Released DG*5.3*790 SEQ #719 Extracted from mail message **KIDS**:DG*5.3*790^ **INSTALL NAME** DG*5.3*790 "BLD",8053,0) DG*5.3*790^REGISTRATION^0^3090724^y "BLD",8053,1,0) ^^6^6^3090512^ "BLD",8053,1,1,0) This patch corrects: "BLD",8053,1,2,0) 1. Correcting Record index of 3 fields in patient file "BLD",8053,1,3,0) to use DA instead of DFN. "BLD",8053,1,4,0) 2. Determination of radiation method for SVC^VADPT API. "BLD",8053,1,5,0) 3. Change Patient Type Update[DG PATIENT TYPE PARAMETER EDIT] option to "BLD",8053,1,6,0) prevent users from adding a new patient type. "BLD",8053,4,0) ^9.64PA^2^1 "BLD",8053,4,2,0) 2 "BLD",8053,4,2,2,0) ^9.641^2^1 "BLD",8053,4,2,2,2,0) PATIENT (File-top level) "BLD",8053,4,2,2,2,1,0) ^9.6411^.135^3 "BLD",8053,4,2,2,2,1,.133,0) EMAIL ADDRESS "BLD",8053,4,2,2,2,1,.134,0) PHONE NUMBER [CELLULAR] "BLD",8053,4,2,2,2,1,.135,0) PAGER NUMBER "BLD",8053,4,2,222) y^n^p^^^^n^^n "BLD",8053,4,2,224) "BLD",8053,4,"APDD",2,2) "BLD",8053,4,"APDD",2,2,.133) "BLD",8053,4,"APDD",2,2,.134) "BLD",8053,4,"APDD",2,2,.135) "BLD",8053,4,"B",2,2) "BLD",8053,6.3) 6 "BLD",8053,"KRN",0) ^9.67PA^779.2^20 "BLD",8053,"KRN",.4,0) .4 "BLD",8053,"KRN",.401,0) .401 "BLD",8053,"KRN",.402,0) .402 "BLD",8053,"KRN",.403,0) .403 "BLD",8053,"KRN",.5,0) .5 "BLD",8053,"KRN",.84,0) .84 "BLD",8053,"KRN",3.6,0) 3.6 "BLD",8053,"KRN",3.8,0) 3.8 "BLD",8053,"KRN",9.2,0) 9.2 "BLD",8053,"KRN",9.8,0) 9.8 "BLD",8053,"KRN",9.8,"NM",0) ^9.68A^1^1 "BLD",8053,"KRN",9.8,"NM",1,0) VADPT4^^0^B37063377 "BLD",8053,"KRN",9.8,"NM","B","VADPT4",1) "BLD",8053,"KRN",19,0) 19 "BLD",8053,"KRN",19,"NM",0) ^9.68A^1^1 "BLD",8053,"KRN",19,"NM",1,0) DG PATIENT TYPE PARAMETER EDIT^^0 "BLD",8053,"KRN",19,"NM","B","DG PATIENT TYPE PARAMETER EDIT",1) "BLD",8053,"KRN",19.1,0) 19.1 "BLD",8053,"KRN",101,0) 101 "BLD",8053,"KRN",409.61,0) 409.61 "BLD",8053,"KRN",771,0) 771 "BLD",8053,"KRN",779.2,0) 779.2 "BLD",8053,"KRN",870,0) 870 "BLD",8053,"KRN",8989.51,0) 8989.51 "BLD",8053,"KRN",8989.52,0) 8989.52 "BLD",8053,"KRN",8994,0) 8994 "BLD",8053,"KRN","B",.4,.4) "BLD",8053,"KRN","B",.401,.401) "BLD",8053,"KRN","B",.402,.402) "BLD",8053,"KRN","B",.403,.403) "BLD",8053,"KRN","B",.5,.5) "BLD",8053,"KRN","B",.84,.84) "BLD",8053,"KRN","B",3.6,3.6) "BLD",8053,"KRN","B",3.8,3.8) "BLD",8053,"KRN","B",9.2,9.2) "BLD",8053,"KRN","B",9.8,9.8) "BLD",8053,"KRN","B",19,19) "BLD",8053,"KRN","B",19.1,19.1) "BLD",8053,"KRN","B",101,101) "BLD",8053,"KRN","B",409.61,409.61) "BLD",8053,"KRN","B",771,771) "BLD",8053,"KRN","B",779.2,779.2) "BLD",8053,"KRN","B",870,870) "BLD",8053,"KRN","B",8989.51,8989.51) "BLD",8053,"KRN","B",8989.52,8989.52) "BLD",8053,"KRN","B",8994,8994) "BLD",8053,"QDEF") ^^^^^^^^^^YES "BLD",8053,"QUES",0) ^9.62^^ "BLD",8053,"REQB",0) ^9.611^2^2 "BLD",8053,"REQB",1,0) DG*5.3*688^1 "BLD",8053,"REQB",2,0) DG*5.3*712^1 "BLD",8053,"REQB","B","DG*5.3*688",1) "BLD",8053,"REQB","B","DG*5.3*712",2) "FIA",2) PATIENT "FIA",2,0) ^DPT( "FIA",2,0,0) 2I "FIA",2,0,1) y^n^p^^^^n^^n "FIA",2,0,10) "FIA",2,0,11) "FIA",2,0,"RLRO") "FIA",2,0,"VR") 5.3^DG "FIA",2,2) 1 "FIA",2,2,.133) "FIA",2,2,.134) "FIA",2,2,.135) "IX",2,2,"AVAFC133",0) 2^AVAFC133^This x-ref calls the DG FIELD MONITOR event point.^MU^^F^I^I^2^^^^^A "IX",2,2,"AVAFC133",.1,0) ^^5^5^3090724 "IX",2,2,"AVAFC133",.1,1,0) This cross-reference activates the DG FIELD MONITOR event point. "IX",2,2,"AVAFC133",.1,2,0) Applications that wish to monitor edit activity related to this field may "IX",2,2,"AVAFC133",.1,3,0) subscribe to that event point and take action as indicated by the changes "IX",2,2,"AVAFC133",.1,4,0) that occur. Refer to the DG FIELD MONITOR protocol for a description of "IX",2,2,"AVAFC133",.1,5,0) the information available at the time of the event. "IX",2,2,"AVAFC133",1) D FC^DGFCPROT(.DA,2,.133,"SET",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q "IX",2,2,"AVAFC133",2) D FC^DGFCPROT(.DA,2,.133,"KILL",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q "IX",2,2,"AVAFC133",11.1,0) ^.114IA^1^1 "IX",2,2,"AVAFC133",11.1,1,0) 1^F^2^.133^^^F "IX",2,2,"AVAFC134",0) 2^AVAFC134^This x-ref calls the DG FIELD MONITOR event point.^MU^^F^I^I^2^^^^^A "IX",2,2,"AVAFC134",.1,0) ^^5^5^3090724 "IX",2,2,"AVAFC134",.1,1,0) This cross-reference activates the DG FIELD MONITOR event point. "IX",2,2,"AVAFC134",.1,2,0) Applications that wish to monitor edit activity related to this field may "IX",2,2,"AVAFC134",.1,3,0) subscribe to that event point and take action as indicated by the changes "IX",2,2,"AVAFC134",.1,4,0) that occur. Refer to the DG FIELD MONITOR protocol for a description of "IX",2,2,"AVAFC134",.1,5,0) the information available at the time of the event. "IX",2,2,"AVAFC134",1) D FC^DGFCPROT(.DA,2,.134,"SET",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q "IX",2,2,"AVAFC134",2) D FC^DGFCPROT(.DA,2,.134,"KILL",$H,$G(DUZ),.X,.X1,.X2,$G(XQY0)) Q "IX",2,2,"AVAFC134",11.1,0) ^.114IA^1^1 "IX",2,2,"AVAFC134",11.1,1,0) 1^F^2^.134^^^F "IX",2,2,"AXENR13",0) 2^AXENR13^TRIGGER A MESSAGE FOR ANY CHANGE TO THESE FIELDS^MU^^R^R^I^2^^^^^A "IX",2,2,"AXENR13",.1,0) ^^2^2^3060213^ "IX",2,2,"AXENR13",.1,1,0) This cross-reference will trigger a message to the HEC anytime one of the "IX",2,2,"AXENR13",.1,2,0) related fields is changed. "IX",2,2,"AXENR13",1) D EVENT^IVMPLOG(DA) "IX",2,2,"AXENR13",2) D EVENT^IVMPLOG(DA) "IX",2,2,"AXENR13",11.1,0) ^.114IA^3^3 "IX",2,2,"AXENR13",11.1,1,0) 1^F^2^.133^^^F "IX",2,2,"AXENR13",11.1,2,0) 2^F^2^.134^^^F "IX",2,2,"AXENR13",11.1,3,0) 3^F^2^.135^^^F "KRN",19,1194,-1) 0^1 "KRN",19,1194,0) DG PATIENT TYPE PARAMETER EDIT^Patient Type Update^^E^^DG SUPERVISOR^^^^^^REGISTRATION "KRN",19,1194,1,0) ^^10^10^2920324^^^ "KRN",19,1194,1,1,0) This option is used to update the PATIENT TYPE (#391) file. The "KRN",19,1194,1,2,0) prompts which are preceded by the word SHOW are used to determine "KRN",19,1194,1,3,0) which registration screens should be shown for that specific patient "KRN",19,1194,1,4,0) type. The prompts which are preceded by the word ASK are used to "KRN",19,1194,1,5,0) identify those data groups within the SHOW screens which are editable. "KRN",19,1194,1,6,0) The IGNORE VETERAN PROMPTS prompt is used to permit users to answer "KRN",19,1194,1,7,0) 'veteran' only questions during registration even if that patient type "KRN",19,1194,1,8,0) may be identified as not being a veteran, i.e., military retireee. "KRN",19,1194,1,9,0) All prompts are answerable by entering either a '1' for YES or a '0' "KRN",19,1194,1,10,0) for NO. A NULL response is assumed to mean NO. "KRN",19,1194,30) DG(391, "KRN",19,1194,31) AEMQ "KRN",19,1194,50) DG(391, "KRN",19,1194,51) [DG PATIENT TYPE] "KRN",19,1194,"U") PATIENT TYPE UPDATE "MBREQ") 0 "ORD",18,19) 19;18;;;OPT^XPDTA;OPTF1^XPDIA;OPTE1^XPDIA;OPTF2^XPDIA;;OPTDEL^XPDIA "ORD",18,19,0) OPTION "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) 790^3090724 "PKG",5,22,1,"PAH",1,1,0) ^^6^6^3090724 "PKG",5,22,1,"PAH",1,1,1,0) This patch corrects: "PKG",5,22,1,"PAH",1,1,2,0) 1. Correcting Record index of 3 fields in patient file "PKG",5,22,1,"PAH",1,1,3,0) to use DA instead of DFN. "PKG",5,22,1,"PAH",1,1,4,0) 2. Determination of radiation method for SVC^VADPT API. "PKG",5,22,1,"PAH",1,1,5,0) 3. Change Patient Type Update[DG PATIENT TYPE PARAMETER EDIT] option to "PKG",5,22,1,"PAH",1,1,6,0) prevent users from adding a new patient type. "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") 1 "RTN","VADPT4") 0^1^B37063377^B35665898 "RTN","VADPT4",1,0) VADPT4 ;ALB/MRL/MJK,ERC - PATIENT VARIABLES; 12 DEC 1988 "RTN","VADPT4",2,0) ;;5.3;Registration;**343,342,528,689,688,790**;Aug 13, 1993;Build 6 "RTN","VADPT4",3,0) 7 ;Eligibility [ELIG] "RTN","VADPT4",4,0) F I=.15,.3,.31,.32,.36,.361,"INE","TYPE","VET" S VAX(I)=$S($D(^DPT(DFN,I)):^(I),1:"") "RTN","VADPT4",5,0) S VAZ=$P(VAX(.36),"^",1) S:$D(^DIC(8,+VAZ,0)) VAZ=VAZ_"^"_$P(^(0),"^",1) S @VAV@($P(VAS,"^",1))=VAZ "RTN","VADPT4",6,0) S VAX=0 F I=0:0 S VAX=$O(^DPT(DFN,"E",VAX)) Q:VAX'>0 S VAZ=VAX I $D(^DIC(8,+VAZ,0)),+@VAV@($P(VAS,"^"))'=VAZ S VAZ=VAZ_"^"_$P(^DIC(8,+VAZ,0),"^") S @VAV@($P(VAS,"^",1),VAX)=VAZ "RTN","VADPT4",7,0) S VAZ=$P(VAX(.32),"^",3) S:$D(^DIC(21,+VAZ,0)) VAZ=VAZ_"^"_$P(^(0),"^",1) S @VAV@($P(VAS,"^",2))=VAZ "RTN","VADPT4",8,0) S VAZ=$S($P(VAX(.3),"^",1)="Y":1,1:0) S:VAZ VAZ=VAZ_"^"_$P(VAX(.3),"^",2) S @VAV@($P(VAS,"^",3))=VAZ "RTN","VADPT4",9,0) S @VAV@($P(VAS,"^",4))=$S(VAX("VET")="Y":1,1:0),VAZ=$S(+$P(VAX(.15),"^",2):0,1:1),@VAV@($P(VAS,"^",5))=VAZ "RTN","VADPT4",10,0) I VAZ F I=1:1:6 S @VAV@($P(VAS,"^",5),I)="" G 71 "RTN","VADPT4",11,0) S VAZ=$P(VAX(.15),"^",2),Y=VAZ X ^DD("DD") S @VAV@($P(VAS,"^",5),1)=VAZ_"^"_Y,VAZ=$P(VAX("INE"),"^",1) S:VAZ]"" VAZ=VAZ_"^"_$P("VAMC^REGIONAL OFFICE^RPC","^",VAZ) S @VAV@($P(VAS,"^",5),2)=VAZ "RTN","VADPT4",12,0) S @VAV@($P(VAS,"^",5),3)=$P(VAX("INE"),"^",3),VAZ=$P(VAX("INE"),"^",4) S:$D(^DIC(5,+VAZ,0)) VAZ=VAZ_"^"_$P(^(0),"^",1) S @VAV@($P(VAS,"^",5),4)=VAZ "RTN","VADPT4",13,0) S @VAV@($P(VAS,"^",5),5)=$P(VAX("INE"),"^",6),@VAV@($P(VAS,"^",5),6)=$P(VAX(.3),"^",7) "RTN","VADPT4",14,0) 71 S VAZ=VAX("TYPE") S:$D(^DG(391,+VAZ,0)) VAZ=VAZ_"^"_$P(^(0),"^",1) S @VAV@($P(VAS,"^",6))=VAZ "RTN","VADPT4",15,0) S @VAV@($P(VAS,"^",7))=$P(VAX(.31),"^",3),VAZ=$P(VAX(.361),"^",1) S:VAZ]"" VAZ=VAZ_"^"_$S(VAZ="V":"VERIFIED",VAZ="P":"PENDING VERIFICATION",VAZ="R":"PENDING RE-VERIFICATION",1:"") S @VAV@($P(VAS,"^",8))=VAZ "RTN","VADPT4",16,0) I $D(^DPT(DFN,0)) S VAX=$P(^(0),"^",14),VAX=$G(^DG(408.32,+VAX,0)) I VAX]"" S @VAV@($P(VAS,"^",9))=$P(VAX,"^",2)_"^"_$P(VAX,"^",1) "RTN","VADPT4",17,0) Q "RTN","VADPT4",18,0) ; "RTN","VADPT4",19,0) 8 ;Monetary Benefits [MB] "RTN","VADPT4",20,0) N DGTOTVA "RTN","VADPT4",21,0) S @VAV@($P(VAS,"^",6))=0 ; SSI no longer supported "RTN","VADPT4",22,0) D ALL^DGMTU21(DFN,"V",DT,"I") "RTN","VADPT4",23,0) S VAX=$G(^DGMT(408.21,+$G(DGINC("V")),0)) F I=8,11,13 S @VAV@($S(I=8:$P(VAS,"^",3),I=11:$P(VAS,"^",5),1:$P(VAS,"^",8)))=$S($P(VAX,"^",I)'="":"1^"_$P(VAX,"^",I),1:0) "RTN","VADPT4",24,0) S VAX=$G(^DPT(DFN,.362)) "RTN","VADPT4",25,0) S DGTOTVA=$P(VAX,U,20) "RTN","VADPT4",26,0) F I=12,13,14 S @VAV@($S(I=12:$P(VAS,"^",1),(I=13):$P(VAS,"^",2),1:$P(VAS,"^",4)))=$S($P(VAX,"^",I)="Y":1_U_DGTOTVA,1:0) "RTN","VADPT4",27,0) S I=17 S @VAV@($P(VAS,"^",9))=$S($P(VAX,"^",17)="Y":1_U_$P(VAX,U,6),1:0) "RTN","VADPT4",28,0) S VAX=$G(^DPT(DFN,.3)) S @VAV@($P(VAS,"^",7))=$S($P(VAX,"^",11)="Y":1_U_DGTOTVA,1:0) "RTN","VADPT4",29,0) K DGDEP,DGREL,DGINC,DGINR Q "RTN","VADPT4",30,0) ; "RTN","VADPT4",31,0) 9 ;Service information "RTN","VADPT4",32,0) F I=.32,.321,.3291,.52,.53 S VAX(I)=$S($D(^DPT(DFN,I)):^(I),1:"") "RTN","VADPT4",33,0) S VAX("N")=.321 F I=1,2,3 S VAX(3)=I,VAZ=$S($P(VAX(.321),"^",I)="Y":1,1:0),@VAV@($P(VAS,"^",VAX(3)))=VAZ I VAZ S VAX(1)=$S(I=1:"4^5",I=2:"7^9^8",1:11),VAX(4)=0 D 91 "RTN","VADPT4",34,0) S VAX("N")=.52 F I=5,11 S VAX(3)=$S(I=5:4,1:5),VAX(1)=$S(I=5:"7^8",1:"13^14"),VAZ=$S($P(VAX(.52),"^",I)="Y":1,1:0),@VAV@($P(VAS,"^",VAX(3)))=VAZ I VAZ S VAX(4)=0 D 91 "RTN","VADPT4",35,0) ;Combat Vet "RTN","VADPT4",36,0) S VAX(3)=10,VAX(1)="15",VAZ=$S($P(VAX(.52),U,15)]"":1,1:0),@VAV@($P(VAS,U,VAX(3)))=VAZ I VAZ S VAX(4)=0 D 91 "RTN","VADPT4",37,0) F I=6,7,8 S @VAV@($P(VAS,"^",I))="" F VAX(1)=1:1:6 S @VAV@($P(VAS,"^",I),VAX(1))="" "RTN","VADPT4",38,0) S VAX("N")=.32,VAZ=$S($P(VAX(.32),"^",5)]"":1,1:0),@VAV@($P(VAS,"^",6))=VAZ I VAZ,$P(VAX(.32),"^",19)="Y" S VAZ=1,@VAV@($P(VAS,"^",7))=VAZ I VAZ,$P(VAX(.32),"^",20)="Y" S @VAV@($P(VAS,"^",8))=1 "RTN","VADPT4",39,0) F I=6,7,8 I @VAV@($P(VAS,"^",I)) S VAX(3)=I,VAX(1)=$S(I=6:"6^7",I=7:"11^12",1:"16^17"),VAX(4)=3 D 91 "RTN","VADPT4",40,0) S VAX("N")=.3291 "RTN","VADPT4",41,0) F I=6,7,8 I @VAV@($P(VAS,"^",I)) S VAX(3)=I,VAX(1)=I-5,VAX(4)=6 D 94 "RTN","VADPT4",42,0) S VAX("N")=.53,VAX(3)=9,VAX(1)="2^3",VAZ=$S($P(VAX(.53),U)="Y":1,$P(VAX(.53),U)="N":1,1:0),@VAV@($P(VAS,U,VAX(3)))=$S($P(VAX(.53),U)="Y":1,$P(VAX(.53),U)="N":0,1:"") I VAZ S VAX(4)=0 D 93 "RTN","VADPT4",43,0) S VAX("N")=.3215,VAZ=$$GET^DGENOEIF(DFN,.VAZ,1) "RTN","VADPT4",44,0) ;OEF/OIF "RTN","VADPT4",45,0) F I=11,12,13 S @VAV@(I)=+$G(VAZ($P("OIF^OEF^UNK",U,I-10),"COUNT")) "RTN","VADPT4",46,0) S VAX(2)=11 "RTN","VADPT4",47,0) F I="OIF","OEF","UNK" S VAX=0 F S VAX=$O(VAZ(I,VAX)) S:'VAX VAX(2)=VAX(2)+1 Q:'VAX S VAX(3)=0 D "RTN","VADPT4",48,0) . N Z "RTN","VADPT4",49,0) . F VAX(1)="LOC","FR","TO" S VAX(3)=VAX(3)+1,Z=$G(VAZ(I,VAX,VAX(1))),@VAV@(VAX(2),VAX,VAX(3))=Z D 95 "RTN","VADPT4",50,0) ;SHAD - added with DG*5.3*688 "RTN","VADPT4",51,0) S VAX(3)=14,VAZ=$S($P(VAX(.321),U,15)]"":1,1:0),@VAV@($P(VAS,U,VAX(3)))=VAZ I VAZ S @VAV@($P(VAS,U,VAX(3)),1)=$S($P(VAX(.321),U,15)=1:"1^YES",1:"0^NO") "RTN","VADPT4",52,0) Q "RTN","VADPT4",53,0) ; "RTN","VADPT4",54,0) 91 ;date fields "RTN","VADPT4",55,0) F VAX(2)=1:1 S VAX(4)=VAX(4)+1,X=+$P(VAX(1),"^",VAX(2)) Q:'X S X=$P(VAX(VAX("N")),"^",X),VAZ=X,Y=VAZ X:Y]"" ^DD("DD") S @VAV@($P(VAS,"^",VAX(3)),VAX(4))=$S(VAZ]"":VAZ_"^"_Y,1:"") "RTN","VADPT4",56,0) Q:VAX(3)=1!(VAX(3)=9)!(VAX(3)=10) "RTN","VADPT4",57,0) ;some sets of codes "RTN","VADPT4",58,0) I VAX(3)=2 S @VAV@($P(VAS,"^",2),4)=$P(VAX(.321),"^",10) S (X,VAZ)=$P(VAX(.321),"^",13) S:X]"" VAZ=VAZ_"^"_$S(X="K":"KOREAN DMZ",1:"VIETNAM") S @VAV@($P(VAS,"^",2),5)=VAZ Q "RTN","VADPT4",59,0) I VAX(3)<4 S X=$P(VAX(.321),"^",12),VAZ=X D "RTN","VADPT4",60,0) .S:X]"" VAZ=VAZ_"^"_$S(X="2":"HIROSHIMA/NAGASAKI",X="3":"ATMOSPHERIC NUCLEAR TESTING",X="4":"H/N AND ATMOSPHERIC TESTING",X="5":"UNDERGROUND NUCLEAR TESTING",X="6":"EXPOSURE AT NUCLEAR FACILITY",1:"OTHER") "RTN","VADPT4",61,0) .S @VAV@($P(VAS,"^",3),2)=VAZ Q "RTN","VADPT4",62,0) ;POW, combat locations "RTN","VADPT4",63,0) I VAX(3)<6 S X=$P(VAX(VAX("N")),"^",$S(VAX(3)=4:6,1:12)),VAZ=X S:$D(^DIC(22,+X,0)) VAZ=VAZ_"^"_$P(^(0),"^",1) S @VAV@($P(VAS,"^",VAX(3)),3)=VAZ Q "RTN","VADPT4",64,0) ;service episodes "RTN","VADPT4",65,0) S X=$S(VAX(3)=6:5,VAX(3)=7:10,1:15),VAX(2)=0 F VAX(5)=X,X+3,X-1 S VAX(2)=VAX(2)+1,VAZ=$P(VAX(VAX("N")),"^",VAX(5)),@VAV@($P(VAS,"^",VAX(3)),VAX(2))=VAZ I "^4^5^9^10^14^15^"[("^"_VAX(5)_"^"),+VAZ D 92 "RTN","VADPT4",66,0) Q "RTN","VADPT4",67,0) 92 ;pointers to Branch of Service (23) and Type Discharge (25) "RTN","VADPT4",68,0) S VAX(6)="^DIC("_$S('(VAX(5)#5):23,1:25)_","_+VAZ_",0)" I $D(@(VAX(6))) S VAZ=$P(^(0),"^",1),@VAV@($P(VAS,"^",VAX(3)),VAX(2))=@VAV@($P(VAS,"^",VAX(3)),VAX(2))_"^"_VAZ "RTN","VADPT4",69,0) Q "RTN","VADPT4",70,0) 93 ;Purple Heart "RTN","VADPT4",71,0) NEW VAFILE,VAIENS,VAFLDS,VAARR,VAI "RTN","VADPT4",72,0) S VAFILE=2,VAIENS=DFN_",",VAFLDS=".532;.533" "RTN","VADPT4",73,0) D GETS^DIQ(VAFILE,VAIENS,VAFLDS,"IEN","VAARR") "RTN","VADPT4",74,0) F VAI=1:1 S VAFLDS(VAI)=$P(VAFLDS,";",VAI) Q:VAFLDS(VAI)="" D "RTN","VADPT4",75,0) . I '$D(VAARR(VAFILE,VAIENS,VAFLDS(VAI),"I")),'$D(VAARR(VAFILE,VAIENS,VAFLDS(VAI),"E")) S @VAV@($P(VAS,"^",VAX(3)),VAI)="" "RTN","VADPT4",76,0) . E S @VAV@($P(VAS,U,VAX(3)),VAI)=$G(VAARR(VAFILE,VAIENS,VAFLDS(VAI),"I"))_"^"_$G(VAARR(VAFILE,VAIENS,VAFLDS(VAI),"E")) "RTN","VADPT4",77,0) Q "RTN","VADPT4",78,0) 94 ;more military service "RTN","VADPT4",79,0) N VAARR,VAIENS,VAFLDS "RTN","VADPT4",80,0) S VAIENS=DFN_",",VAFLDS=".3291"_VAX(1) "RTN","VADPT4",81,0) D GETS^DIQ(2,VAIENS,VAFLDS,"IEN","VAARR") "RTN","VADPT4",82,0) I $G(VAARR(2,VAIENS,VAFLDS,"I"))'="" D "RTN","VADPT4",83,0) . S @VAV@($P(VAS,"^",VAX(3)),VAX(4))=$G(VAARR(2,VAIENS,VAFLDS,"I"))_"^"_$G(VAARR(2,VAIENS,VAFLDS,"E")) "RTN","VADPT4",84,0) Q "RTN","VADPT4",85,0) ; "RTN","VADPT4",86,0) 95 ;OEF/OIF "RTN","VADPT4",87,0) N X,Y "RTN","VADPT4",88,0) I VAX(3)=1 S $P(@VAV@(VAX(2),VAX,VAX(3)),U,2)=$$EXTERNAL^DILFD(2.3215,.01,"",Z) "RTN","VADPT4",89,0) I VAX(3)=2!(VAX(3)=3) S Y=Z X ^DD("DD") S:Y'="" $P(@VAV@(VAX(2),VAX,VAX(3)),U,2)=Y "RTN","VADPT4",90,0) Q "RTN","VADPT4",91,0) ; "VER") 8.0^22.0 "^DD",2,2,.133,0) EMAIL ADDRESS^F^^.13;3^K:$L(X)>50!($L(X)<3)!'(X?1.E1"@"1.E1"."1.E) X "^DD",2,2,.133,.1) Email Address "^DD",2,2,.133,1,0) ^.1^^-1 "^DD",2,2,.133,1,1,0) ^^TRIGGER^2^.136 "^DD",2,2,.133,1,1,1) K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DPT(D0,.13)):^(.13),1:"") S X=$P(Y(1),U,6),X=X S DIU=X K Y S X=DIV S X=$$NOW^XLFDT() S DIH=$G(^DPT(DIV(0),.13)),DIV=X S $P(^(.13),U,6)=DIV,DIH=2,DIG=.136 D ^DICR "^DD",2,2,.133,1,1,2) K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DPT(D0,.13)):^(.13),1:"") S X=$P(Y(1),U,6),X=X S DIU=X K Y S X=DIV S X=$$NOW^XLFDT() S DIH=$G(^DPT(DIV(0),.13)),DIV=X S $P(^(.13),U,6)=DIV,DIH=2,DIG=.136 D ^DICR "^DD",2,2,.133,1,1,3) DO NOT DELETE "^DD",2,2,.133,1,1,"%D",0) ^^2^2^3060411^ "^DD",2,2,.133,1,1,"%D",1,0) This cross reference will update the EMAIL ADDRESS CHANGE DT/TM field "^DD",2,2,.133,1,1,"%D",2,0) with current date and time stamp each time this field is changed. "^DD",2,2,.133,1,1,"CREATE VALUE") S X=$$NOW^XLFDT() "^DD",2,2,.133,1,1,"DELETE VALUE") S X=$$NOW^XLFDT() "^DD",2,2,.133,1,1,"DT") 3050608 "^DD",2,2,.133,1,1,"FIELD") #.136 "^DD",2,2,.133,3) Enter the applicant's email address [3-50 characters]. The entry must include an '@'. "^DD",2,2,.133,4) D 133^DGMTDD5 "^DD",2,2,.133,"DT") 3090410 "^DD",2,2,.134,0) PHONE NUMBER [CELLULAR]^FX^^.13;4^K:$L(X)>20!($L(X)<4) X I $D(X) N CTR,CHR,VAR S VAR=X F CTR=1:1:20 S CHR=$E(VAR,CTR) K:("1234567890 -()."'[CHR) X "^DD",2,2,.134,.1) Cell Phone "^DD",2,2,.134,1,0) ^.1 "^DD",2,2,.134,1,1,0) ^^TRIGGER^2^.139 "^DD",2,2,.134,1,1,1) K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DPT(D0,.13)):^(.13),1:"") S X=$P(Y(1),U,9),X=X S DIU=X K Y S X=DIV S X=$$NOW^XLFDT() S DIH=$G(^DPT(DIV(0),.13)),DIV=X S $P(^(.13),U,9)=DIV,DIH=2,DIG=.139 D ^DICR "^DD",2,2,.134,1,1,2) K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DPT(D0,.13)):^(.13),1:"") S X=$P(Y(1),U,9),X=X S DIU=X K Y S X=DIV S X=$$NOW^XLFDT() S DIH=$G(^DPT(DIV(0),.13)),DIV=X S $P(^(.13),U,9)=DIV,DIH=2,DIG=.139 D ^DICR "^DD",2,2,.134,1,1,"%D",0) ^^2^2^3060411^ "^DD",2,2,.134,1,1,"%D",1,0) This cross reference will update the CELLULAR NUMBER CHANGE DT/TM field "^DD",2,2,.134,1,1,"%D",2,0) with current date and time stamp each time this field is changed. "^DD",2,2,.134,1,1,"CREATE VALUE") S X=$$NOW^XLFDT() "^DD",2,2,.134,1,1,"DELETE VALUE") S X=$$NOW^XLFDT() "^DD",2,2,.134,1,1,"FIELD") #.139 "^DD",2,2,.134,3) Answer must be 4-20 characters in length, be numeric with only spaces, parenthesis, periods, and dashes for separators. "^DD",2,2,.134,21,0) ^^2^2^3050111^ "^DD",2,2,.134,21,1,0) Enter the telephone number [4-20 characters] to the applicant's "^DD",2,2,.134,21,2,0) mobile phone. "^DD",2,2,.134,"DT") 3090410 "^DD",2,2,.135,0) PAGER NUMBER^FX^^.13;5^K:$L(X)>20!($L(X)<4) X I $D(X) N CTR,CHR,VAR S VAR=X F CTR=1:1:20 S CHR=$E(VAR,CTR) K:("1234567890 -()."'[CHR) X "^DD",2,2,.135,.1) Pager # "^DD",2,2,.135,1,0) ^.1 "^DD",2,2,.135,1,1,0) ^^TRIGGER^2^.1312 "^DD",2,2,.135,1,1,1) K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DPT(D0,.13)):^(.13),1:"") S X=$P(Y(1),U,12),X=X S DIU=X K Y S X=DIV S X=$$NOW^XLFDT() S DIH=$G(^DPT(DIV(0),.13)),DIV=X S $P(^(.13),U,12)=DIV,DIH=2,DIG=.1312 D ^DICR "^DD",2,2,.135,1,1,2) K DIV S DIV=X,D0=DA,DIV(0)=D0 S Y(1)=$S($D(^DPT(D0,.13)):^(.13),1:"") S X=$P(Y(1),U,12),X=X S DIU=X K Y S X=DIV S X=$$NOW^XLFDT() S DIH=$G(^DPT(DIV(0),.13)),DIV=X S $P(^(.13),U,12)=DIV,DIH=2,DIG=.1312 D ^DICR "^DD",2,2,.135,1,1,"%D",0) ^.101^2^2^3060411^^ "^DD",2,2,.135,1,1,"%D",1,0) This cross reference will update the PAGER NUMBER CHANGE DT/TM field with "^DD",2,2,.135,1,1,"%D",2,0) current date and time stamp each time this field is changed. "^DD",2,2,.135,1,1,"CREATE VALUE") S X=$$NOW^XLFDT() "^DD",2,2,.135,1,1,"DELETE VALUE") S X=$$NOW^XLFDT() "^DD",2,2,.135,1,1,"FIELD") #.1312 "^DD",2,2,.135,3) Answer must be 4-20 characters in length, be numeric with only spaces, parenthesis, periods, and dashes for separators. "^DD",2,2,.135,21,0) ^^1^1^3050111^ "^DD",2,2,.135,21,1,0) Enter the applicant's pager number [4-20 characters]. "^DD",2,2,.135,23,0) ^.001^1^1^3050111^^^ "^DD",2,2,.135,23,1,0) Contains between 4 and 20 Free Text characters. "^DD",2,2,.135,"DT") 3090410 "BLD",8053,6) ^719 **END** **END**