Released DG*5.3*759 SEQ #718 Extracted from mail message **KIDS**:DG*5.3*759^ **INSTALL NAME** DG*5.3*759 "BLD",7482,0) DG*5.3*759^REGISTRATION^0^3090519^y "BLD",7482,1,0) ^^1^1^3090512^ "BLD",7482,1,1,0) FIXES FOR PTF 501 DISPLAY AND WAIT LIST ERROR "BLD",7482,4,0) ^9.64PA^^ "BLD",7482,6) 6^ "BLD",7482,6.3) 21 "BLD",7482,"KRN",0) ^9.67PA^8989.52^19 "BLD",7482,"KRN",.4,0) .4 "BLD",7482,"KRN",.401,0) .401 "BLD",7482,"KRN",.402,0) .402 "BLD",7482,"KRN",.403,0) .403 "BLD",7482,"KRN",.5,0) .5 "BLD",7482,"KRN",.84,0) .84 "BLD",7482,"KRN",3.6,0) 3.6 "BLD",7482,"KRN",3.8,0) 3.8 "BLD",7482,"KRN",9.2,0) 9.2 "BLD",7482,"KRN",9.8,0) 9.8 "BLD",7482,"KRN",9.8,"NM",0) ^9.68A^3^2 "BLD",7482,"KRN",9.8,"NM",1,0) DGPTFM4^^0^B28140353 "BLD",7482,"KRN",9.8,"NM",3,0) VADPT0^^0^B13477796 "BLD",7482,"KRN",9.8,"NM","B","DGPTFM4",1) "BLD",7482,"KRN",9.8,"NM","B","VADPT0",3) "BLD",7482,"KRN",19,0) 19 "BLD",7482,"KRN",19,"NM",0) ^9.68A^^ "BLD",7482,"KRN",19.1,0) 19.1 "BLD",7482,"KRN",101,0) 101 "BLD",7482,"KRN",409.61,0) 409.61 "BLD",7482,"KRN",771,0) 771 "BLD",7482,"KRN",870,0) 870 "BLD",7482,"KRN",8989.51,0) 8989.51 "BLD",7482,"KRN",8989.52,0) 8989.52 "BLD",7482,"KRN",8994,0) 8994 "BLD",7482,"KRN","B",.4,.4) "BLD",7482,"KRN","B",.401,.401) "BLD",7482,"KRN","B",.402,.402) "BLD",7482,"KRN","B",.403,.403) "BLD",7482,"KRN","B",.5,.5) "BLD",7482,"KRN","B",.84,.84) "BLD",7482,"KRN","B",3.6,3.6) "BLD",7482,"KRN","B",3.8,3.8) "BLD",7482,"KRN","B",9.2,9.2) "BLD",7482,"KRN","B",9.8,9.8) "BLD",7482,"KRN","B",19,19) "BLD",7482,"KRN","B",19.1,19.1) "BLD",7482,"KRN","B",101,101) "BLD",7482,"KRN","B",409.61,409.61) "BLD",7482,"KRN","B",771,771) "BLD",7482,"KRN","B",870,870) "BLD",7482,"KRN","B",8989.51,8989.51) "BLD",7482,"KRN","B",8989.52,8989.52) "BLD",7482,"KRN","B",8994,8994) "BLD",7482,"QDEF") ^^^^^^^^^^YES "BLD",7482,"QUES",0) ^9.62^^ "BLD",7482,"REQB",0) ^9.611^2^2 "BLD",7482,"REQB",1,0) DG*5.3*664^1 "BLD",7482,"REQB",2,0) DG*5.3*688^1 "BLD",7482,"REQB","B","DG*5.3*664",1) "BLD",7482,"REQB","B","DG*5.3*688",2) "MBREQ") 0 "PKG",5,-1) 1^1 "PKG",5,0) REGISTRATION^DG^PATIENT REGISTRATION, ADMISSION, DISCHARGE, EMBOSSER "PKG",5,20,0) ^9.402P^^ "PKG",5,22,0) ^9.49I^1^1 "PKG",5,22,1,0) 5.3^2930813 "PKG",5,22,1,"PAH",1,0) 759^3090519^100850 "PKG",5,22,1,"PAH",1,1,0) ^^1^1^3090519 "PKG",5,22,1,"PAH",1,1,1,0) FIXES FOR PTF 501 DISPLAY AND WAIT LIST ERROR "QUES","XPF1",0) Y "QUES","XPF1","??") ^D REP^XPDH "QUES","XPF1","A") Shall I write over your |FLAG| File "QUES","XPF1","B") YES "QUES","XPF1","M") D XPF1^XPDIQ "QUES","XPF2",0) Y "QUES","XPF2","??") ^D DTA^XPDH "QUES","XPF2","A") Want my data |FLAG| yours "QUES","XPF2","B") YES "QUES","XPF2","M") D XPF2^XPDIQ "QUES","XPI1",0) YO "QUES","XPI1","??") ^D INHIBIT^XPDH "QUES","XPI1","A") Want KIDS to INHIBIT LOGONs during the install "QUES","XPI1","B") NO "QUES","XPI1","M") D XPI1^XPDIQ "QUES","XPM1",0) PO^VA(200,:EM "QUES","XPM1","??") ^D MG^XPDH "QUES","XPM1","A") Enter the Coordinator for Mail Group '|FLAG|' "QUES","XPM1","B") "QUES","XPM1","M") D XPM1^XPDIQ "QUES","XPO1",0) Y "QUES","XPO1","??") ^D MENU^XPDH "QUES","XPO1","A") Want KIDS to Rebuild Menu Trees Upon Completion of Install "QUES","XPO1","B") NO "QUES","XPO1","M") D XPO1^XPDIQ "QUES","XPZ1",0) Y "QUES","XPZ1","??") ^D OPT^XPDH "QUES","XPZ1","A") Want to DISABLE Scheduled Options, Menu Options, and Protocols "QUES","XPZ1","B") YES "QUES","XPZ1","M") D XPZ1^XPDIQ "QUES","XPZ2",0) Y "QUES","XPZ2","??") ^D RTN^XPDH "QUES","XPZ2","A") Want to MOVE routines to other CPUs "QUES","XPZ2","B") NO "QUES","XPZ2","M") D XPZ2^XPDIQ "RTN") 2 "RTN","DGPTFM4") 0^1^B28140353^B28277134 "RTN","DGPTFM4",1,0) DGPTFM4 ;ALB/MTC/ADL - PTF ENTRY/EDIT-2 ; 12/18/07 11:37am "RTN","DGPTFM4",2,0) ;;5.3;Registration;**114,195,397,510,565,775,664,759**;Aug 13, 1993;Build 21 "RTN","DGPTFM4",3,0) ;;ADL;Update for CSV Project;;Mar 26, 2003 "RTN","DGPTFM4",4,0) ; "RTN","DGPTFM4",5,0) S DGZM0=DGZM0+1 "RTN","DGPTFM4",6,0) EN N M3 D MOB:'$D(M) S M(DGZM0)=$S($D(M(DGZM0)):M(DGZM0),1:"") G NEXM:M(DGZM0)="" S (M3,M(DGZM0),M1)=$S($D(^DGPT(PTF,"M",+M(DGZM0),0)):^DGPT(PTF,"M",+M(DGZM0),0),1:"") "RTN","DGPTFM4",7,0) I $D(^DGPT(PTF,"M",+M(DGZM0),"P")) S $P(M(DGZM0),U,20)=^("P"),$P(M1,U,20)=^("P") "RTN","DGPTFM4",8,0) WR S DG300=$S($D(^DGPT(PTF,"M",+M(DGZM0),300)):^(300),1:"") "RTN","DGPTFM4",9,0) W @IOF,HEAD,?70 S Z="<501-"_DGZM0_">" D Z^DGPTFM I +M(DGZM0)=1 W !,?62,"Discharge Movement" "RTN","DGPTFM4",10,0) M S L=+$P(M1,U,10),Y=L D D^DGPTUTL W !! S Z=1 D Z W "Date of Move: " S Z=Y,Z1=20 D Z1 W "Losing Specialty: ",$E($S($D(^DIC(42.4,+$P(M1,U,2),0)):$P(^(0),U,1),1:""),1,25) "RTN","DGPTFM4",11,0) W !," Leave days: ",$P(M1,U,3),?44,"Pass days: ",$P(M1,U,4) "RTN","DGPTFM4",12,0) W !,"Treated for SC Condition: ",$S($P(M3,U,18)=1:"Yes",1:"No") "RTN","DGPTFM4",13,0) N NL S NL=0 "RTN","DGPTFM4",14,0) I $P(M3,U,31)'="" W @($S(NL#2:"!",1:"?37")),"Potentially Related to Combat: ",$S($P(M3,U,31)="Y":"Yes",1:"No") S NL=NL+1 "RTN","DGPTFM4",15,0) I $P(M3,U,26)'="" W @($S(NL#2:"!",1:"?37")),"Treated for AO Condition: ",$S($P(M3,U,26)="Y":"Yes",1:"No") S NL=NL+1 "RTN","DGPTFM4",16,0) I $P(M3,U,27)'="" W @($S(NL#2:"!",1:"?37")),"Treated for IR Condition: ",$S($P(M3,U,27)="Y":"Yes",1:"No") S NL=NL+1 "RTN","DGPTFM4",17,0) I $P(M3,U,28)'="" W @($S(NL#2:"!",1:"?37")),"Treated for service in SW Asia: ",$S($P(M3,U,28)="Y":"Yes",1:"No") S NL=NL+1 "RTN","DGPTFM4",18,0) ; added 6/17/98 for MST enhancement "RTN","DGPTFM4",19,0) I $P(M3,U,29)'="" W @($S(NL#2:"!",1:"?37")),"Treated for MST Condition: ",$S($P(M3,U,29)="Y":"Yes",1:"No") S NL=NL+1 "RTN","DGPTFM4",20,0) K DGNTARR "RTN","DGPTFM4",21,0) S DGNTARR=$$GETCUR^DGNTAPI(DFN,"DGNTARR") "RTN","DGPTFM4",22,0) I $P(M3,U,30)="",(",3,4,5,"[(","_$P($G(DGNTARR("STAT")),U)_",")) S $P(M3,U,30)="N" "RTN","DGPTFM4",23,0) I $P(M3,U,30)'="" W @($S(NL#2:"!",1:"?37")),"Treated for HEAD/NECK CA Condition: ",$S($P(M3,U,30)="Y":"Yes",1:"No") S NL=NL+1 "RTN","DGPTFM4",24,0) I $P(M3,U,32)'="" W @($S(NL#2:"!",1:"?37")),"Treated for Project 112/SHAD: ",$S($P(M3,U,32)="Y":"Yes",1:"No") "RTN","DGPTFM4",25,0) K NL "RTN","DGPTFM4",26,0) W !! S Z=2 D Z W " DX: " F I=1:1:11 S L=$P(M1,U,I+4) I L'=""&(I'=6) S DGPTTMP=$$ICDDX^ICDCODE(+L,$$GETDATE^ICDGTDRG(PTF)) D "RTN","DGPTFM4",27,0) . W $S(+DGPTTMP>0:$P(DGPTTMP,U,4)_" ("_$P(DGPTTMP,U,2)_")",1:"**********-"_L),!?17 "RTN","DGPTFM4",28,0) D PRN2^DGPTFM8:DG300]"" "RTN","DGPTFM4",29,0) I $P(M1,U,20) S DRG=$P(M1,U,20) W:DRG=998!(DRG=999)!((DRG=468!(DRG=469)!(DRG=470))&(+$P($G(M1),U,10)<3071001)) *7 W !!?14,"TRANSFER DRG: ",DRG D "RTN","DGPTFM4",30,0) . N DXD,DGDX "RTN","DGPTFM4",31,0) . S DXD=$$DRGD^ICDGTDRG(DRG,"DGDX",,$P(M1,U,10)),DGDS=0 "RTN","DGPTFM4",32,0) . F S DGDS=$O(DGDX(DGDS)) Q:'+DGDS Q:DGDX(DGDS)=" " W !,DGDX(DGDS) "RTN","DGPTFM4",33,0) JUMP K DG300 F I=$Y:1:21 W ! "RTN","DGPTFM4",34,0) X S DGNUM=$S($D(M(DGZM0+1)):501_"-"_(DGZM0+1),1:"MAS") G 501^DGPTFJC:DGST "RTN","DGPTFM4",35,0) W "Enter to continue, 1-2 to edit,",!,"'M' ",$S(DGPTFE:" to add a patient movement",1:"to edit Treat. Specialty"),", '^N' for screen N, or '^' to abort:<",DGNUM,">// " R X:DTIME "RTN","DGPTFM4",36,0) K DGNUM G Q:X="^",NEXM:X="",^DGPTFJ:X?1"^".E,M^DGPTFM1:X="M"!(X="m") "RTN","DGPTFM4",37,0) X1 I X[1!(X[2) S DR="[DG501"_$E("F",DGPTFE) X:(+M(DGZM0)=1) "S J=^DGPT(PTF,""M"",1,0) F I=11:1:15 I $P(J,U,I) S DR=DR_1" S DR=DR_"]",DGJUMP=X,DIE="^DGPT(",(DA,DGPTF)=PTF,DGMOV=+M(DGZM0) D ^DIE K M,DR,DIE D CHK501^DGPTSCAN K DGPTF,DGMOV "RTN","DGPTFM4",38,0) ; Determine if NTR HISTORY (#28.11) filer is called if question for "RTN","DGPTFM4",39,0) ; 'Treated for Head/Neck CA Condition:' is answered YES. "RTN","DGPTFM4",40,0) ; Only a NTR screening status of 3=PENDING DIAGNOSIS gets Filed. "RTN","DGPTFM4",41,0) I $P($G(M3),U,30)="Y",$P($G(DGNTARR("STAT")),U)=3 D "RTN","DGPTFM4",42,0) .S DGNTARR=$$FILEHNC^DGNTAPI1(DFN) "RTN","DGPTFM4",43,0) K DGNTARR "RTN","DGPTFM4",44,0) ;- update MT indicator after edit movement "RTN","DGPTFM4",45,0) N DGPMCA,DGPMAN D PM^DGPTUTL "RTN","DGPTFM4",46,0) I '$G(DGADM) S DGADM=+^DGPT(PTF,0) "RTN","DGPTFM4",47,0) D MT^DGPTUTL "RTN","DGPTFM4",48,0) G EN "RTN","DGPTFM4",49,0) PR W !,"Enter '^' to stop the display and edit of data",!,"'^N' to jump to screen #N (appears in upper right of screen ''",!," to continue on to the next screen or 1-2 to edit:" "RTN","DGPTFM4",50,0) W !?10,"1-",$S(DGPTFE:"Date of movement, Losing Specialty, ",1:""),"Leave and Pass days",!?10,"2-ICD DIAGNOSIS CODES" "RTN","DGPTFM4",51,0) W !,"You may also enter 1-2",! "RTN","DGPTFM4",52,0) R !!,"Enter : ",X:DTIME G WR "RTN","DGPTFM4",53,0) Q "RTN","DGPTFM4",54,0) NEXM S DGZM0=DGZM0+1 G ^DGPTFM:'$D(M(DGZM0)),EN "RTN","DGPTFM4",55,0) ADD S DGZM0=$S($D(DGZM0):DGZM0+1,1:0) S L=$S($D(^DGPT(PTF,"M",0)):^(0),1:"^45.02DA^^"),L1=$P(L,U,3) F I=1:1 Q:'$D(^DGPT(PTF,"M",L1+I)) "RTN","DGPTFM4",56,0) S DA(1)=PTF,DIC="^DGPT("_DA(1)_",""M"",",X=L1+I,DIC(0)="LMZQE" D ^DIC K DIC,DIE G ^DGPTFM:Y'>0 "RTN","DGPTFM4",57,0) S M(DGZM0)=L1+I S X="1-2" G X1 "RTN","DGPTFM4",58,0) Q "RTN","DGPTFM4",59,0) MOB S I=0 K M,M1,M2 S M2=0 F I1=1:1 S I=$O(^DGPT(PTF,"M",I)) Q:'I S M(I1)=^(I,0) "RTN","DGPTFM4",60,0) S PM=I1-1 D ORDER^DGPTF Q "RTN","DGPTFM4",61,0) Q G Q^DGPTF "RTN","DGPTFM4",62,0) Z I 'DGN S Z=$S(IOST="C-QUME"&($L(DGVI)'=2):Z,1:"["_Z_"]") W @DGVI,Z,@DGVO "RTN","DGPTFM4",63,0) E W " " "RTN","DGPTFM4",64,0) Q "RTN","DGPTFM4",65,0) Z1 F I=1:1:(Z1-$L(Z)) S Z=Z_" " "RTN","DGPTFM4",66,0) W Z "RTN","DGPTFM4",67,0) Q "RTN","DGPTFM4",68,0) R ;DELETE PROCEDURE RECORD "RTN","DGPTFM4",69,0) I '$D(^DGPT(PTF,"P")) G NOPROC "RTN","DGPTFM4",70,0) I $O(^DGPT(PTF,"P",0))']"" G NOPROC "RTN","DGPTFM4",71,0) S DGPNUM="" F DGPROC=0:0 S DGPROC=$O(P(DGPROC)) Q:'DGPROC S:$D(P(DGPROC,1)) DGPNUM=DGPNUM_","_DGPROC "RTN","DGPTFM4",72,0) S DGPNUM=DGPNUM_"," "RTN","DGPTFM4",73,0) ASKPRO W !!,"Delete procedure record <",$P(DGPNUM,",",2,99),"> : " R DGPROC:DTIME I DGPROC[U!(DGPROC="") K DGPNUM,DGPROC G ^DGPTFM "RTN","DGPTFM4",74,0) I DGPNUM'[(","_DGPROC_",") W !!,"Enter the record # to delete from the PTF file <",$P(DGPNUM,",",2,99),">",! G ASKPRO "RTN","DGPTFM4",75,0) K DA N DGJ "RTN","DGPTFM4",76,0) F DGJ=1:1 S DA=+$P(DGPROC,",",DGJ) Q:'DA S DA=$S($D(P(DA,1)):+P(DA,1),1:0) I DA S DA(1)=PTF,DIK="^DGPT("_PTF_",""P""," D ^DIK K DA W " ",$P(DGPROC,",",DGJ),"-DELETED***" H:'$P(DGPROC,",",DGJ+1) 2 "RTN","DGPTFM4",77,0) K DIK,DA,DGPROC,DGPNUM G ^DGPTFM "RTN","DGPTFM4",78,0) NOPROC W !!,*7,"No procedures to delete",! H 3 G ^DGPTFM "RTN","VADPT0") 0^3^B13477796^B13477759 "RTN","VADPT0",1,0) VADPT0 ;ALB/MRL/MJK,ERC - PATIENT VARIABLE ROUTINE DRIVER, CONT. ; 8/1/08 1:29pm "RTN","VADPT0",2,0) ;;5.3;Registration;**343,342,415,489,498,528,689,789,688,759**;Aug 13, 1993;Build 21 "RTN","VADPT0",3,0) ; "RTN","VADPT0",4,0) ;Initialize variables "RTN","VADPT0",5,0) N I1 "RTN","VADPT0",6,0) S U="^" D DT^DICRW:'$D(DT) "RTN","VADPT0",7,0) S VAERR=$S($G(DFN)="":1,'$D(^DPT(DFN,0)):1,1:0) "RTN","VADPT0",8,0) S Y=VAN'=13 I Y,$D(VAROOT)'[0,VAROOT]"" S Y=0,VAV=VAROOT K @VAV "RTN","VADPT0",9,0) I Y S:$S(VAN>9:1,'$D(VAHOW):0,1:VAHOW[2) VAV="^UTILITY("_""""_VAV_""""_","_$J_")" "RTN","VADPT0",10,0) D @VAN "RTN","VADPT0",11,0) Q K X,Y,VAC,VAS,VAV,VAW,VAN,I,VAX,VAZ Q "RTN","VADPT0",12,0) ; "RTN","VADPT0",13,0) INIT ; -- determine #'s or names then init array "RTN","VADPT0",14,0) ; "RTN","VADPT0",15,0) 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^26^27^28" "RTN","VADPT0",16,0) I VAN<10,$D(VAHOW),VAHOW[1 S VAS=$P($T(SS+VAN),";;",2) "RTN","VADPT0",17,0) I $D(VAN(1)) F I=1:1:VAN(1) S @VAV@($P(VAS,"^",I))="" "RTN","VADPT0",18,0) Q "RTN","VADPT0",19,0) ; "RTN","VADPT0",20,0) 1 ; -- [DEM] demos "RTN","VADPT0",21,0) D C1,INIT I 'VAERR D 1^VADPT1,13 Q "RTN","VADPT0",22,0) ; "RTN","VADPT0",23,0) 2 ; -- [OPD] other pt vars "RTN","VADPT0",24,0) D C2,INIT,2^VADPT1:'VAERR Q "RTN","VADPT0",25,0) ; "RTN","VADPT0",26,0) 3 ; -- [ADD] current address "RTN","VADPT0",27,0) D C3,INIT,3^VADPT1:'VAERR Q "RTN","VADPT0",28,0) ; "RTN","VADPT0",29,0) 4 ; -- [OAD] other pt vars "RTN","VADPT0",30,0) D C4,INIT,4^VADPT1:'VAERR Q "RTN","VADPT0",31,0) ; "RTN","VADPT0",32,0) 5 ; -- [INP] inpt data -v5 "RTN","VADPT0",33,0) D C5,INIT,5^VADPT2:'VAERR Q "RTN","VADPT0",34,0) ; "RTN","VADPT0",35,0) 6 ; -- [IN5] inpt data v5 "RTN","VADPT0",36,0) D C6,INIT F I=13:1:17 F I1=1:1:7 S @VAV@($P(VAS,"^",I),I1)="" "RTN","VADPT0",37,0) F I=1:1:3 S @VAV@($P(VAS,"^",19),I)="" "RTN","VADPT0",38,0) D 6^VADPT3:'VAERR Q "RTN","VADPT0",39,0) ; "RTN","VADPT0",40,0) 7 ; -- [ELIG] elig data "RTN","VADPT0",41,0) D C7,INIT F I=1:1:6 S @VAV@($P(VAS,"^",5),I)="" "RTN","VADPT0",42,0) D 7^VADPT4:'VAERR Q "RTN","VADPT0",43,0) ; "RTN","VADPT0",44,0) 8 ; -- [MB] $ benefits "RTN","VADPT0",45,0) D C8,INIT D 8^VADPT4:'VAERR Q "RTN","VADPT0",46,0) ; "RTN","VADPT0",47,0) 9 ; -- [SVC] service data "RTN","VADPT0",48,0) D C9,INIT F I=1:1:9 S @VAV@($P(VAS,"^",I),1)="",@VAV@($P(VAS,"^",I),2)="" "RTN","VADPT0",49,0) S @VAV@($P(VAS,"^",10),1)="" "RTN","VADPT0",50,0) F I=11:1:13 S @VAV@($P(VAS,"^",I))=0 "RTN","VADPT0",51,0) S @VAV@($P(VAS,"^",14),1)="" "RTN","VADPT0",52,0) S @VAV@($P(VAS,"^",4),3)="",@VAV@($P(VAS,"^",5),3)="" "RTN","VADPT0",53,0) F I=2,6,7,8 F I1=3,4,5 S @VAV@($P(VAS,"^",I),I1)="" "RTN","VADPT0",54,0) D 9^VADPT4:'VAERR Q "RTN","VADPT0",55,0) ; "RTN","VADPT0",56,0) 10 ; -- [REG] registration data "RTN","VADPT0",57,0) D C10,INIT D 10^VADPT5:'VAERR Q "RTN","VADPT0",58,0) ; "RTN","VADPT0",59,0) 11 ; -- [SDE] clinic enrollment data "RTN","VADPT0",60,0) D C11,INIT D 11^VADPT5:'VAERR Q "RTN","VADPT0",61,0) ; "RTN","VADPT0",62,0) 12 ; -- [SDA] appt data "RTN","VADPT0",63,0) D C12,INIT D 12^VADPT5:'VAERR Q "RTN","VADPT0",64,0) ; "RTN","VADPT0",65,0) 13 ; -- [PID] pt id's "RTN","VADPT0",66,0) S (VA("PID"),VA("BID"))="" D 13^VADPT6:'VAERR Q "RTN","VADPT0",67,0) ; "RTN","VADPT0",68,0) KVAR ; kill all vadpt data "RTN","VADPT0",69,0) K VAN "RTN","VADPT0",70,0) C1 K ^UTILITY("VADM",$J),VADM Q:$D(VAN) "RTN","VADPT0",71,0) C2 K ^UTILITY("VAPD",$J),VAPD Q:$D(VAN) "RTN","VADPT0",72,0) C3 K X S:$D(VAPA("P")) X("P")=VAPA("P") "RTN","VADPT0",73,0) S:$D(VAPA("CD")) X("CD")=VAPA("CD") "RTN","VADPT0",74,0) K ^UTILITY("VAPA",$J),VAPA "RTN","VADPT0",75,0) S:$D(X("P")) VAPA("P")=X("P") K X("P") "RTN","VADPT0",76,0) S:$D(X("CD")) VAPA("CD")=X("CD") K X Q:$D(VAN) "RTN","VADPT0",77,0) C4 K X S:$D(VAOA("A")) X("A")=VAOA("A") "RTN","VADPT0",78,0) K ^UTILITY("VAOA",$J),VAOA "RTN","VADPT0",79,0) S:$D(X("A")) VAOA("A")=X("A") K X Q:$D(VAN) "RTN","VADPT0",80,0) C5 K ^UTILITY("VAIN",$J),VAIN Q:$D(VAN) "RTN","VADPT0",81,0) C6 K X F I="D","E","L","M","V" I $D(VAIP(I)) S X(I)=VAIP(I) "RTN","VADPT0",82,0) S Y=$S('$D(VAIP("V")):"VAIP",VAIP("V")'?1A.E:"VAIP",1:VAIP("V")) K ^UTILITY(Y,$J),@Y "RTN","VADPT0",83,0) F I="D","E","L","M","V" I $D(X(I)) S VAIP(I)=X(I) "RTN","VADPT0",84,0) K X Q:$D(VAN) "RTN","VADPT0",85,0) C7 K ^UTILITY("VAEL",$J),VAEL Q:$D(VAN) "RTN","VADPT0",86,0) C8 K ^UTILITY("VAMB",$J),VAMB Q:$D(VAN) "RTN","VADPT0",87,0) C9 K ^UTILITY("VASV",$J),VASV Q:$D(VAN) "RTN","VADPT0",88,0) C10 K ^UTILITY("VARP",$J) Q:$D(VAN) "RTN","VADPT0",89,0) C11 K ^UTILITY("VAEN",$J) Q:$D(VAN) "RTN","VADPT0",90,0) C12 K ^UTILITY("VASD",$J) Q "RTN","VADPT0",91,0) C13 Q "RTN","VADPT0",92,0) ; "RTN","VADPT0",93,0) 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^26^27^28 "RTN","VADPT0",94,0) ;;NM^SS^DB^AG^SX^EX^RE^RA^RP^MS^ET^RC "RTN","VADPT0",95,0) ;;BC^BS^FN^MN^MM^OC^ES "RTN","VADPT0",96,0) ;;L1^L2^L3^CI^ST^ZP^CO^PN^TS^TE^Z4^CCA^CL1^CL2^CL3^CCI^CST^CZP^CCO^CCS^CCE^CTY^PR^PC^CT^CPR^CPC^CCT "RTN","VADPT0",97,0) ;;L1^L2^L3^CI^ST^ZP^CO^PN^NM^RE^Z4 "RTN","VADPT0",98,0) ;;AN^DR^TS^WL^RB^BS^AD^AT^AF^PT^AP "RTN","VADPT0",99,0) ;;MN^TT^MD^MT^WL^RB^DR^TS^MF^BS^RD^PT^AN^LN^PN^NN^DN^AP^FD "RTN","VADPT0",100,0) ;;EL^PS^SC^VT^IN^TY^CN^ES^MT "RTN","VADPT0",101,0) ;;AA^HB^SS^PE^MR^SI^DI^OR^GI "RTN","VADPT0",102,0) ;;VN^AO^IR^PW^CS^S1^S2^S3^PH^CV^OIF^OEF^UNK^SHD "VER") 8.0^22.0 "BLD",7482,6) ^718 **END** **END**