| [613] | 1 | VADPT0 ;ALB/MRL/MJK - PATIENT VARIABLE ROUTINE DRIVER, CONT.; 12 DEC 1988
|
|---|
| 2 | ;;5.3;Registration;**343,342,415,489,498,528,689**;Aug 13, 1993;Build 1
|
|---|
| 3 | ;
|
|---|
| 4 | ;Initialize variables
|
|---|
| 5 | N I1
|
|---|
| 6 | S U="^" D DT^DICRW:'$D(DT)
|
|---|
| 7 | S VAERR=$S('$D(DFN)#2:1,'$D(^DPT(DFN,0)):1,1:0)
|
|---|
| 8 | S Y=VAN'=13 I Y,$D(VAROOT)'[0,VAROOT]"" S Y=0,VAV=VAROOT K @VAV
|
|---|
| 9 | I Y S:$S(VAN>9:1,'$D(VAHOW):0,1:VAHOW[2) VAV="^UTILITY("_""""_VAV_""""_","_$J_")"
|
|---|
| 10 | D @VAN
|
|---|
| 11 | Q K X,Y,VAC,VAS,VAV,VAW,VAN,I,VAX,VAZ Q
|
|---|
| 12 | ;
|
|---|
| 13 | INIT ; -- determine #'s or names then init array
|
|---|
| 14 | ;
|
|---|
| 15 | S VAS="1^2^3^4^5^6^7^8^9^10^11^12^13^14^15^16^17^18^19^20^21^22^23^24^25"
|
|---|
| 16 | I VAN<10,$D(VAHOW),VAHOW[1 S VAS=$P($T(SS+VAN),";;",2)
|
|---|
| 17 | I $D(VAN(1)) F I=1:1:VAN(1) S @VAV@($P(VAS,"^",I))=""
|
|---|
| 18 | Q
|
|---|
| 19 | ;
|
|---|
| 20 | 1 ; -- [DEM] demos
|
|---|
| 21 | D C1,INIT I 'VAERR D 1^VADPT1,13 Q
|
|---|
| 22 | ;
|
|---|
| 23 | 2 ; -- [OPD] other pt vars
|
|---|
| 24 | D C2,INIT,2^VADPT1:'VAERR Q
|
|---|
| 25 | ;
|
|---|
| 26 | 3 ; -- [ADD] current address
|
|---|
| 27 | D C3,INIT,3^VADPT1:'VAERR Q
|
|---|
| 28 | ;
|
|---|
| 29 | 4 ; -- [OAD] other pt vars
|
|---|
| 30 | D C4,INIT,4^VADPT1:'VAERR Q
|
|---|
| 31 | ;
|
|---|
| 32 | 5 ; -- [INP] inpt data -v5
|
|---|
| 33 | D C5,INIT,5^VADPT2:'VAERR Q
|
|---|
| 34 | ;
|
|---|
| 35 | 6 ; -- [IN5] inpt data v5
|
|---|
| 36 | D C6,INIT F I=13:1:17 F I1=1:1:7 S @VAV@($P(VAS,"^",I),I1)=""
|
|---|
| 37 | F I=1:1:3 S @VAV@($P(VAS,"^",19),I)=""
|
|---|
| 38 | D 6^VADPT3:'VAERR Q
|
|---|
| 39 | ;
|
|---|
| 40 | 7 ; -- [ELIG] elig data
|
|---|
| 41 | D C7,INIT F I=1:1:6 S @VAV@($P(VAS,"^",5),I)=""
|
|---|
| 42 | D 7^VADPT4:'VAERR Q
|
|---|
| 43 | ;
|
|---|
| 44 | 8 ; -- [MB] $ benefits
|
|---|
| 45 | D C8,INIT D 8^VADPT4:'VAERR Q
|
|---|
| 46 | ;
|
|---|
| 47 | 9 ; -- [SVC] service data
|
|---|
| 48 | D C9,INIT F I=1:1:9 S @VAV@($P(VAS,"^",I),1)="",@VAV@($P(VAS,"^",I),2)=""
|
|---|
| 49 | F I=11:1:13 S @VAV@($P(VAS,"^",I))=0
|
|---|
| 50 | S @VAV@($P(VAS,"^",4),3)="",@VAV@($P(VAS,"^",5),3)=""
|
|---|
| 51 | F I=2,6,7,8 F I1=3,4,5 S @VAV@($P(VAS,"^",I),I1)=""
|
|---|
| 52 | D 9^VADPT4:'VAERR Q
|
|---|
| 53 | ;
|
|---|
| 54 | 10 ; -- [REG] registration data
|
|---|
| 55 | D C10,INIT D 10^VADPT5:'VAERR Q
|
|---|
| 56 | ;
|
|---|
| 57 | 11 ; -- [SDE] clinic enrollment data
|
|---|
| 58 | D C11,INIT D 11^VADPT5:'VAERR Q
|
|---|
| 59 | ;
|
|---|
| 60 | 12 ; -- [SDA] appt data
|
|---|
| 61 | D C12,INIT D 12^VADPT5:'VAERR Q
|
|---|
| 62 | ;
|
|---|
| 63 | 13 ; -- [PID] pt id's
|
|---|
| 64 | S (VA("PID"),VA("BID"))="" D 13^VADPT6:'VAERR Q
|
|---|
| 65 | ;
|
|---|
| 66 | KVAR ; kill all vadpt data
|
|---|
| 67 | K VAN
|
|---|
| 68 | C1 K ^UTILITY("VADM",$J),VADM Q:$D(VAN)
|
|---|
| 69 | C2 K ^UTILITY("VAPD",$J),VAPD Q:$D(VAN)
|
|---|
| 70 | C3 K X S:$D(VAPA("P")) X("P")=VAPA("P")
|
|---|
| 71 | S:$D(VAPA("CD")) X("CD")=VAPA("CD")
|
|---|
| 72 | K ^UTILITY("VAPA",$J),VAPA
|
|---|
| 73 | S:$D(X("P")) VAPA("P")=X("P") K X("P")
|
|---|
| 74 | S:$D(X("CD")) VAPA("CD")=X("CD") K X Q:$D(VAN)
|
|---|
| 75 | C4 K X S:$D(VAOA("A")) X("A")=VAOA("A")
|
|---|
| 76 | K ^UTILITY("VAOA",$J),VAOA
|
|---|
| 77 | S:$D(X("A")) VAOA("A")=X("A") K X Q:$D(VAN)
|
|---|
| 78 | C5 K ^UTILITY("VAIN",$J),VAIN Q:$D(VAN)
|
|---|
| 79 | C6 K X F I="D","E","L","M","V" I $D(VAIP(I)) S X(I)=VAIP(I)
|
|---|
| 80 | S Y=$S('$D(VAIP("V")):"VAIP",VAIP("V")'?1A.E:"VAIP",1:VAIP("V")) K ^UTILITY(Y,$J),@Y
|
|---|
| 81 | F I="D","E","L","M","V" I $D(X(I)) S VAIP(I)=X(I)
|
|---|
| 82 | K X Q:$D(VAN)
|
|---|
| 83 | C7 K ^UTILITY("VAEL",$J),VAEL Q:$D(VAN)
|
|---|
| 84 | C8 K ^UTILITY("VAMB",$J),VAMB Q:$D(VAN)
|
|---|
| 85 | C9 K ^UTILITY("VASV",$J),VASV Q:$D(VAN)
|
|---|
| 86 | C10 K ^UTILITY("VARP",$J) Q:$D(VAN)
|
|---|
| 87 | C11 K ^UTILITY("VAEN",$J) Q:$D(VAN)
|
|---|
| 88 | C12 K ^UTILITY("VASD",$J) Q
|
|---|
| 89 | C13 Q
|
|---|
| 90 | ;
|
|---|
| 91 | SS ; 1^ 2^ 3^ 4^ 5^ 6^ 7^ 8^ 9^10^11^12^13^14^15^16^17^18^19^20^21^22^23^24^25
|
|---|
| 92 | ;;NM^SS^DB^AG^SX^EX^RE^RA^RP^MS^ET^RC
|
|---|
| 93 | ;;BC^BS^FN^MN^MM^OC^ES
|
|---|
| 94 | ;;L1^L2^L3^CI^ST^ZP^CO^PN^TS^TE^Z4^CCA^CL1^CL2^CL3^CCI^CST^CZP^CCO^CCS^CCE^CTY
|
|---|
| 95 | ;;L1^L2^L3^CI^ST^ZP^CO^PN^NM^RE^Z4
|
|---|
| 96 | ;;AN^DR^TS^WL^RB^BS^AD^AT^AF^PT^AP
|
|---|
| 97 | ;;MN^TT^MD^MT^WL^RB^DR^TS^MF^BS^RD^PT^AN^LN^PN^NN^DN^AP^FD
|
|---|
| 98 | ;;EL^PS^SC^VT^IN^TY^CN^ES^MT
|
|---|
| 99 | ;;AA^HB^SS^PE^MR^SI^DI^OR^GI
|
|---|
| 100 | ;;VN^AO^IR^PW^CS^S1^S2^S3^PH^OIF^OEF^VIS
|
|---|
