home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1994 March / Source_Code_CD-ROM_Walnut_Creek_March_1994.iso / win3 / programr / vbasic / health.exe / MODULE1.BAS < prev    next >
Encoding:
BASIC Source File  |  1993-07-23  |  38.4 KB  |  1,692 lines
  1.  
  2. Sub bounce (picsrc As Form, picdest As Control)
  3. picsrc.ScaleMode = PIXEL
  4. picdest.ScaleMode = PIXEL
  5. hDestDC% = picdest.hDC
  6. X% = 0: Y% = 0
  7. nWidth% = picdest.ScaleWidth
  8. nHeight% = picdest.ScaleHeight
  9. hSrcDC% = picsrc.hDC
  10. xsrc% = 0: ysrc% = summary.HEdit1.Top
  11. dwRop& = &HCC0020
  12. SUC% = BitBlt(hDestDC%, X%, Y%, nWidth%, nHeight%, hSrcDC%, xsrc%, ysrc%, dwRop&)
  13. picsrc.ScaleMode = TWIPS
  14. picdest.ScaleMode = TWIPS
  15.  
  16. End Sub
  17.  
  18. Sub bounce2 (picsrc As Control, picdest As Control)
  19. picsrc.ScaleMode = PIXEL
  20. picdest.ScaleMode = PIXEL
  21. hDestDC% = picdest.hDC
  22. X% = 0: Y% = 0
  23. nWidth% = picdest.ScaleWidth
  24. nHeight% = picdest.ScaleHeight
  25. hSrcDC% = picsrc.hDC
  26. xsrc% = 0: ysrc% = 0
  27. dwRop& = &HCC0020
  28. SUC% = BitBlt(hDestDC%, X%, Y%, nWidth%, nHeight%, hSrcDC%, xsrc%, ysrc%, dwRop&)
  29. picsrc.ScaleMode = TWIPS
  30. picdest.ScaleMode = TWIPS
  31.  
  32. End Sub
  33.  
  34. Sub clearoutine ()
  35. screen.MousePointer = 11
  36. LSet temprecord = clearrecord
  37.     
  38.    
  39.     For n = 0 To 2
  40.     assess1.Option3D1(n).ForeColor = &HFF0000
  41.     Next n
  42.     For n = 0 To 5
  43.     assess1.Option3D4(n).ForeColor = &HFF0000
  44.     Next n
  45.     For n = 0 To 4
  46.     assess1.Option3D10(n).ForeColor = &HFF0000
  47.     Next n
  48.     assess1.Label5.ForeColor = &HFF0000
  49.  
  50. assess1.BEdit2.Text = ""
  51. assess1.HEdit2.Text = ""
  52.  
  53. idform.BEdit1.Text = ""
  54. idform.HEdit1.Text = ""
  55.     idform.BEdit1.Visible = -1
  56.     idform.BEdit1.Text = "   -  -    "
  57.     idform.HEdit1.Visible = 0
  58.     idform.HEdit1.Enabled = -1
  59.     idform.AniButton4.Value = 1
  60.     idform.AniButton3(2).Value = 1
  61.     idform.Option3D1(0).Value = 0
  62.     idform.Option3D1(1).Value = 0
  63.     idform.Check3D1.Value = 0
  64.  
  65. picloc = 0
  66.  
  67. assess1.Option3D1(0).Value = 0
  68. assess1.Option3D1(1).Value = 0
  69. assess1.Option3D1(2).Value = 0
  70. assess1.Option3D4(0).Value = 0
  71. assess1.Option3D4(1).Value = 0
  72. assess1.Option3D4(2).Value = 0
  73. assess1.Option3D4(3).Value = 0
  74. assess1.Option3D4(4).Value = 0
  75. assess1.Option3D4(5).Value = 0
  76. assess1.Option3D10(0).Value = 0
  77. assess1.Option3D10(1).Value = 0
  78. assess1.Option3D10(2).Value = 0
  79. assess1.Option3D10(3).Value = 0
  80. assess1.Option3D10(4).Value = 0
  81. assess1.Check3D3(0).Value = 0
  82. assess1.Check3D3(1).Value = 0
  83. assess1.Check3D3(2).Value = 0
  84. assess1.Check3D3(3).Value = 0
  85. assess1.Check3D3(4).Value = 0
  86. assess1.Check3D3(5).Value = 0
  87. assess1.Check3D3(6).Value = 0
  88. assess1.Check3D3(7).Value = 0
  89. assess1.Check3D3(8).Value = 0
  90. assess1.Check3D1.Value = 0
  91. assess1.Check3D2.Value = 0
  92. assess2.BEdit1(0).Text = ""
  93. assess2.BEdit1(1).Text = ""
  94. assess2.BEdit2(0).Text = ""
  95. assess2.BEdit2(1).Text = ""
  96. assess2.hedit1(0).Text = ""
  97. assess2.hedit1(1).Text = ""
  98. assess2.hedit2(0).Text = ""
  99. assess2.hedit2(1).Text = ""
  100. assess2.HEdit3.Text = ""
  101. medhist.Check3D1(0).Value = 0
  102. medhist.Check3D1(1).Value = 0
  103. medhist.Check3D1(2).Value = 0
  104. medhist.Check3D1(3).Value = 0
  105. medhist.Check3D1(4).Value = 0
  106. medhist.Check3D1(5).Value = 0
  107. medhist.Check3D1(6).Value = 0
  108. medhist.Check3D1(7).Value = 0
  109. medhist.Check3D2(0).Value = 0
  110. medhist.Check3D2(1).Value = 0
  111. medhist.Check3D2(2).Value = 0
  112. medhist.Check3D2(3).Value = 0
  113. medhist.Check3D2(4).Value = 0
  114. medhist.Check3D2(5).Value = 0
  115. medhist.Check3D2(6).Value = 0
  116. medhist.Check3D2(7).Value = 0
  117. medhist.Check3D3(0).Value = 0
  118. medhist.Check3D3(1).Value = 0
  119. medhist.Check3D3(2).Value = 0
  120. medhist.Check3D3(3).Value = 0
  121. medhist.Check3D3(4).Value = 0
  122. medhist.Check3D3(5).Value = 0
  123. medhist.Check3D3(6).Value = 0
  124. medhist.Check3D3(7).Value = 0
  125. medhist.Check3D4(0).Value = 0
  126. medhist.Check3D4(1).Value = 0
  127. medhist.Check3D4(2).Value = 0
  128. medhist.Check3D4(3).Value = 0
  129. medhist.Check3D4(4).Value = 0
  130. medhist.Check3D4(5).Value = 0
  131. medhist.Check3D4(6).Value = 0
  132. medhist.Check3D4(7).Value = 0
  133. Do While MDIChild1A.List1(1).ListCount
  134.     MDIChild1A.List1(1).RemoveItem 0
  135.     Loop
  136.  
  137. Do While MDIChild1B.List2(1).ListCount
  138.     MDIChild1B.List2(1).RemoveItem 0
  139.     Loop
  140.  
  141. Do While MDIChild1C.List3(1).ListCount
  142.     MDIChild1C.List3(1).RemoveItem 0
  143.     Loop
  144.  
  145. Do While summary.List2.ListCount
  146.     summary.List2.RemoveItem 0
  147.     Loop
  148. screen.MousePointer = 0
  149. End Sub
  150.  
  151. Sub dispose ()
  152. exitsave.Show 1
  153. If admit.Picture1.Tag = "new" Then
  154.     admit.Picture1.Cls
  155.     admit.Picture1.AutoRedraw = -1
  156.     admit.Picture1.Scale (0, 0)-(3, 4)
  157.     admit.Picture1.CurrentX = .8
  158.     admit.Picture1.CurrentY = 1.2
  159.     admit.Picture1.Print "CLICK"
  160.     admit.Picture1.CurrentX = 1
  161.     admit.Picture1.CurrentY = 2
  162.     admit.Picture1.Print " TO"
  163.     admit.Picture1.CurrentX = .8
  164.     admit.Picture1.CurrentY = 2.8
  165.     admit.Picture1.Print "BEGIN"
  166.     clearoutine
  167.     admit.Show
  168. End If
  169. End Sub
  170.  
  171. Sub editswap (thebedit As Control, thehedit As Control, process As Integer)
  172. Select Case process
  173. Case 1
  174.     For n = 1 To Len(thebedit.Text)
  175.     a$ = a$ + Mid$(thebedit.Text, n, 1) + Chr$(32)
  176.     Next n
  177.     thehedit.Text = Chr$(32) + a$
  178.  
  179. Case 2
  180.     For n = 1 To Len(thehedit.Text)
  181.     If Mid$(thehedit.Text, n, 1) <> " " Then
  182.         a$ = a$ + Mid$(thehedit.Text, n, 1)
  183.     End If
  184.     Next n
  185.     thebedit.Text = a$
  186. End Select
  187.  
  188.  
  189. End Sub
  190.  
  191. Sub Endroutine ()
  192. Unload admit
  193. Unload assess1
  194. Unload assess2
  195. Unload assess3
  196. Unload idform
  197. Unload medhist
  198. Unload MDIMForm
  199. Unload summary
  200. End    'redundant but...
  201. End Sub
  202.  
  203. Sub fillfields ()
  204. nofocuscalls = -1
  205. assess1.BEdit1.Text = patrecord.dayt
  206. assess1.BEdit2.Text = patrecord.tyme
  207. assess1.Option3D1(0).Value = patrecord.theoption.opt1
  208. assess1.Option3D1(1).Value = patrecord.theoption.opt2
  209. assess1.Option3D1(2).Value = patrecord.theoption.opt3
  210. assess1.Option3D4(0).Value = patrecord.theoption.opt4
  211. assess1.Option3D4(1).Value = patrecord.theoption.opt5
  212. assess1.Option3D4(2).Value = patrecord.theoption.opt6
  213. assess1.Option3D4(3).Value = patrecord.theoption.opt7
  214. assess1.Option3D4(4).Value = patrecord.theoption.opt8
  215. assess1.Option3D4(5).Value = patrecord.theoption.opt9
  216. assess1.Option3D10(0).Value = patrecord.theoption.opt10
  217. assess1.Option3D10(1).Value = patrecord.theoption.opt11
  218. assess1.Option3D10(2).Value = patrecord.theoption.opt11
  219. assess1.Option3D10(3).Value = patrecord.theoption.opt13
  220. assess1.Option3D10(4).Value = patrecord.theoption.opt14
  221. assess1.Check3D3(0).Value = patrecord.chicks.chek1
  222. assess1.Check3D3(1).Value = patrecord.chicks.chek2
  223. assess1.Check3D3(2).Value = patrecord.chicks.chek3
  224. assess1.Check3D3(3).Value = patrecord.chicks.chek4
  225. assess1.Check3D3(4).Value = patrecord.chicks.chek5
  226. assess1.Check3D3(5).Value = patrecord.chicks.chek6
  227. assess1.Check3D3(6).Value = patrecord.chicks.chek7
  228. assess1.Check3D3(7).Value = patrecord.chicks.chek8
  229. assess1.Check3D3(8).Value = patrecord.chicks.chek9
  230. assess1.Check3D1.Value = patrecord.chk1
  231. assess1.Check3D2.Value = patrecord.chk2
  232. assess2.BEdit1(0).Text = patrecord.name
  233. assess2.BEdit1(1).Text = patrecord.relation
  234. assess2.BEdit2(0).Text = patrecord.home
  235. assess2.BEdit2(1).Text = patrecord.work
  236. assess2.hedit1(0).Text = patrecord.name
  237. assess2.hedit1(1).Text = patrecord.relation
  238. assess2.hedit2(0).Text = patrecord.home
  239. assess2.hedit2(1).Text = patrecord.work
  240. assess2.HEdit3.Text = patrecord.hed1
  241. medhist.Check3D1(0).Value = patrecord.d1.shek1
  242. medhist.Check3D1(1).Value = patrecord.d1.shek2
  243. medhist.Check3D1(2).Value = patrecord.d1.shek3
  244. medhist.Check3D1(3).Value = patrecord.d1.shek4
  245. medhist.Check3D1(4).Value = patrecord.d1.shek5
  246. medhist.Check3D1(5).Value = patrecord.d1.shek6
  247. medhist.Check3D1(6).Value = patrecord.d1.shek7
  248. medhist.Check3D1(7).Value = patrecord.d1.shek8
  249. medhist.Check3D2(0).Value = patrecord.d2.shek1
  250. medhist.Check3D2(1).Value = patrecord.d2.shek2
  251. medhist.Check3D2(2).Value = patrecord.d2.shek3
  252. medhist.Check3D2(3).Value = patrecord.d2.shek4
  253. medhist.Check3D2(4).Value = patrecord.d2.shek5
  254. medhist.Check3D2(5).Value = patrecord.d2.shek6
  255. medhist.Check3D2(6).Value = patrecord.d2.shek7
  256. medhist.Check3D2(7).Value = patrecord.d2.shek8
  257. medhist.Check3D3(0).Value = patrecord.d3.shek1
  258. medhist.Check3D3(1).Value = patrecord.d3.shek2
  259. medhist.Check3D3(2).Value = patrecord.d3.shek3
  260. medhist.Check3D3(3).Value = patrecord.d3.shek4
  261. medhist.Check3D3(4).Value = patrecord.d3.shek5
  262. medhist.Check3D3(5).Value = patrecord.d3.shek6
  263. medhist.Check3D3(6).Value = patrecord.d3.shek7
  264. medhist.Check3D3(7).Value = patrecord.d3.shek8
  265. medhist.Check3D4(0).Value = patrecord.d4.shek1
  266. medhist.Check3D4(1).Value = patrecord.d4.shek2
  267. medhist.Check3D4(2).Value = patrecord.d4.shek3
  268. medhist.Check3D4(3).Value = patrecord.d4.shek4
  269. medhist.Check3D4(4).Value = patrecord.d4.shek5
  270. medhist.Check3D4(5).Value = patrecord.d4.shek6
  271. medhist.Check3D4(6).Value = patrecord.d4.shek7
  272. medhist.Check3D4(7).Value = patrecord.d4.shek8
  273. '***********************************************************
  274.  
  275. '******************************************************************
  276. num = 0
  277. If num < patrecord.mdi1count Then
  278. MDIChild1A.List1(1).AddItem patrecord.mdi1.fd1
  279. num = num + 1
  280. Else
  281. GoTo done1
  282. End If
  283.  
  284. If num < patrecord.mdi1count Then
  285. MDIChild1A.List1(1).AddItem patrecord.mdi1.fd2
  286. num = num + 1
  287. Else
  288. GoTo done1
  289. End If
  290.  
  291. If num < patrecord.mdi1count Then
  292. MDIChild1A.List1(1).AddItem patrecord.mdi1.fd3
  293. num = num + 1
  294. Else
  295. GoTo done1
  296. End If
  297.  
  298. If num < patrecord.mdi1count Then
  299. MDIChild1A.List1(1).AddItem patrecord.mdi1.fd4
  300. num = num + 1
  301. Else
  302. GoTo done1
  303. End If
  304.  
  305. If num < patrecord.mdi1count Then
  306. MDIChild1A.List1(1).AddItem patrecord.mdi1.fd5
  307. num = num + 1
  308. Else
  309. GoTo done1
  310. End If
  311.  
  312. If num < patrecord.mdi1count Then
  313. MDIChild1A.List1(1).AddItem patrecord.mdi1.fd6
  314. num = num + 1
  315. Else
  316. GoTo done1
  317. End If
  318.  
  319. If num < patrecord.mdi1count Then
  320. MDIChild1A.List1(1).AddItem patrecord.mdi1.fd7
  321. num = num + 1
  322. Else
  323. GoTo done1
  324. End If
  325.  
  326. If num < patrecord.mdi1count Then
  327. MDIChild1A.List1(1).AddItem patrecord.mdi1.fd8
  328. num = num + 1
  329. Else
  330. GoTo done1
  331. End If
  332.  
  333. If num < patrecord.mdi1count Then
  334. MDIChild1A.List1(1).AddItem patrecord.mdi1.fd9
  335. num = num + 1
  336. Else
  337. GoTo done1
  338. End If
  339.  
  340. If num < patrecord.mdi1count Then
  341. MDIChild1A.List1(1).AddItem patrecord.mdi1.fd10
  342. num = num + 1
  343. Else
  344. GoTo done1
  345. End If
  346.  
  347. If num < patrecord.mdi1count Then
  348. MDIChild1A.List1(1).AddItem patrecord.mdi1.fd11
  349. num = num + 1
  350. Else
  351. GoTo done1
  352. End If
  353.  
  354. If num < patrecord.mdi1count Then
  355. MDIChild1A.List1(1).AddItem patrecord.mdi1.fd12
  356. num = num + 1
  357. Else
  358. GoTo done1
  359. End If
  360.  
  361. If num < patrecord.mdi1count Then
  362. MDIChild1A.List1(1).AddItem patrecord.mdi1.fd13
  363. num = num + 1
  364. Else
  365. GoTo done1
  366. End If
  367.  
  368. If num < patrecord.mdi1count Then
  369. MDIChild1A.List1(1).AddItem patrecord.mdi1.fd14
  370. num = num + 1
  371. Else
  372. GoTo done1
  373. End If
  374.  
  375. If num < patrecord.mdi1count Then
  376. MDIChild1A.List1(1).AddItem patrecord.mdi1.fd15
  377. num = num + 1
  378. Else
  379. GoTo done1
  380. End If
  381.  
  382. If num < patrecord.mdi1count Then
  383. MDIChild1A.List1(1).AddItem patrecord.mdi1.fd16
  384. num = num + 1
  385. Else
  386. GoTo done1
  387. End If
  388.  
  389. If num < patrecord.mdi1count Then
  390. MDIChild1A.List1(1).AddItem patrecord.mdi1.fd17
  391. num = num + 1
  392. Else
  393. GoTo done1
  394. End If
  395.  
  396. If num < patrecord.mdi1count Then
  397. MDIChild1A.List1(1).AddItem patrecord.mdi1.fd18
  398. num = num + 1
  399. Else
  400. GoTo done1
  401. End If
  402.  
  403. If num < patrecord.mdi1count Then
  404. MDIChild1A.List1(1).AddItem patrecord.mdi1.fd19
  405. num = num + 1
  406. Else
  407. GoTo done1
  408. End If
  409.  
  410. If num < patrecord.mdi1count Then
  411. MDIChild1A.List1(1).AddItem patrecord.mdi1.fd20
  412. num = num + 1
  413. Else
  414. GoTo done1
  415. End If
  416.  
  417. '***********************************************************
  418. done1:
  419. '***********************************************************
  420. num = 0
  421. If num < patrecord.mdi2count Then
  422. MDIChild1B.List2(1).AddItem patrecord.mdi2.fd1
  423. num = num + 1
  424. Else
  425. GoTo done2
  426. End If
  427.  
  428. If num < patrecord.mdi2count Then
  429. MDIChild1B.List2(1).AddItem patrecord.mdi2.fd2
  430. num = num + 1
  431. Else
  432. GoTo done2
  433. End If
  434.  
  435. If num < patrecord.mdi2count Then
  436. MDIChild1B.List2(1).AddItem patrecord.mdi2.fd3
  437. num = num + 1
  438. Else
  439. GoTo done2
  440. End If
  441.  
  442. If num < patrecord.mdi2count Then
  443. MDIChild1B.List2(1).AddItem patrecord.mdi2.fd4
  444. num = num + 1
  445. Else
  446. GoTo done2
  447. End If
  448.  
  449. If num < patrecord.mdi2count Then
  450. MDIChild1B.List2(1).AddItem patrecord.mdi2.fd5
  451. num = num + 1
  452. Else
  453. GoTo done2
  454. End If
  455.  
  456. If num < patrecord.mdi2count Then
  457. MDIChild1B.List2(1).AddItem patrecord.mdi2.fd6
  458. num = num + 1
  459. Else
  460. GoTo done2
  461. End If
  462.  
  463. If num < patrecord.mdi2count Then
  464. MDIChild1B.List2(1).AddItem patrecord.mdi2.fd7
  465. num = num + 1
  466. Else
  467. GoTo done2
  468. End If
  469.  
  470. If num < patrecord.mdi2count Then
  471. MDIChild1B.List2(1).AddItem patrecord.mdi2.fd8
  472. num = num + 1
  473. Else
  474. GoTo done2
  475. End If
  476.  
  477. If num < patrecord.mdi2count Then
  478. MDIChild1B.List2(1).AddItem patrecord.mdi2.fd9
  479. num = num + 1
  480. Else
  481. GoTo done2
  482. End If
  483.  
  484. If num < patrecord.mdi2count Then
  485. MDIChild1B.List2(1).AddItem patrecord.mdi2.fd10
  486. num = num + 1
  487. Else
  488. GoTo done2
  489. End If
  490.  
  491. If num < patrecord.mdi2count Then
  492. MDIChild1B.List2(1).AddItem patrecord.mdi2.fd11
  493. num = num + 1
  494. Else
  495. GoTo done2
  496. End If
  497.  
  498. If num < patrecord.mdi2count Then
  499. MDIChild1B.List2(1).AddItem patrecord.mdi2.fd12
  500. num = num + 1
  501. Else
  502. GoTo done2
  503. End If
  504.  
  505. If num < patrecord.mdi2count Then
  506. MDIChild1B.List2(1).AddItem patrecord.mdi2.fd13
  507. num = num + 1
  508. Else
  509. GoTo done2
  510. End If
  511.  
  512. If num < patrecord.mdi2count Then
  513. MDIChild1B.List2(1).AddItem patrecord.mdi2.fd14
  514. num = num + 1
  515. Else
  516. GoTo done2
  517. End If
  518.  
  519. If num < patrecord.mdi2count Then
  520. MDIChild1B.List2(1).AddItem patrecord.mdi2.fd15
  521. num = num + 1
  522. Else
  523. GoTo done2
  524. End If
  525.  
  526. If num < patrecord.mdi2count Then
  527. MDIChild1B.List2(1).AddItem patrecord.mdi2.fd16
  528. num = num + 1
  529. Else
  530. GoTo done2
  531. End If
  532.  
  533. If num < patrecord.mdi2count Then
  534. MDIChild1B.List2(1).AddItem patrecord.mdi2.fd17
  535. num = num + 1
  536. Else
  537. GoTo done2
  538. End If
  539.  
  540. If num < patrecord.mdi2count Then
  541. MDIChild1B.List2(1).AddItem patrecord.mdi2.fd18
  542. num = num + 1
  543. Else
  544. GoTo done2
  545. End If
  546.  
  547. If num < patrecord.mdi2count Then
  548. MDIChild1B.List2(1).AddItem patrecord.mdi2.fd19
  549. num = num + 1
  550. Else
  551. GoTo done2
  552. End If
  553.  
  554. If num < patrecord.mdi2count Then
  555. MDIChild1B.List2(1).AddItem patrecord.mdi2.fd20
  556. num = num + 1
  557. Else
  558. GoTo done2
  559. End If
  560.  
  561. done2:
  562. '*******************************************************************
  563. num = 0
  564.  
  565. If num < patrecord.mdi3count Then
  566. MDIChild1C.List3(1).AddItem patrecord.mdi3.fd1
  567. num = num + 1
  568. Else
  569. GoTo done3
  570. End If
  571.  
  572. If num < patrecord.mdi3count Then
  573. MDIChild1C.List3(1).AddItem patrecord.mdi3.fd2
  574. num = num + 1
  575. Else
  576. GoTo done3
  577. End If
  578.  
  579. If num < patrecord.mdi3count Then
  580. MDIChild1C.List3(1).AddItem patrecord.mdi3.fd3
  581. num = num + 1
  582. Else
  583. GoTo done3
  584. End If
  585.  
  586. If num < patrecord.mdi3count Then
  587. MDIChild1C.List3(1).AddItem patrecord.mdi3.fd4
  588. num = num + 1
  589. Else
  590. GoTo done3
  591. End If
  592.  
  593. If num < patrecord.mdi3count Then
  594. MDIChild1C.List3(1).AddItem patrecord.mdi3.fd5
  595. num = num + 1
  596. Else
  597. GoTo done3
  598. End If
  599.  
  600. If num < patrecord.mdi3count Then
  601. MDIChild1C.List3(1).AddItem patrecord.mdi3.fd6
  602. num = num + 1
  603. Else
  604. GoTo done3
  605. End If
  606.  
  607. If num < patrecord.mdi3count Then
  608. MDIChild1C.List3(1).AddItem patrecord.mdi3.fd7
  609. num = num + 1
  610. Else
  611. GoTo done3
  612. End If
  613.  
  614. If num < patrecord.mdi3count Then
  615. MDIChild1C.List3(1).AddItem patrecord.mdi3.fd8
  616. num = num + 1
  617. Else
  618. GoTo done3
  619. End If
  620.  
  621. If num < patrecord.mdi3count Then
  622. MDIChild1C.List3(1).AddItem patrecord.mdi3.fd9
  623. num = num + 1
  624. Else
  625. GoTo done3
  626. End If
  627.  
  628. If num < patrecord.mdi3count Then
  629. MDIChild1C.List3(1).AddItem patrecord.mdi3.fd10
  630. num = num + 1
  631. Else
  632. GoTo done3
  633. End If
  634.  
  635. If num < patrecord.mdi3count Then
  636. MDIChild1C.List3(1).AddItem patrecord.mdi3.fd11
  637. num = num + 1
  638. Else
  639. GoTo done3
  640. End If
  641.  
  642. If num < patrecord.mdi3count Then
  643. MDIChild1C.List3(1).AddItem patrecord.mdi3.fd12
  644. num = num + 1
  645. Else
  646. GoTo done3
  647. End If
  648.  
  649. If num < patrecord.mdi3count Then
  650. MDIChild1C.List3(1).AddItem patrecord.mdi3.fd13
  651. num = num + 1
  652. Else
  653. GoTo done3
  654. End If
  655.  
  656. If num < patrecord.mdi3count Then
  657. MDIChild1C.List3(1).AddItem patrecord.mdi3.fd14
  658. num = num + 1
  659. Else
  660. GoTo done3
  661. End If
  662.  
  663. If num < patrecord.mdi3count Then
  664. MDIChild1C.List3(1).AddItem patrecord.mdi3.fd15
  665. num = num + 1
  666. Else
  667. GoTo done3
  668. End If
  669.  
  670. If num < patrecord.mdi3count Then
  671. MDIChild1C.List3(1).AddItem patrecord.mdi3.fd16
  672. num = num + 1
  673. Else
  674. GoTo done3
  675. End If
  676.  
  677. If num < patrecord.mdi3count Then
  678. MDIChild1C.List3(1).AddItem patrecord.mdi3.fd17
  679. num = num + 1
  680. Else
  681. GoTo done3
  682. End If
  683.  
  684. If num < patrecord.mdi3count Then
  685. MDIChild1C.List3(1).AddItem patrecord.mdi3.fd18
  686. num = num + 1
  687. Else
  688. GoTo done3
  689. End If
  690.  
  691. If num < patrecord.mdi3count Then
  692. MDIChild1C.List3(1).AddItem patrecord.mdi3.fd19
  693. num = num + 1
  694. Else
  695. GoTo done3
  696. End If
  697.  
  698. If num < patrecord.mdi3count Then
  699. MDIChild1C.List3(1).AddItem patrecord.mdi3.fd20
  700. num = num + 1
  701. Else
  702. GoTo done3
  703. End If
  704.  
  705. done3:
  706. '******************************************************
  707. num = 0
  708.  
  709. If num < patrecord.sumcount Then
  710. summary.List2.AddItem patrecord.sum1.fd1
  711. num = num + 1
  712. Else
  713. GoTo sumdone
  714. End If
  715.  
  716. If num < patrecord.sumcount Then
  717. summary.List2.AddItem patrecord.sum1.fd2
  718. num = num + 1
  719. Else
  720. GoTo sumdone
  721. End If
  722.  
  723. If num < patrecord.sumcount Then
  724. summary.List2.AddItem patrecord.sum1.fd3
  725. num = num + 1
  726. Else
  727. GoTo sumdone
  728. End If
  729.  
  730. If num < patrecord.sumcount Then
  731. summary.List2.AddItem patrecord.sum1.fd4
  732. num = num + 1
  733. Else
  734. GoTo sumdone
  735. End If
  736.  
  737. If num < patrecord.sumcount Then
  738. summary.List2.AddItem patrecord.sum1.fd5
  739. num = num + 1
  740. Else
  741. GoTo sumdone
  742. End If
  743.  
  744. If num < patrecord.sumcount Then
  745. summary.List2.AddItem patrecord.sum1.fd6
  746. num = num + 1
  747. Else
  748. GoTo sumdone
  749. End If
  750.  
  751. If num < patrecord.sumcount Then
  752. summary.List2.AddItem patrecord.sum1.fd7
  753. num = num + 1
  754. Else
  755. GoTo sumdone
  756. End If
  757.  
  758. If num < patrecord.sumcount Then
  759. summary.List2.AddItem patrecord.sum1.fd8
  760. num = num + 1
  761. Else
  762. GoTo sumdone
  763. End If
  764.  
  765. If num < patrecord.sumcount Then
  766. summary.List2.AddItem patrecord.sum1.fd9
  767. num = num + 1
  768. Else
  769. GoTo sumdone
  770. End If
  771.  
  772. If num < patrecord.sumcount Then
  773. summary.List2.AddItem patrecord.sum1.fd10
  774. num = num + 1
  775. Else
  776. GoTo sumdone
  777. End If
  778.  
  779. If num < patrecord.sumcount Then
  780. summary.List2.AddItem patrecord.sum1.fd11
  781. num = num + 1
  782. Else
  783. GoTo sumdone
  784. End If
  785.  
  786. If num < patrecord.sumcount Then
  787. summary.List2.AddItem patrecord.sum1.fd12
  788. num = num + 1
  789. Else
  790. GoTo sumdone
  791. End If
  792.  
  793. If num < patrecord.sumcount Then
  794. summary.List2.AddItem patrecord.sum1.fd13
  795. num = num + 1
  796. Else
  797. GoTo sumdone
  798. End If
  799.  
  800. If num < patrecord.sumcount Then
  801. summary.List2.AddItem patrecord.sum1.fd14
  802. num = num + 1
  803. Else
  804. GoTo sumdone
  805. End If
  806.  
  807. If num < patrecord.sumcount Then
  808. summary.List2.AddItem patrecord.sum1.fd15
  809. num = num + 1
  810. Else
  811. GoTo sumdone
  812. End If
  813.  
  814. If num < patrecord.sumcount Then
  815. summary.List2.AddItem patrecord.sum1.fd16
  816. num = num + 1
  817. Else
  818. GoTo sumdone
  819. End If
  820.  
  821. If num < patrecord.sumcount Then
  822. summary.List2.AddItem patrecord.sum1.fd17
  823. num = num + 1
  824. Else
  825. GoTo sumdone
  826. End If
  827.  
  828. If num < patrecord.sumcount Then
  829. summary.List2.AddItem patrecord.sum1.fd18
  830. num = num + 1
  831. Else
  832. GoTo sumdone
  833. End If
  834.  
  835. If num < patrecord.sumcount Then
  836. summary.List2.AddItem patrecord.sum1.fd19
  837. num = num + 1
  838. Else
  839. GoTo sumdone
  840. End If
  841.  
  842. If num < patrecord.sumcount Then
  843. summary.List2.AddItem patrecord.sum1.fd20
  844. num = num + 1
  845. Else
  846. GoTo sumdone
  847. End If
  848.  
  849. sumdone:
  850. nofocuscalls = 0
  851. End Sub
  852.  
  853. Function FINALCHECK () As Integer
  854.  
  855. FINALCHECK = -1
  856.  
  857. If Not ok.idf Then
  858. MsgBox "The Identification Form Is Not Complete", 0, "FinalCheck"
  859. FINALCHECK = 0
  860. Exit Function
  861. End If
  862.  
  863. If Not ok.ass1 Then
  864. MsgBox "The Admission Form Is Not Complete", 0, "FinalCheck"
  865. FINALCHECK = 0
  866. Exit Function
  867. End If
  868.  
  869. If Not ok.ass2 Then
  870. MsgBox "The Diagnosis Form Is Not Complete", 0, "FinalCheck"
  871. FINALCHECK = 0
  872. Exit Function
  873. End If
  874.  
  875. 'If Not ok.medh Then
  876. 'MsgBox "The History Form Is Not Complete", 0, "FinalCheck"
  877. 'FINALCHECK = 0
  878. 'Exit Function
  879. 'End If
  880.  
  881. 'If Not ok.ass3 Then
  882. 'MsgBox "The Physical Form Is Not Complete", 0, "FinalCheck"
  883. 'FINALCHECK = 0
  884. 'Exit Function
  885. 'End If
  886.  
  887. If Not ok.mdif Then
  888. MsgBox "The Clinical Form Is Not Complete", 0, "FinalCheck"
  889. FINALCHECK = 0
  890. Exit Function
  891. End If
  892.  
  893. If Not ok.sumf Then
  894. MsgBox "The Summary Form Is Not Complete", 0, "FinalCheck"
  895. FINALCHECK = 0
  896. Exit Function
  897. End If
  898.  
  899. End Function
  900.  
  901. Sub formcheck (where$)
  902. MsgBox "You Have Not Completed " + Chr$(13) + "The Necessary Entries " + Chr$(13) + "On The " + where$, 48, "SMARTFORM"
  903. End Sub
  904.  
  905. Sub getfields ()
  906.  
  907. LSet patrecord = temprecord
  908.  
  909. patrecord.theoption.opt2 = assess1.Option3D1(1).Value
  910. patrecord.theoption.opt3 = assess1.Option3D1(2).Value
  911.  
  912. patrecord.theoption.opt5 = assess1.Option3D4(1).Value
  913. patrecord.theoption.opt6 = assess1.Option3D4(2).Value
  914. patrecord.theoption.opt7 = assess1.Option3D4(3).Value
  915. patrecord.theoption.opt8 = assess1.Option3D4(4).Value
  916. patrecord.theoption.opt9 = assess1.Option3D4(5).Value
  917.  
  918. patrecord.theoption.opt11 = assess1.Option3D10(1).Value
  919. patrecord.theoption.opt12 = assess1.Option3D10(2).Value
  920. patrecord.theoption.opt13 = assess1.Option3D10(3).Value
  921. patrecord.theoption.opt14 = assess1.Option3D10(4).Value
  922. patrecord.chicks.chek1 = assess1.Check3D3(0).Value
  923. patrecord.chicks.chek2 = assess1.Check3D3(1).Value
  924. patrecord.chicks.chek3 = assess1.Check3D3(2).Value
  925. patrecord.chicks.chek4 = assess1.Check3D3(3).Value
  926. patrecord.chicks.chek5 = assess1.Check3D3(4).Value
  927. patrecord.chicks.chek6 = assess1.Check3D3(5).Value
  928. patrecord.chicks.chek7 = assess1.Check3D3(6).Value
  929. patrecord.chicks.chek8 = assess1.Check3D3(7).Value
  930. patrecord.chicks.chek9 = assess1.Check3D3(8).Value
  931. patrecord.d1.shek1 = medhist.Check3D1(0).Value
  932. patrecord.d1.shek2 = medhist.Check3D1(1).Value
  933. patrecord.d1.shek3 = medhist.Check3D1(2).Value
  934. patrecord.d1.shek4 = medhist.Check3D1(3).Value
  935. patrecord.d1.shek5 = medhist.Check3D1(4).Value
  936. patrecord.d1.shek6 = medhist.Check3D1(5).Value
  937. patrecord.d1.shek7 = medhist.Check3D1(6).Value
  938. patrecord.d1.shek8 = medhist.Check3D1(7).Value
  939. patrecord.d2.shek1 = medhist.Check3D2(0).Value
  940. patrecord.d2.shek2 = medhist.Check3D2(1).Value
  941. patrecord.d2.shek3 = medhist.Check3D2(2).Value
  942. patrecord.d2.shek4 = medhist.Check3D2(3).Value
  943. patrecord.d2.shek5 = medhist.Check3D2(4).Value
  944. patrecord.d2.shek6 = medhist.Check3D2(5).Value
  945. patrecord.d2.shek7 = medhist.Check3D2(6).Value
  946. patrecord.d2.shek8 = medhist.Check3D2(7).Value
  947. patrecord.d3.shek1 = medhist.Check3D3(0).Value
  948. patrecord.d3.shek2 = medhist.Check3D3(1).Value
  949. patrecord.d3.shek3 = medhist.Check3D3(2).Value
  950. patrecord.d3.shek4 = medhist.Check3D3(3).Value
  951. patrecord.d3.shek5 = medhist.Check3D3(4).Value
  952. patrecord.d3.shek6 = medhist.Check3D3(5).Value
  953. patrecord.d3.shek7 = medhist.Check3D3(6).Value
  954. patrecord.d3.shek8 = medhist.Check3D3(7).Value
  955. patrecord.d4.shek1 = medhist.Check3D4(0).Value
  956. patrecord.d4.shek2 = medhist.Check3D4(1).Value
  957. patrecord.d4.shek3 = medhist.Check3D4(2).Value
  958. patrecord.d4.shek4 = medhist.Check3D4(3).Value
  959. patrecord.d4.shek5 = medhist.Check3D4(4).Value
  960. patrecord.d4.shek6 = medhist.Check3D4(5).Value
  961. patrecord.d4.shek7 = medhist.Check3D4(6).Value
  962. patrecord.d4.shek8 = medhist.Check3D4(7).Value
  963. '***********************************************************
  964.  
  965. '******************************************************************
  966. num = 0
  967.  
  968. If MDIChild1A.List1(1).ListCount < num Then
  969. patrecord.mdi1.fd1 = MDIChild1A.List1(1).List(0)
  970. num = num + 1
  971. End If
  972.  
  973. If MDIChild1A.List1(1).ListCount < num Then
  974. patrecord.mdi1.fd2 = MDIChild1A.List1(1).List(1)
  975. num = num + 1
  976. End If
  977.  
  978. If MDIChild1A.List1(1).ListCount < num Then
  979. patrecord.mdi1.fd3 = MDIChild1A.List1(1).List(2)
  980. num = num + 1
  981. End If
  982.  
  983. If MDIChild1A.List1(1).ListCount < num Then
  984. patrecord.mdi1.fd4 = MDIChild1A.List1(1).List(3)
  985. num = num + 1
  986. End If
  987.  
  988. If MDIChild1A.List1(1).ListCount < num Then
  989. patrecord.mdi1.fd5 = MDIChild1A.List1(1).List(4)
  990. num = num + 1
  991. End If
  992.  
  993. If MDIChild1A.List1(1).ListCount < num Then
  994. patrecord.mdi1.fd6 = MDIChild1A.List1(1).List(5)
  995. num = num + 1
  996. End If
  997.  
  998. If MDIChild1A.List1(1).ListCount < num Then
  999. patrecord.mdi1.fd7 = MDIChild1A.List1(1).List(6)
  1000. num = num + 1
  1001. End If
  1002.  
  1003. If MDIChild1A.List1(1).ListCount < num Then
  1004. patrecord.mdi1.fd8 = MDIChild1A.List1(1).List(7)
  1005. num = num + 1
  1006. End If
  1007.  
  1008. If MDIChild1A.List1(1).ListCount < num Then
  1009. patrecord.mdi1.fd9 = MDIChild1A.List1(1).List(8)
  1010. num = num + 1
  1011. End If
  1012.  
  1013. If MDIChild1A.List1(1).ListCount < num Then
  1014. patrecord.mdi1.fd10 = MDIChild1A.List1(1).List(9)
  1015. num = num + 1
  1016. End If
  1017.  
  1018. If MDIChild1A.List1(1).ListCount < num Then
  1019. patrecord.mdi1.fd11 = MDIChild1A.List1(1).List(10)
  1020. num = num + 1
  1021. End If
  1022.  
  1023. If MDIChild1A.List1(1).ListCount < num Then
  1024. patrecord.mdi1.fd12 = MDIChild1A.List1(1).List(11)
  1025. num = num + 1
  1026. End If
  1027.  
  1028. If MDIChild1A.List1(1).ListCount < num Then
  1029. patrecord.mdi1.fd13 = MDIChild1A.List1(1).List(12)
  1030. num = num + 1
  1031. End If
  1032.  
  1033. If MDIChild1A.List1(1).ListCount < num Then
  1034. patrecord.mdi1.fd14 = MDIChild1A.List1(1).List(13)
  1035. num = num + 1
  1036. End If
  1037.  
  1038. If MDIChild1A.List1(1).ListCount < num Then
  1039. patrecord.mdi1.fd15 = MDIChild1A.List1(1).List(14)
  1040. num = num + 1
  1041. End If
  1042.  
  1043. If MDIChild1A.List1(1).ListCount < num Then
  1044. patrecord.mdi1.fd16 = MDIChild1A.List1(1).List(15)
  1045. num = num + 1
  1046. End If
  1047.  
  1048. If MDIChild1A.List1(1).ListCount < num Then
  1049. patrecord.mdi1.fd17 = MDIChild1A.List1(1).List(16)
  1050. num = num + 1
  1051. End If
  1052.  
  1053. If MDIChild1A.List1(1).ListCount < num Then
  1054. patrecord.mdi1.fd18 = MDIChild1A.List1(1).List(17)
  1055. num = num + 1
  1056. End If
  1057.  
  1058. If MDIChild1A.List1(1).ListCount < num Then
  1059. patrecord.mdi1.fd19 = MDIChild1A.List1(1).List(18)
  1060. num = num + 1
  1061. End If
  1062.  
  1063. If MDIChild1A.List1(1).ListCount < num Then
  1064. patrecord.mdi1.fd20 = MDIChild1A.List1(1).List(19)
  1065. num = num + 1
  1066. End If
  1067. patrecord.mdi1count = num
  1068. '*******************************************************************
  1069. num = 0
  1070. If MDIChild1B.List2(1).ListCount < num Then
  1071. patrecord.mdi2.fd1 = MDIChild1B.List2(1).List(0)
  1072. num = num + 1
  1073. End If
  1074.  
  1075. If MDIChild1B.List2(1).ListCount < num Then
  1076. patrecord.mdi2.fd2 = MDIChild1B.List2(1).List(1)
  1077. num = num + 1
  1078. End If
  1079.  
  1080. If MDIChild1B.List2(1).ListCount < num Then
  1081. patrecord.mdi2.fd3 = MDIChild1B.List2(1).List(2)
  1082. num = num + 1
  1083. End If
  1084.  
  1085. If MDIChild1B.List2(1).ListCount < num Then
  1086. patrecord.mdi2.fd4 = MDIChild1B.List2(1).List(3)
  1087. num = num + 1
  1088. End If
  1089.  
  1090. If MDIChild1B.List2(1).ListCount < num Then
  1091. patrecord.mdi2.fd5 = MDIChild1B.List2(1).List(4)
  1092. num = num + 1
  1093. End If
  1094.  
  1095. If MDIChild1B.List2(1).ListCount < num Then
  1096. patrecord.mdi2.fd6 = MDIChild1B.List2(1).List(5)
  1097. num = num + 1
  1098. End If
  1099.  
  1100. If MDIChild1B.List2(1).ListCount < num Then
  1101. patrecord.mdi2.fd7 = MDIChild1B.List2(1).List(6)
  1102. num = num + 1
  1103. End If
  1104.  
  1105. If MDIChild1B.List2(1).ListCount < num Then
  1106. patrecord.mdi2.fd8 = MDIChild1B.List2(1).List(7)
  1107. num = num + 1
  1108. End If
  1109.  
  1110. If MDIChild1B.List2(1).ListCount < num Then
  1111. patrecord.mdi2.fd9 = MDIChild1B.List2(1).List(8)
  1112. num = num + 1
  1113. End If
  1114.  
  1115. If MDIChild1B.List2(1).ListCount < num Then
  1116. patrecord.mdi2.fd10 = MDIChild1B.List2(1).List(9)
  1117. num = num + 1
  1118. End If
  1119.  
  1120. If MDIChild1B.List2(1).ListCount < num Then
  1121. patrecord.mdi2.fd11 = MDIChild1B.List2(1).List(10)
  1122. num = num + 1
  1123. End If
  1124.  
  1125. If MDIChild1B.List2(1).ListCount < num Then
  1126. patrecord.mdi2.fd12 = MDIChild1B.List2(1).List(11)
  1127. num = num + 1
  1128. End If
  1129.  
  1130. If MDIChild1B.List2(1).ListCount < num Then
  1131. patrecord.mdi2.fd13 = MDIChild1B.List2(1).List(12)
  1132. num = num + 1
  1133. End If
  1134.  
  1135. If MDIChild1B.List2(1).ListCount < num Then
  1136. patrecord.mdi2.fd14 = MDIChild1B.List2(1).List(13)
  1137. num = num + 1
  1138. End If
  1139.  
  1140. If MDIChild1B.List2(1).ListCount < num Then
  1141. patrecord.mdi2.fd15 = MDIChild1B.List2(1).List(14)
  1142. num = num + 1
  1143. End If
  1144.  
  1145. If MDIChild1B.List2(1).ListCount < num Then
  1146. patrecord.mdi2.fd16 = MDIChild1B.List2(1).List(15)
  1147. num = num + 1
  1148. End If
  1149.  
  1150. If MDIChild1B.List2(1).ListCount < num Then
  1151. patrecord.mdi2.fd17 = MDIChild1B.List2(1).List(16)
  1152. num = num + 1
  1153. End If
  1154.  
  1155. If MDIChild1B.List2(1).ListCount < num Then
  1156. patrecord.mdi2.fd18 = MDIChild1B.List2(1).List(17)
  1157. num = num + 1
  1158. End If
  1159.  
  1160. If MDIChild1B.List2(1).ListCount < num Then
  1161. patrecord.mdi2.fd19 = MDIChild1B.List2(1).List(18)
  1162. num = num + 1
  1163. End If
  1164.  
  1165. If MDIChild1B.List2(1).ListCount < num Then
  1166. patrecord.mdi2.fd20 = MDIChild1B.List2(1).List(19)
  1167. num = num + 1
  1168. End If
  1169. patrecord.mdi2count = num
  1170. '******************************************************************
  1171. num = 0
  1172. If MDIChild1C.List3(1).ListCount < num Then
  1173. patrecord.mdi3.fd1 = MDIChild1C.List3(1).List(0)
  1174. num = num + 1
  1175. End If
  1176.  
  1177. If MDIChild1C.List3(1).ListCount < num Then
  1178. patrecord.mdi3.fd2 = MDIChild1C.List3(1).List(1)
  1179. num = num + 1
  1180. End If
  1181.  
  1182. If MDIChild1C.List3(1).ListCount < num Then
  1183. patrecord.mdi3.fd3 = MDIChild1C.List3(1).List(2)
  1184. num = num + 1
  1185. End If
  1186.  
  1187. If MDIChild1C.List3(1).ListCount < num Then
  1188. patrecord.mdi3.fd4 = MDIChild1C.List3(1).List(3)
  1189. num = num + 1
  1190. End If
  1191.  
  1192. If MDIChild1C.List3(1).ListCount < num Then
  1193. patrecord.mdi3.fd5 = MDIChild1C.List3(1).List(4)
  1194. num = num + 1
  1195. End If
  1196.  
  1197. If MDIChild1C.List3(1).ListCount < num Then
  1198. patrecord.mdi3.fd6 = MDIChild1C.List3(1).List(5)
  1199. num = num + 1
  1200. End If
  1201.  
  1202. If MDIChild1C.List3(1).ListCount < num Then
  1203. patrecord.mdi3.fd7 = MDIChild1C.List3(1).List(6)
  1204. num = num + 1
  1205. End If
  1206.  
  1207. If MDIChild1C.List3(1).ListCount < num Then
  1208. patrecord.mdi3.fd8 = MDIChild1C.List3(1).List(7)
  1209. num = num + 1
  1210. End If
  1211.  
  1212. If MDIChild1C.List3(1).ListCount < num Then
  1213. patrecord.mdi3.fd9 = MDIChild1C.List3(1).List(8)
  1214. num = num + 1
  1215. End If
  1216.  
  1217. If MDIChild1C.List3(1).ListCount < num Then
  1218. patrecord.mdi3.fd10 = MDIChild1C.List3(1).List(9)
  1219. num = num + 1
  1220. End If
  1221.  
  1222. If MDIChild1C.List3(1).ListCount < num Then
  1223. patrecord.mdi3.fd11 = MDIChild1C.List3(1).List(10)
  1224. num = num + 1
  1225. End If
  1226.  
  1227. If MDIChild1C.List3(1).ListCount < num Then
  1228. patrecord.mdi3.fd12 = MDIChild1C.List3(1).List(11)
  1229. num = num + 1
  1230. End If
  1231.  
  1232. If MDIChild1C.List3(1).ListCount < num Then
  1233. patrecord.mdi3.fd13 = MDIChild1C.List3(1).List(12)
  1234. num = num + 1
  1235. End If
  1236.  
  1237. If MDIChild1C.List3(1).ListCount < num Then
  1238. patrecord.mdi3.fd14 = MDIChild1C.List3(1).List(13)
  1239. num = num + 1
  1240. End If
  1241.  
  1242. If MDIChild1C.List3(1).ListCount < num Then
  1243. patrecord.mdi3.fd15 = MDIChild1C.List3(1).List(14)
  1244. num = num + 1
  1245. End If
  1246.  
  1247. If MDIChild1C.List3(1).ListCount < num Then
  1248. patrecord.mdi3.fd16 = MDIChild1C.List3(1).List(15)
  1249. num = num + 1
  1250. End If
  1251.  
  1252. If MDIChild1C.List3(1).ListCount < num Then
  1253. patrecord.mdi3.fd17 = MDIChild1C.List3(1).List(16)
  1254. num = num + 1
  1255. End If
  1256.  
  1257. If MDIChild1C.List3(1).ListCount < num Then
  1258. patrecord.mdi3.fd18 = MDIChild1C.List3(1).List(17)
  1259. num = num + 1
  1260. End If
  1261.  
  1262. If MDIChild1C.List3(1).ListCount < num Then
  1263. patrecord.mdi3.fd19 = MDIChild1C.List3(1).List(18)
  1264. num = num + 1
  1265. End If
  1266.  
  1267. If MDIChild1C.List3(1).ListCount < num Then
  1268. patrecord.mdi3.fd20 = MDIChild1C.List3(1).List(19)
  1269. num = num + 1
  1270. End If
  1271. patrecord.mdi3count = num
  1272. '******************************************************************
  1273. num = 0
  1274. If summary.List2.ListCount < num Then
  1275. patrecord.sum1.fd1 = summary.List2.List(0)
  1276. num = num + 1
  1277. Else
  1278. GoTo donesum
  1279. End If
  1280. If summary.List2.ListCount < num Then
  1281. patrecord.sum1.fd2 = summary.List2.List(1)
  1282. num = num + 1
  1283. Else
  1284. GoTo donesum
  1285. End If
  1286.  
  1287. If summary.List2.ListCount < num Then
  1288. patrecord.sum1.fd3 = summary.List2.List(2)
  1289. num = num + 1
  1290. Else
  1291. GoTo donesum
  1292. End If
  1293.  
  1294. If summary.List2.ListCount < num Then
  1295. patrecord.sum1.fd4 = summary.List2.List(3)
  1296. num = num + 1
  1297. Else
  1298. GoTo donesum
  1299. End If
  1300.  
  1301. If summary.List2.ListCount < num Then
  1302. patrecord.sum1.fd5 = summary.List2.List(4)
  1303. num = num + 1
  1304. Else
  1305. GoTo donesum
  1306. End If
  1307.  
  1308. If summary.List2.ListCount < num Then
  1309. patrecord.sum1.fd6 = summary.List2.List(5)
  1310. num = num + 1
  1311. Else
  1312. GoTo donesum
  1313. End If
  1314.  
  1315. If summary.List2.ListCount < num Then
  1316. patrecord.sum1.fd7 = summary.List2.List(6)
  1317. num = num + 1
  1318. Else
  1319. GoTo donesum
  1320. End If
  1321.  
  1322. If summary.List2.ListCount < num Then
  1323. patrecord.sum1.fd8 = summary.List2.List(7)
  1324. num = num + 1
  1325. Else
  1326. GoTo donesum
  1327. End If
  1328.  
  1329. If summary.List2.ListCount < num Then
  1330. patrecord.sum1.fd9 = summary.List2.List(8)
  1331. num = num + 1
  1332. Else
  1333. GoTo donesum
  1334. End If
  1335.  
  1336. If summary.List2.ListCount < num Then
  1337. patrecord.sum1.fd10 = summary.List2.List(9)
  1338. num = num + 1
  1339. Else
  1340. GoTo donesum
  1341. End If
  1342.  
  1343. If summary.List2.ListCount < num Then
  1344. patrecord.sum1.fd11 = summary.List2.List(10)
  1345. num = num + 1
  1346. Else
  1347. GoTo donesum
  1348. End If
  1349.  
  1350. If summary.List2.ListCount < num Then
  1351. patrecord.sum1.fd12 = summary.List2.List(11)
  1352. num = num + 1
  1353. Else
  1354. GoTo donesum
  1355. End If
  1356.  
  1357. If summary.List2.ListCount < num Then
  1358. patrecord.sum1.fd13 = summary.List2.List(12)
  1359. num = num + 1
  1360. Else
  1361. GoTo donesum
  1362. End If
  1363.  
  1364. If summary.List2.ListCount < num Then
  1365. patrecord.sum1.fd14 = summary.List2.List(13)
  1366. num = num + 1
  1367. Else
  1368. GoTo donesum
  1369. End If
  1370.  
  1371. If summary.List2.ListCount < num Then
  1372. patrecord.sum1.fd15 = summary.List2.List(14)
  1373. num = num + 1
  1374. Else
  1375. GoTo donesum
  1376. End If
  1377.  
  1378. If summary.List2.ListCount < num Then
  1379. patrecord.sum1.fd16 = summary.List2.List(15)
  1380. num = num + 1
  1381. Else
  1382. GoTo donesum
  1383. End If
  1384.  
  1385. If summary.List2.ListCount < num Then
  1386. patrecord.sum1.fd17 = summary.List2.List(16)
  1387. num = num + 1
  1388. Else
  1389. GoTo donesum
  1390. End If
  1391.  
  1392.  
  1393. If summary.List2.ListCount < num Then
  1394. patrecord.sum1.fd18 = summary.List2.List(17)
  1395. num = num + 1
  1396. Else
  1397. GoTo donesum
  1398. End If
  1399.  
  1400. If summary.List2.ListCount < num Then
  1401. patrecord.sum1.fd19 = summary.List2.List(18)
  1402. num = num + 1
  1403. Else
  1404. GoTo donesum
  1405. End If
  1406.  
  1407. If summary.List2.ListCount < num Then
  1408. patrecord.sum1.fd20 = summary.List2.List(20)
  1409. num = num + 1
  1410. Else
  1411. GoTo donesum
  1412. End If
  1413. donesum:
  1414. patrecord.sumcount = num
  1415.  
  1416.  
  1417. End Sub
  1418.  
  1419. Sub highlight (foo As Form, group As Integer, myindex As Integer)
  1420.  
  1421. Select Case group
  1422.  
  1423. Case 3
  1424.     For n = 0 To group - 1
  1425.     
  1426.     If n <> myindex And foo.Option3D1(n).ForeColor = &H0& Then
  1427.     foo.Option3D1(n).ForeColor = &HFF0000
  1428.     End If
  1429.     Next n
  1430.    foo.Option3D1(myindex).ForeColor = &H0&
  1431.  
  1432. Case 6
  1433.  
  1434.     For n = 0 To group - 1
  1435.     
  1436.     If n <> myindex And foo.Option3D4(n).ForeColor = &H0& Then
  1437.     foo.Option3D4(n).ForeColor = &HFF0000
  1438.     End If
  1439.     Next n
  1440.     foo.Option3D4(myindex).ForeColor = &H0&
  1441.  
  1442. Case 5
  1443.  
  1444.     For n = 0 To group - 1
  1445.     
  1446.     If n <> myindex And foo.Option3D10(n).ForeColor = &H0& Then
  1447.     foo.Option3D10(n).ForeColor = &HFF0000
  1448.     If n = 4 Then foo.Label5.ForeColor = &HFF0000
  1449.     End If
  1450.     Next n
  1451.  
  1452.     foo.Option3D10(myindex).ForeColor = &H0&
  1453.  
  1454. End Select
  1455.  
  1456. End Sub
  1457.  
  1458. ' COPYRIGHT:
  1459. '
  1460. '   (C) Copyright Microsoft Corp. 1993.  All rights reserved.
  1461. '
  1462. '   You have a royalty-free right to use, modify, reproduce and
  1463. '   distribute the Sample Files (and/or any modified version) in
  1464. '   any way you find useful, provided that you agree that
  1465. '   Microsoft has no warranty obligations or liability for any
  1466. '   Sample Application Files which are modified.
  1467. '
  1468. Sub main ()
  1469. admit.Show
  1470. End Sub
  1471.  
  1472. Sub menumode (fooey As Form)
  1473. menu1.Show 1
  1474. Select Case menuchoice
  1475. Case "new"
  1476. admit.Picture1.Cls
  1477. admit.Picture1.AutoRedraw = -1
  1478. admit.Picture1.Scale (0, 0)-(3, 4)
  1479. admit.Picture1.CurrentX = .8
  1480. admit.Picture1.CurrentY = 1.2
  1481. admit.Picture1.Print "CLICK"
  1482. admit.Picture1.CurrentX = 1
  1483. admit.Picture1.CurrentY = 2
  1484. admit.Picture1.Print " TO"
  1485. admit.Picture1.CurrentX = .6
  1486. admit.Picture1.CurrentY = 2.8
  1487. admit.Picture1.Print "RETURN"
  1488. clearoutine
  1489. admit.Show
  1490. If admit.Tag <> "cover" Then fooey.Hide
  1491. Case "one"
  1492. idform.Show
  1493. If fooey.Tag <> "id" Then fooey.Hide
  1494. Case "two"
  1495. assess1.Show
  1496. If fooey.Tag <> "admission" Then fooey.Hide
  1497. Case "three"
  1498. screen.MousePointer = 11
  1499. assess2.Show
  1500. If fooey.Tag <> "diagnosis" Then fooey.Hide
  1501. screen.MousePointer = 0
  1502. Case "four"
  1503. screen.MousePointer = 11
  1504. medhist.Show
  1505. If fooey.Tag <> "history" Then fooey.Hide
  1506. screen.MousePointer = 0
  1507. Case "five"
  1508. screen.MousePointer = 11
  1509. assess3.Show
  1510. If fooey.Tag <> "physical" Then fooey.Hide
  1511. screen.MousePointer = 0
  1512. Case "six"
  1513. screen.MousePointer = 11
  1514. MDIMForm.Show
  1515. If fooey.Tag <> "clinical" Then fooey.Hide
  1516. screen.MousePointer = 0
  1517. Case "seven"
  1518. screen.MousePointer = 11
  1519. summary.Show
  1520. If fooey.Tag <> "summary" Then fooey.Hide
  1521. screen.MousePointer = 0
  1522. Case "eight"
  1523. 'clear
  1524. dispose
  1525. Case "nine"
  1526. 'save
  1527. dispose
  1528. Case "ten"
  1529. 'exit
  1530. dispose
  1531. Case "eleven"
  1532. 'cancel
  1533. End Select
  1534. End Sub
  1535.  
  1536. Sub restorebody (tid$)
  1537. Static oldID As String
  1538. Static test As Integer
  1539.  
  1540.  
  1541.     If LTrim$(RTrim$(tid$)) <> LTrim$(RTrim$(oldID)) Then
  1542.    
  1543.         screen.MousePointer = 11
  1544.         assess3.Picture1.Picture = LoadPicture(tid$ + ".bmp")
  1545.         screen.MousePointer = 0
  1546.          test = -1
  1547.         End If
  1548. End Sub
  1549.  
  1550. Sub restoredata (cpID As Long)
  1551.  
  1552. ' set global string for load on demand
  1553. screen.MousePointer = 11
  1554. Open "health.dat" For Random As #1 Len = Len(patrecord)
  1555. numrecs = LOF(1) \ Len(patrecord)
  1556.     For n = 1 To numrecs
  1557.     Get #1, n, patrecord
  1558.         If cpID = patrecord.patid Then
  1559.         recindex = n
  1560.         Exit For
  1561.         End If
  1562.     Next n
  1563. Close #1
  1564.  
  1565.     If cpID = patrecord.patid Then
  1566.     fillfields
  1567.    On Error Resume Next   'kludge for now!!
  1568.     If Not newflag Then
  1569.     ID$ = Left$(LTrim$(Str$(cpID)), 4) + "body"
  1570.     inkID$ = Left$(LTrim$(Str$(cpID)), 4) + "ink"
  1571.     restorebody ID$
  1572.     summary.Picture1.Picture = LoadPicture(inkID$ + ".BMP")
  1573.     End If
  1574.  
  1575.     Else
  1576.     recindex = 0
  1577.     End If
  1578.  
  1579. screen.MousePointer = 0
  1580. End Sub
  1581.  
  1582. Sub savedata ()
  1583.  
  1584. getfields
  1585.  
  1586. On Error Resume Next
  1587. SavePicture summary.Picture1.Picture, LTrim$(RTrim$(inkID$)) + ".bmp"
  1588.  
  1589. Open "health.dat" For Random As #1 Len = Len(patrecord)
  1590. If recindex <> 0 Then
  1591. Put #1, recindex, patrecord
  1592. Else
  1593. Put #1, numrecs + 1, patrecord
  1594. End If
  1595.  
  1596. Close #1
  1597.  
  1598.  
  1599. End Sub
  1600.  
  1601. Sub saveproc ()
  1602.  
  1603. screen.MousePointer = 11
  1604. SavePicture assess3.Picture3.Image, LTrim$(RTrim$(ID$)) + ".bmp"
  1605. screen.MousePointer = 0
  1606.  
  1607.     savedata
  1608.  
  1609. End Sub
  1610.  
  1611. Function smartform (which As Integer) As Integer
  1612. If TYPECHECK Then
  1613. Select Case which
  1614.      Case 1
  1615.      If temprecord.sex <> 0 And temprecord.patid <> 0 Then
  1616.      ok.idf = -1
  1617.      smartform = -1
  1618.      End If
  1619.      Case 2
  1620.      If temprecord.dayt <> "" And temprecord.tyme <> "" And temprecord.theoption.opt1 And temprecord.theoption.opt4 And temprecord.theoption.opt10 And temprecord.chk1 And temprecord.chk2 Then
  1621.      ok.ass1 = -1
  1622.      smartform = -1
  1623.      End If
  1624.      Case 3
  1625.      If LTrim$(temprecord.name) <> "" And LTrim$(temprecord.relation) <> "" And LTrim$(temprecord.home) <> "" And LTrim$(temprecord.work) <> "" And LTrim$(temprecord.hed1) <> "" Then
  1626.      ok.ass2 = -1
  1627.      smartform = -1
  1628.      End If
  1629.      Case 4
  1630.      ok.medh = -1
  1631.      smartform = -1
  1632.      Case 5
  1633.      If picloc Then
  1634.      ok.ass3 = -1
  1635.      smartform = -1
  1636.      End If
  1637.      Case 6
  1638.      If MDIChild1A.List1(1).ListCount > 0 And MDIChild1B.List2(1).ListCount > 0 And MDIChild1C.List3(1).ListCount > 0 Then
  1639.      ok.mdif = -1
  1640.      smartform = -1
  1641.      End If
  1642.      Case 7
  1643.      If summary.List2.ListCount > 0 Then
  1644.      ok.sumf = -1
  1645.      smartform = -1
  1646.      End If
  1647.      End Select
  1648.     
  1649. Else
  1650. smartform = -1
  1651. End If
  1652. End Function
  1653.  
  1654. Function validID (IDstring As String) As Long
  1655. validID = 0
  1656. For n = 1 To Len(IDstring)
  1657.     If Mid$(IDstring, n, 1) <> "-" Then
  1658.     c$ = c$ + Mid$(IDstring, n, 1)
  1659.     End If
  1660. Next
  1661.     IDstring = c$
  1662.     
  1663.     ' Look for a match
  1664. For i = 1 To 3   'uses constants for testing
  1665.     If Val(LTrim$(RTrim$(IDstring))) = patientID(i) Then
  1666.     validID = patientID(i)
  1667.     found = -1
  1668.     Exit For
  1669.     End If
  1670. Next i
  1671. If Not found Then
  1672.     Open "health.dat" For Random As #1 Len = Len(patrecord)
  1673.     numrecs = LOF(1) \ Len(patrecord)
  1674.     For n = 1 To numrecs
  1675.     Get #1, n, patrecord
  1676.     If Val(LTrim$(RTrim$(IDstring))) = patrecord.patid Then
  1677.         recindex = n
  1678.         Exit For
  1679.         End If
  1680.     Next n
  1681.     Close #1
  1682.     If Val(LTrim$(RTrim$(IDstring))) = patrecord.patid Then
  1683.         validID = patrecord.patid
  1684.         ID$ = Left$(LTrim$(Str$(cpID)), 4) + "body"
  1685.         inkID$ = Left$(LTrim$(Str$(cpID)), 4) + "ink"
  1686.         Else
  1687.         recindex = 0
  1688.         End If
  1689. End If
  1690. End Function
  1691.  
  1692.