Released DG*5.3*1084 SEQ #949 Extracted from mail message **KIDS**:DG*5.3*1084^ **INSTALL NAME** DG*5.3*1084 "BLD",12700,0) DG*5.3*1084^REGISTRATION^0^3220920^y "BLD",12700,1,0) ^^8^8^3220920^ "BLD",12700,1,1,0) Patch DG*5.3*1084 addresses 2 issues "BLD",12700,1,2,0) "BLD",12700,1,3,0) 1. A reported issue where the potential for a blank error to be posted in "BLD",12700,1,4,0) the error trap exists. "BLD",12700,1,5,0) "BLD",12700,1,6,0) 2. The removal of the Agent Orange Registration # from the DG LOAD PATIENT "BLD",12700,1,7,0) DATA option screen 6 (MILITARY SERVICE DATA SCREEN) > Environmental "BLD",12700,1,8,0) Factors screen, with the approval from the business owners. "BLD",12700,4,0) ^9.64PA^^ "BLD",12700,6) 4 "BLD",12700,6.3) 4 "BLD",12700,"ABPKG") n "BLD",12700,"KRN",0) ^9.67PA^1.5^25 "BLD",12700,"KRN",.4,0) .4 "BLD",12700,"KRN",.401,0) .401 "BLD",12700,"KRN",.402,0) .402 "BLD",12700,"KRN",.403,0) .403 "BLD",12700,"KRN",.5,0) .5 "BLD",12700,"KRN",.84,0) .84 "BLD",12700,"KRN",1.5,0) 1.5 "BLD",12700,"KRN",1.6,0) 1.6 "BLD",12700,"KRN",1.61,0) 1.61 "BLD",12700,"KRN",1.62,0) 1.62 "BLD",12700,"KRN",3.6,0) 3.6 "BLD",12700,"KRN",3.8,0) 3.8 "BLD",12700,"KRN",9.2,0) 9.2 "BLD",12700,"KRN",9.8,0) 9.8 "BLD",12700,"KRN",9.8,"NM",0) ^9.68A^2^2 "BLD",12700,"KRN",9.8,"NM",1,0) DGUAMWS^^0^B115086835 "BLD",12700,"KRN",9.8,"NM",2,0) DGRP6EF^^0^B51318599 "BLD",12700,"KRN",9.8,"NM","B","DGRP6EF",2) "BLD",12700,"KRN",9.8,"NM","B","DGUAMWS",1) "BLD",12700,"KRN",19,0) 19 "BLD",12700,"KRN",19.1,0) 19.1 "BLD",12700,"KRN",101,0) 101 "BLD",12700,"KRN",409.61,0) 409.61 "BLD",12700,"KRN",771,0) 771 "BLD",12700,"KRN",779.2,0) 779.2 "BLD",12700,"KRN",870,0) 870 "BLD",12700,"KRN",8989.51,0) 8989.51 "BLD",12700,"KRN",8989.52,0) 8989.52 "BLD",12700,"KRN",8993,0) 8993 "BLD",12700,"KRN",8994,0) 8994 "BLD",12700,"KRN","B",.4,.4) "BLD",12700,"KRN","B",.401,.401) "BLD",12700,"KRN","B",.402,.402) "BLD",12700,"KRN","B",.403,.403) "BLD",12700,"KRN","B",.5,.5) "BLD",12700,"KRN","B",.84,.84) "BLD",12700,"KRN","B",1.5,1.5) "BLD",12700,"KRN","B",1.6,1.6) "BLD",12700,"KRN","B",1.61,1.61) "BLD",12700,"KRN","B",1.62,1.62) "BLD",12700,"KRN","B",3.6,3.6) "BLD",12700,"KRN","B",3.8,3.8) "BLD",12700,"KRN","B",9.2,9.2) "BLD",12700,"KRN","B",9.8,9.8) "BLD",12700,"KRN","B",19,19) "BLD",12700,"KRN","B",19.1,19.1) "BLD",12700,"KRN","B",101,101) "BLD",12700,"KRN","B",409.61,409.61) "BLD",12700,"KRN","B",771,771) "BLD",12700,"KRN","B",779.2,779.2) "BLD",12700,"KRN","B",870,870) "BLD",12700,"KRN","B",8989.51,8989.51) "BLD",12700,"KRN","B",8989.52,8989.52) "BLD",12700,"KRN","B",8993,8993) "BLD",12700,"KRN","B",8994,8994) "BLD",12700,"QDEF") ^^^^^^^^^^YES "BLD",12700,"QUES",0) ^9.62^^ "BLD",12700,"REQB",0) ^9.611^2^2 "BLD",12700,"REQB",1,0) DG*5.3*1065^1 "BLD",12700,"REQB",2,0) DG*5.3*1075^1 "BLD",12700,"REQB","B","DG*5.3*1065",1) "BLD",12700,"REQB","B","DG*5.3*1075",2) "MBREQ") 0 "PKG",5,-1) 1^1 "PKG",5,0) REGISTRATION^DG^PATIENT REGISTRATION, ADMISSION, DISCHARGE, EMBOSSER "PKG",5,22,0) ^9.49I^1^1 "PKG",5,22,1,0) 5.3^2930813 "PKG",5,22,1,"PAH",1,0) 1084^3220920 "PKG",5,22,1,"PAH",1,1,0) ^^8^8^3220920 "PKG",5,22,1,"PAH",1,1,1,0) Patch DG*5.3*1084 addresses 2 issues "PKG",5,22,1,"PAH",1,1,2,0) "PKG",5,22,1,"PAH",1,1,3,0) 1. A reported issue where the potential for a blank error to be posted in "PKG",5,22,1,"PAH",1,1,4,0) the error trap exists. "PKG",5,22,1,"PAH",1,1,5,0) "PKG",5,22,1,"PAH",1,1,6,0) 2. The removal of the Agent Orange Registration # from the DG LOAD PATIENT "PKG",5,22,1,"PAH",1,1,7,0) DATA option screen 6 (MILITARY SERVICE DATA SCREEN) > Environmental "PKG",5,22,1,"PAH",1,1,8,0) Factors screen, with the approval from the business owners. "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","DGRP6EF") 0^2^B51318599^B51641588 "RTN","DGRP6EF",1,0) DGRP6EF ;ALB/TMK,EG,BAJ,JLS,ARF,JAM - REGISTRATION SCREEN 6 FIELDS FOR EXPOSURE FACTORS ;05 Feb 2015 11:06 AM "RTN","DGRP6EF",2,0) ;;5.3;Registration;**689,659,737,688,909,1014,1018,1075,1084**;Aug 13,1993;Build 4 "RTN","DGRP6EF",3,0) ; "RTN","DGRP6EF",4,0) EN(DFN,QUIT) ; Display Environmental exposure factors/allow to edit "RTN","DGRP6EF",5,0) N I,IND,DG321,DG322,DGCT,DIR,Z,X,Y,DIE,DR,DA,DGNONT "RTN","DGRP6EF",6,0) ; Returns QUIT=1 if ^ entered "RTN","DGRP6EF",7,0) ; "RTN","DGRP6EF",8,0) EN1 D CLEAR^VALM1 "RTN","DGRP6EF",9,0) N DTOUT,DUOUT,TYPE,SEL,L,S,L1,L2,L3,DGELV "RTN","DGRP6EF",10,0) S DG321=$G(^DPT(DFN,.321)),DG322=$G(^DPT(DFN,.322)) "RTN","DGRP6EF",11,0) ; "RTN","DGRP6EF",12,0) S DIR(0)="SA^",DGCT=0 "RTN","DGRP6EF",13,0) N DGSSNSTR,DGPTYPE,DGSSN,DGDOB ;ARF-DG*5.3*1014 begin - add standardize patient data to the screen banner "RTN","DGRP6EF",14,0) S DGSSNSTR=$$SSNNM^DGRPU(DFN) "RTN","DGRP6EF",15,0) S DGSSN=$P($P(DGSSNSTR,";",2)," ",3) "RTN","DGRP6EF",16,0) S DGDOB=$$GET1^DIQ(2,DFN,.03,"I") "RTN","DGRP6EF",17,0) S DGDOB=$$UP^XLFSTR($$FMTE^XLFDT($E(DGDOB,1,12),1)) "RTN","DGRP6EF",18,0) S DGPTYPE=$$GET1^DIQ(391,$$GET1^DIQ(2,DFN_",",391,"I")_",",.01) "RTN","DGRP6EF",19,0) S:DGPTYPE="" DGPTYPE="PATIENT TYPE UNKNOWN" "RTN","DGRP6EF",20,0) S DGCT=DGCT+1,DIR("A",DGCT)=$P(DGSSNSTR,";",1)_$S($$GET1^DIQ(2,DFN,.2405)'="":" ("_$$GET1^DIQ(2,DFN,.2405)_")",1:"")_" "_DGDOB "RTN","DGRP6EF",21,0) S DGCT=DGCT+1,DIR("A",DGCT)=$S($P($P(DGSSNSTR,";",2)," ",2)'="":$E($P($P(DGSSNSTR,";",2)," ",2),1,40)_" ",1:"")_DGSSN_" "_DGPTYPE "RTN","DGRP6EF",22,0) ;S DGCT=DGCT+1,DIR("A",DGCT)=$$SSNNM^DGRPU(DFN) ;ARF-DG*5.3*1014 end "RTN","DGRP6EF",23,0) S DGCT=DGCT+1,DIR("A",DGCT)="",$P(DIR("A",DGCT),"=",81)="" "RTN","DGRP6EF",24,0) S DGCT=DGCT+1,DIR("A",DGCT)=$J("",23)_"**** ENVIRONMENTAL FACTORS ****",DGCT=DGCT+1,DIR("A",DGCT)=" " "RTN","DGRP6EF",25,0) S IND=$S('$G(DGRPV):"[]",1:"<>") "RTN","DGRP6EF",26,0) S DGCT=DGCT+1 "RTN","DGRP6EF",27,0) S Z=$E(IND)_"1"_$E(IND,2) "RTN","DGRP6EF",28,0) ; DG*5.3*1075; Set flag if eligibility is Verified and ELIGIBILITY STATUS ENTERED BY (#.3616) field = POSTMASTER "RTN","DGRP6EF",29,0) S DGELV=0 "RTN","DGRP6EF",30,0) I $$GET1^DIQ(2,DFN_",",.3611,"I")="V"&($$GET1^DIQ(2,DFN_",",.3616)="POSTMASTER") S DGELV=1 "RTN","DGRP6EF",31,0) ; DG*5.3*1075 - If DGELV flag is set, A/O and Rad Exposure (groups 1 and 2) are read-only "RTN","DGRP6EF",32,0) I DGELV S Z="<1>" "RTN","DGRP6EF",33,0) ; "OTHER" choice added DG*5.3*688 "RTN","DGRP6EF",34,0) ; variables S,L1,L2, & L3 used for dynamic spacing "RTN","DGRP6EF",35,0) S SEL=$P(DG321,U,13),S=$C(32),($P(L1,S,6),$P(L2,S,$S(SEL="O":3,1:2)),$P(L3,S,3))="" "RTN","DGRP6EF",36,0) ; DG*5.3*1018 - Add Blue Water Navy Value "B" "RTN","DGRP6EF",37,0) S TYPE=$S(SEL="B":" (BWN) ",SEL="K":" (DMZ) ",SEL="V":" (VIET)",SEL="O":" (OTH)",1:$J("",7)) "RTN","DGRP6EF",38,0) S DIR("A",DGCT)=Z_L1_"A/O Exp.: "_$$YN^DGRP6CL(DG321,2)_TYPE_L2_"Reg: "_$$DAT^DGRP6CL(DG321,7,12)_L3_"Exam: "_$$DAT^DGRP6CL(DG321,9,12) "RTN","DGRP6EF",39,0) S Z=$E(IND)_"2"_$E(IND,2) "RTN","DGRP6EF",40,0) I DGELV S Z="<2>" "RTN","DGRP6EF",41,0) S DGCT=DGCT+1,DIR("A",DGCT)=Z_" ION Rad.: "_$$YN^DGRP6CL(DG321,3)_$J("",8)_"Reg: "_$$DAT^DGRP6CL(DG321,11,12)_"Method: " "RTN","DGRP6EF",42,0) S:$P(DG321,U,12)>7 $P(DG321,U,12)="" S DIR("A",DGCT)=DIR("A",DGCT)_$P($T(SELTBL+$P(DG321,U,12)),";;",2) "RTN","DGRP6EF",43,0) S Z=$E(IND)_"3"_$E(IND,2) "RTN","DGRP6EF",44,0) ;Env Contam name changed to SW Asia Conditions, DG*5.3*688 "RTN","DGRP6EF",45,0) S DGCT=DGCT+1,DIR("A",DGCT)=Z_" SW Asia Cond: "_$$YN^DGRP6CL(DG322,13)_$J("",8)_"Reg: "_$$DAT^DGRP6CL(DG322,14,12)_" Exam: "_$$DAT^DGRP6CL(DG322,15,11) "RTN","DGRP6EF",46,0) S DGNONT=0 I $$GETSTAT^DGNTAPI1(DFN)>2,'$D(^XUSEC("DGNT VERIFY",DUZ)) S DGNONT=1 "RTN","DGRP6EF",47,0) I $G(DGRPV) S DGNONT=1 "RTN","DGRP6EF",48,0) S DGCT=DGCT+1,DIR("A",DGCT)=$S(DGNONT:"<",1:"[")_"4"_$S(DGNONT:">",1:"]")_" N/T Radium: " N DGNT S DGRPX=$$GETCUR^DGNTAPI(DFN,"DGNT") S DIR("A",DGCT)=DIR("A",DGCT)_$G(DGNT("INTRP")) "RTN","DGRP6EF",49,0) ; "RTN","DGRP6EF",50,0) ; DG*5.3*909 Display Camp Lejeune info in entirety "RTN","DGRP6EF",51,0) N DG3217CL S DG3217CL=$G(^DPT(DFN,.3217)) "RTN","DGRP6EF",52,0) N DGCLE S DGCLE=$$CLE^DGENCLEA(DFN) "RTN","DGRP6EF",53,0) I DGCLE=1,$G(^DPT(DFN,.32171))=1 S DGCLE=0 "RTN","DGRP6EF",54,0) S IND=$S('DGCLE:"<>",1:IND) "RTN","DGRP6EF",55,0) S Z=$E(IND)_"5"_$E(IND,2) "RTN","DGRP6EF",56,0) S DGCT=DGCT+1,DIR("A",DGCT)=Z_" Camp Lejeune: " "RTN","DGRP6EF",57,0) S DIR("A",DGCT)=DIR("A",DGCT)_$$YN^DGRP6CL(DG3217CL,1) "RTN","DGRP6EF",58,0) ; "RTN","DGRP6EF",59,0) ; DG*5.3*1075 - If DGELV flag is set display informational message "RTN","DGRP6EF",60,0) I DGELV D "RTN","DGRP6EF",61,0) . S DGCT=DGCT+1,DIR("A",DGCT)=" " "RTN","DGRP6EF",62,0) . S DGCT=DGCT+1,DIR("A",DGCT)="Eligibility is Verified in VES. Only VES users may enter/edit Agent Orange" "RTN","DGRP6EF",63,0) . S DGCT=DGCT+1,DIR("A",DGCT)="or ION Radiation Exposure." "RTN","DGRP6EF",64,0) . S DGCT=DGCT+1,DIR("A",DGCT)=" " "RTN","DGRP6EF",65,0) ; "RTN","DGRP6EF",66,0) S DGCT=DGCT+1,DIR("A",DGCT)=" " "RTN","DGRP6EF",67,0) N DGENDTXT S DGENDTXT=$S(DGNONT&DGCLE:"3,5",DGNONT&'DGCLE:"3",'DGNONT&DGCLE:"5",1:"4") ; DG*5.3*909 Determine available choices based also on Camp Lejeune eligibility "RTN","DGRP6EF",68,0) S DIR("A")=$S('$G(DGRPV):"SELECT AN ENVIRONMENTAL FACTOR (1-"_DGENDTXT_") OR (Q)UIT: ",1:"PRESS RETURN TO CONTINUE ") ;DG*5.3*909 Camp Lejeune choice added "RTN","DGRP6EF",69,0) ; DG*5.3*1075 If DGELV flag is set, no edit of groups 1 and 2 "RTN","DGRP6EF",70,0) I DGELV S DIR("A")=$S('$G(DGRPV):"SELECT AN ENVIRONMENTAL FACTOR (3-"_DGENDTXT_") OR (Q)UIT: ",1:"PRESS RETURN TO CONTINUE ") "RTN","DGRP6EF",71,0) ;Env Contam name changed to SW Asia Conditions, DG*5.3*688 "RTN","DGRP6EF",72,0) S DIR(0)=$S('$G(DGRPV):"SA^1:A/O Exp;2:ION Rad;3:SW Asia Cond;"_$S(DGNONT:"",1:"4:N/T Radium;")_$S(DGCLE:"5:Camp Lejeune;",1:"")_"Q:QUIT",1:"EA") ; DG*5.3*909 Camp Lejeune choice added "RTN","DGRP6EF",73,0) ; DG*5.3*1075 If DGELV, no edit of groups 1 and 2 "RTN","DGRP6EF",74,0) I DGELV S DIR(0)=$S('$G(DGRPV):"SA^3:SW Asia Cond;"_$S(DGNONT:"",1:"4:N/T Radium;")_$S(DGCLE:"5:Camp Lejeune;",1:"")_"Q:QUIT",1:"EA") ; DG*5.3*909 Camp Lejeune choice added "RTN","DGRP6EF",75,0) I '$G(DGRPV) S DIR("B")="QUIT" "RTN","DGRP6EF",76,0) I 'DGCLE,$G(^DPT(DFN,.32171))=1,$P($G(XQY0),U)'="DG REGISTRATION VIEW" D "RTN","DGRP6EF",77,0) . S DGHECMSG(1)="Camp Lejeune data has been verified by HEC, please " "RTN","DGRP6EF",78,0) . S DGHECMSG(1)=DGHECMSG(1)_"notify the HEC via" "RTN","DGRP6EF",79,0) . S DGHECMSG(2)="the HEC Alert process if changes are required." "RTN","DGRP6EF",80,0) . S DGHECMSG(3)="Press Return key to continue" "RTN","DGRP6EF",81,0) . S DIR("PRE")="I X=5 W !!,DGHECMSG(1),!,DGHECMSG(2),!!,DGHECMSG(3)" "RTN","DGRP6EF",82,0) . S DIR("PRE")=DIR("PRE")_" R *DGANSWER S X=""""" "RTN","DGRP6EF",83,0) D ^DIR K DIR,DGANSWER,DGHECMSG "RTN","DGRP6EF",84,0) I $G(DGRPV)!$D(DUOUT)!$D(DTOUT)!(Y="Q") S:Y'="Q" QUIT=1 G QUIT "RTN","DGRP6EF",85,0) S Z="603"_$E("0",2-$L(+Y))_+Y "RTN","DGRP6EF",86,0) S DIE=2,DA=DFN,DR=$P($T(@Z),";;",2) "RTN","DGRP6EF",87,0) ; "RTN","DGRP6EF",88,0) ; DG*5.3*1075; If editing group 1, A/O data, capture the current value of the AGENT ORANGE EXPOS. INDICATED? (#.32102) field "RTN","DGRP6EF",89,0) N DGAO "RTN","DGRP6EF",90,0) I Y=1 S DGAO=$$GET1^DIQ(2,DFN,.32102,"I") "RTN","DGRP6EF",91,0) ; "RTN","DGRP6EF",92,0) ; DG*5.3*1075; If editing group 2, Radiation Exposure data, capture the current value of the RADIATION EXPOSURE INDICATED? (#.32103) field "RTN","DGRP6EF",93,0) N DGRAD "RTN","DGRP6EF",94,0) I Y=2 S DGRAD=$$GET1^DIQ(2,DFN,.32103,"I") "RTN","DGRP6EF",95,0) ; "RTN","DGRP6EF",96,0) ; DG*5.3*909 Camp Lejeune logic added "RTN","DGRP6EF",97,0) I Y'=5 D:DR'="" ^DIE "RTN","DGRP6EF",98,0) E X DR D AUTOUPD^DGENA2(DFN) "RTN","DGRP6EF",99,0) ; "RTN","DGRP6EF",100,0) ; DG*5.3*1075;jam "RTN","DGRP6EF",101,0) ; If DGRAD is defined, editing of the Radiation Exposure data was done. "RTN","DGRP6EF",102,0) ; If .32103 field was changed to Y, check if RADIATION EXPOSURE METHOD (#.3212) field is blank "RTN","DGRP6EF",103,0) I $D(DGRAD),DGRAD'="Y",$$GET1^DIQ(2,DFN,.32103,"I")="Y",$$GET1^DIQ(2,DFN,.3212)="" D "RTN","DGRP6EF",104,0) . ; If no Radiation Method defined, set the RADIATION EXPOSURE INDICATED? value back to DGRAD value (or NO if no DGRAD value) "RTN","DGRP6EF",105,0) . I DGRAD="" S DGRAD="N" "RTN","DGRP6EF",106,0) . S DR=".32103///^S X=DGRAD" "RTN","DGRP6EF",107,0) . D ^DIE "RTN","DGRP6EF",108,0) . K DIE,DA,DR "RTN","DGRP6EF",109,0) K DGRAD "RTN","DGRP6EF",110,0) ; "RTN","DGRP6EF",111,0) ; DG*5.3*1075;jam "RTN","DGRP6EF",112,0) ; If DGAO is defined, editing of the AO Exposure data was done. "RTN","DGRP6EF",113,0) ; If .32102 field was changed to Y, check if AGENT ORANGE EXPOSURE LOCATION (#.3213) field is blank "RTN","DGRP6EF",114,0) I $D(DGAO),DGAO'="Y",$$GET1^DIQ(2,DFN,.32102,"I")="Y",$$GET1^DIQ(2,DFN,.3213)="" D "RTN","DGRP6EF",115,0) . ; If no location defined, set the AGENT ORANGE EXPOS. INDICATED? value back to DGAO value (or NO if no DGAO value) "RTN","DGRP6EF",116,0) . I DGAO="" S DGAO="N" "RTN","DGRP6EF",117,0) . S DR=".32102///^S X=DGAO" "RTN","DGRP6EF",118,0) . D ^DIE "RTN","DGRP6EF",119,0) K DIE,DA,DR,DGAO "RTN","DGRP6EF",120,0) ; "RTN","DGRP6EF",121,0) G EN1 "RTN","DGRP6EF",122,0) ; "RTN","DGRP6EF",123,0) QUIT Q "RTN","DGRP6EF",124,0) ; "RTN","DGRP6EF",125,0) EF(DFN,LIN) ; "RTN","DGRP6EF",126,0) N DG321,DG322,LENGTH,Z,SEQ "RTN","DGRP6EF",127,0) K LIN S (LENGTH,LIN)=0 "RTN","DGRP6EF",128,0) S DG321=$G(^DPT(DFN,.321)),DG322=$G(^(.322)) "RTN","DGRP6EF",129,0) I $P(DG321,U,2)="Y" D "RTN","DGRP6EF",130,0) . S Z="A/O Exp.",SEQ=1 "RTN","DGRP6EF",131,0) . ;S:'$P(DG321,U,7)!'$P(DG321,U,9)!($P(DG321,U,10)="") Z=Z_"(Incomplete)" "RTN","DGRP6EF",132,0) . S:'$P(DG321,U,7)!('$P(DG321,U,9))="" Z=Z_"(Incomplete)" "RTN","DGRP6EF",133,0) . D SETLNEX^DGRP6(Z,SEQ,.LIN,.LENGTH) "RTN","DGRP6EF",134,0) ; "RTN","DGRP6EF",135,0) I $P(DG321,U,3)="Y" D "RTN","DGRP6EF",136,0) . S Z="Ion Rad.",SEQ=2 "RTN","DGRP6EF",137,0) . S:'$P(DG321,U,11)!($P(DG321,U,12)="") Z=Z_"(Incomplete)" "RTN","DGRP6EF",138,0) . D SETLNEX^DGRP6(Z,SEQ,.LIN,.LENGTH) "RTN","DGRP6EF",139,0) ; "RTN","DGRP6EF",140,0) I $P(DG322,U,13)="Y" D "RTN","DGRP6EF",141,0) . I 'LIN S LIN=LIN+1,LIN(LIN)="" "RTN","DGRP6EF",142,0) . ;Env Contam name changed to SW Asia Conditions, DG*5.3*688 "RTN","DGRP6EF",143,0) . S Z="SW Asia Cond.",SEQ=3 "RTN","DGRP6EF",144,0) . S:'$P(DG322,U,14)!'$P(DG322,U,15) Z=Z_"(Incomplete)" "RTN","DGRP6EF",145,0) . D SETLNEX^DGRP6(Z,SEQ,.LIN,.LENGTH) "RTN","DGRP6EF",146,0) ; N/T Radium Exposure "RTN","DGRP6EF",147,0) N DGNT,DGRPX S DGRPX=$$GETCUR^DGNTAPI(DFN,"DGNT") "RTN","DGRP6EF",148,0) I "NO"'[$G(DGNT("INTRP")) D "RTN","DGRP6EF",149,0) . I 'LIN S LIN=LIN+1,LIN(LIN)="" "RTN","DGRP6EF",150,0) . S SEQ=4 D SETLNEX^DGRP6("N/T Radium ("_$P(DGNT("INTRP"),"YES,",2)_")",SEQ,.LIN,.LENGTH) "RTN","DGRP6EF",151,0) ; DG*5.3*909 Get latest Camp Lejeune information from PATIENT file "RTN","DGRP6EF",152,0) N DG3217CL "RTN","DGRP6EF",153,0) S DG3217CL=$G(^DPT(DFN,.3217)) "RTN","DGRP6EF",154,0) I $P(DG3217CL,U,1)="Y" D "RTN","DGRP6EF",155,0) . I 'LIN S LIN=LIN+1,LIN(LIN)="" "RTN","DGRP6EF",156,0) . S Z="Camp Lejeune",SEQ=5 "RTN","DGRP6EF",157,0) . D SETLNEX^DGRP6(Z,SEQ,.LIN,.LENGTH) "RTN","DGRP6EF",158,0) Q "RTN","DGRP6EF",159,0) ; "RTN","DGRP6EF",160,0) CHKAOEL(DGY) ;DG*5.3*1018;jam; - Screen logic for .3213 (AGENT ORANGE EXPOSURE LOCATION) field in PATIENT file "RTN","DGRP6EF",161,0) ; Returns: TRUE if the entry DGY is valid "RTN","DGRP6EF",162,0) ; "RTN","DGRP6EF",163,0) ; Only checking B (BLUE WATER NAVY) entry - All other entries are allowed "RTN","DGRP6EF",164,0) I DGY'="B" Q 1 "RTN","DGRP6EF",165,0) N DGBWNDT "RTN","DGRP6EF",166,0) ; Allow B to be displayed when BWN ACTIVE DATE (#1402) in MAS PARAMETER file #43 is reached "RTN","DGRP6EF",167,0) ; - Get the BWN ACTIVE DATE "RTN","DGRP6EF",168,0) S DGBWNDT=$$GET1^DIQ(43,1,1402,"I") "RTN","DGRP6EF",169,0) ; - If active date not defined, return FALSE "RTN","DGRP6EF",170,0) I 'DGBWNDT Q 0 "RTN","DGRP6EF",171,0) ; - If active date is in the future, return FALSE "RTN","DGRP6EF",172,0) I DGBWNDT>$$DT^XLFDT Q 0 "RTN","DGRP6EF",173,0) Q 1 "RTN","DGRP6EF",174,0) ; "RTN","DGRP6EF",175,0) ; The following tag is a table of values. Do not change location of values including null at SELTBL+0 "RTN","DGRP6EF",176,0) SELTBL ;; "RTN","DGRP6EF",177,0) ;;NO VALUE "RTN","DGRP6EF",178,0) ;;HIROSHIMA/NAGASAKI "RTN","DGRP6EF",179,0) ;;ATMOSPHERIC NUCLEAR TEST "RTN","DGRP6EF",180,0) ;;H/N AND ATMOSPHERIC TEST "RTN","DGRP6EF",181,0) ;;UNDERGROUND NUCLEAR TEST "RTN","DGRP6EF",182,0) ;;EXP. AT NUCLEAR FACILITY "RTN","DGRP6EF",183,0) ;;OTHER "RTN","DGRP6EF",184,0) 60301 ;;.32102//NO;S:X'="Y" Y="@65";.3213;.32107;.32109;@65; "RTN","DGRP6EF",185,0) ; DG*5.3*1075 - Add "R" to field .3212, making it Required "RTN","DGRP6EF",186,0) 60302 ;;.32103//NO;S:X'="Y" Y="@66";.3212R;.32111;@66; "RTN","DGRP6EF",187,0) 60303 ;;.322013//NO;S:X'="Y" Y="@612";.322014;Q;.322015;@612; "RTN","DGRP6EF",188,0) 60304 ;;D REG^DGNTQ(DFN) "RTN","DGRP6EF",189,0) 60305 ;;D ADDEDTCL^DGENCLEA(DFN) "RTN","DGRP6EF",190,0) ;; "RTN","DGUAMWS") 0^1^B115086835^B111128641 "RTN","DGUAMWS",1,0) DGUAMWS ;ALB/MCF,JAM - UAM Address Validation Web Service ;30 June 2020 10:00 AM "RTN","DGUAMWS",2,0) ;;5.3;Registration;**1014,1065,1084**;Aug 13, 1993;Build 4 "RTN","DGUAMWS",3,0) ; "RTN","DGUAMWS",4,0) ; Supported ICR's: "RTN","DGUAMWS",5,0) ; #5421 - XOBWLIB - Public APIs for HWSC "RTN","DGUAMWS",6,0) ; #6682 - DECODE^XLFJSON - Decode JSON "RTN","DGUAMWS",7,0) ; - ENCODE^XLFJSON - Encode JSON "RTN","DGUAMWS",8,0) ; #7191 - Read access to file 18.12 "RTN","DGUAMWS",9,0) ; #7190 - Read access to file 18.02 "RTN","DGUAMWS",10,0) ; #2263 - Permits the use of $$GET^XPAR to retrieve a parameter value. "RTN","DGUAMWS",11,0) ; #1621 - APPERROR^%ZTER - sets $ZE and call the error trap "RTN","DGUAMWS",12,0) ; "RTN","DGUAMWS",13,0) ; NOTE: EN^DGUAMWS contains vendor specific code that is restricted and will be reported by XINDEX. "RTN","DGUAMWS",14,0) ; Exemption (20200806-01) was granted by the Standards and Conventions (SAC) committee on 8/6/20 "RTN","DGUAMWS",15,0) ; allowing the vendor specific code. "RTN","DGUAMWS",16,0) ; "RTN","DGUAMWS",17,0) EN(DGADDRESS,DGFLDS,DGFORGN) ; Main entry to for UAM Address Validation Web Service "RTN","DGUAMWS",18,0) ; Input : DGADDRESS (Required, pass by reference) - Array containing the address to be validated "RTN","DGUAMWS",19,0) ; DGFLDS (Required) - List of fileman field values. See "Address fields" below. "RTN","DGUAMWS",20,0) ; DGFORGN (Required) - Foreign flag indicator. Determines use of Candidate or Validate web service "RTN","DGUAMWS",21,0) ; 0-Domestic (Candidate), 1-Foreign (Validate), 2-Foreign Exception (Candidate) "RTN","DGUAMWS",22,0) ; Return: DGADDRESS - original address returned with the response addresses from the web service in the same format. "RTN","DGUAMWS",23,0) ; DGADDRESS(DGCNT,"confidenceScore") - Contains the confidence score for this address. "RTN","DGUAMWS",24,0) ; DGADDRESS(DGCNT,"deliveryPoint") - Contains the delivery point validation message for this address. "RTN","DGUAMWS",25,0) ; (Only pertains to USA addresses) "RTN","DGUAMWS",26,0) ; 0 - Error in web service call or no addresses above 80% confidence. 1- Successful request/response. "RTN","DGUAMWS",27,0) ; Note: A "1" returned does NOT imply a "good" address is returned. "RTN","DGUAMWS",28,0) ; Confidence Score, Delivery Point, and Message Codes give more detail if provided by the web service. "RTN","DGUAMWS",29,0) N DGX,DGEXC,DGFRGNEXCPTS,DGADDRLN1,DGADDRLN2,DGADDRLN3,DGCITY,DGSTATE,DGZIP,DGPROV,DGPOSTCODE,DGCOUNTRY "RTN","DGUAMWS",30,0) N DGSERVICE,DGERR,DGHTTPREQ,DGJSON,DGHEADER,DGRESPONSE,DGRESPERR,DGHTTPRESP,DGDATA,DGARRAY,DGRESPMSG,DGSTAT,DGKEY "RTN","DGUAMWS",31,0) D INIT "RTN","DGUAMWS",32,0) ; The Candidate web service may accept some foreign countries like Canada. That list is set up in Init. "RTN","DGUAMWS",33,0) I DGFORGN=1 D "RTN","DGUAMWS",34,0) . F DGX=1:1 S DGEXC=$P(DGFRGNEXCPTS,"^",DGX) Q:DGEXC="" D "RTN","DGUAMWS",35,0) . . I DGADDRESS(1,DGCOUNTRY)=DGEXC S DGFORGN=2 ; Foreign country on exceptions list "RTN","DGUAMWS",36,0) ; Quit if server or services not installed "RTN","DGUAMWS",37,0) I '$$FIND1^DIC(18.12,,"B","DG UAM AV SERVER")!('$$FIND1^DIC(18.02,,"B","DG UAM AV CANDIDATE"))!('$$FIND1^DIC(18.02,,"B","DG UAM AV VALIDATE")) Q "0^Web services are not set up" "RTN","DGUAMWS",38,0) ; Call web server and web service. API key is set in Context Root of the web service in HWSC. "RTN","DGUAMWS",39,0) S DGSERVICE=$S(DGFORGN=1:"DG UAM AV VALIDATE",1:"DG UAM AV CANDIDATE") "RTN","DGUAMWS",40,0) S DGHTTPREQ=$$GETREST^XOBWLIB(DGSERVICE,"DG UAM AV SERVER") "RTN","DGUAMWS",41,0) S DGHTTPREQ.SSLCheckServerIdentity = 0 ; Older versions of xobw.WebServer.cls don't set this value. Setting here to prevent Error #6156 during the POST below. "RTN","DGUAMWS",42,0) ; "RTN","DGUAMWS",43,0) ; JSON specific setup "RTN","DGUAMWS",44,0) S DGJSON=$$JSONREQUEST(.DGADDRESS,DGFLDS) "RTN","DGUAMWS",45,0) D DGHTTPREQ.EntityBody.Write(DGJSON) ; places the entire json string into EntityBody "RTN","DGUAMWS",46,0) F DGHEADER="Accept","ContentType" D DGHTTPREQ.SetHeader(DGHEADER,"application/json") "RTN","DGUAMWS",47,0) ; "RTN","DGUAMWS",48,0) ; DG*5.3*1065 - Get API Key from PARAMETER file (#8989.5), parameter instance DG UAM API KEY and set it into the header "RTN","DGUAMWS",49,0) S DGKEY=$$GET^XPAR("PKG","DG UAM API KEY",1) "RTN","DGUAMWS",50,0) D DGHTTPREQ.SetHeader("apiKey",DGKEY) "RTN","DGUAMWS",51,0) ; "RTN","DGUAMWS",52,0) ; REST API Post Call and Response (response is in DGHTTPREQ.HttpResponse) "RTN","DGUAMWS",53,0) S DGRESPONSE=$$POST^XOBWLIB(DGHTTPREQ,"",.DGRESPERR,0) "RTN","DGUAMWS",54,0) I ('DGRESPONSE) Q "0^"_$$ERRRSPMSG(DGRESPERR) "RTN","DGUAMWS",55,0) S DGHTTPRESP=DGHTTPREQ.HttpResponse "RTN","DGUAMWS",56,0) S DGDATA=DGHTTPRESP.Data.ReadLine() ; reads json string response from the data stream. "RTN","DGUAMWS",57,0) ; "RTN","DGUAMWS",58,0) ; convert json string to an array, parse results and return in DGADDRESS array. "RTN","DGUAMWS",59,0) D DECODE^XLFJSON("DGDATA","DGARRAY") "RTN","DGUAMWS",60,0) I DGFORGN=1 D VALRESULTS(.DGADDRESS,.DGARRAY) "RTN","DGUAMWS",61,0) I DGFORGN'=1 D CANDRESULTS(.DGADDRESS,.DGARRAY) "RTN","DGUAMWS",62,0) ; "RTN","DGUAMWS",63,0) S DGSTAT=$S($Order(DGADDRESS(1)):1,1:0) ; if there are no results to return set status to "0" "RTN","DGUAMWS",64,0) Q DGSTAT_"^"_$$RSPMSG(DGHTTPRESP.StatusCode,.DGRESPMSG) "RTN","DGUAMWS",65,0) ; "RTN","DGUAMWS",66,0) ERRRSPMSG(DGRESPERR) ; "RTN","DGUAMWS",67,0) ; Input : DGRESPERR (Required) - response error from Post call "RTN","DGUAMWS",68,0) ; Return: response code/txt (ex: DGERR(400) from Init)_response code/msg (ex: ADDRVAL###) "RTN","DGUAMWS",69,0) N DGERRARR "RTN","DGUAMWS",70,0) ;D ZTER^XOBWLIB(DGRESPERR), DG*5.3*1084 adds the APPERROR^%ZTER API for proper error handling "RTN","DGUAMWS",71,0) D ERR2ARR^XOBWLIB(DGRESPERR,.DGERRARR) "RTN","DGUAMWS",72,0) N DGERRCODE S DGERRCODE=DGRESPERR.code "RTN","DGUAMWS",73,0) D APPERROR^%ZTER(DGERRCODE_" HTTP/Webservice error") "RTN","DGUAMWS",74,0) I '$D(DGERR(DGERRCODE)) Q DGERRCODE_" An error occurred and has been logged. The service is currently not available." "RTN","DGUAMWS",75,0) E Q DGERR(DGERRCODE) "RTN","DGUAMWS",76,0) ; "RTN","DGUAMWS",77,0) RSPMSG(DGSTCODE,DGRESPMSG) ; "RTN","DGUAMWS",78,0) ; Input : DGSTCODE (Required) - response statuscode from DGHTTPRESP "RTN","DGUAMWS",79,0) ; : DGRESPMSG - response message from DGDATA "RTN","DGUAMWS",80,0) ; Return: response code/txt (ex: DGERR(400) from Init)_response code/msg (ex: ADDRVAL###) "RTN","DGUAMWS",81,0) Q DGERR(DGSTCODE) "RTN","DGUAMWS",82,0) ; "RTN","DGUAMWS",83,0) JSONREQUEST(DGADDRESS,DGFLDS) ; places the address elements in the json string "RTN","DGUAMWS",84,0) ; Input : DGADDRESS (Required, pass by reference) - Array containing the address to be validated "RTN","DGUAMWS",85,0) ; DGFLDS (Required) - List of fileman field values. See "Address fields" in Init "RTN","DGUAMWS",86,0) ; Return: DGJSON(1) - a json string "RTN","DGUAMWS",87,0) ; "RTN","DGUAMWS",88,0) ; Format of DGADDRESS array "RTN","DGUAMWS",89,0) ; DGADDRESS(field#)=VALUE "RTN","DGUAMWS",90,0) ; "RTN","DGUAMWS",91,0) ; if a foreign address, get value from Province if it was entered "RTN","DGUAMWS",92,0) N DGSTATEPROV,DGJSON,DGSTCODE "RTN","DGUAMWS",93,0) S DGSTATEPROV=$G(DGADDRESS(1,DGSTATE)) "RTN","DGUAMWS",94,0) ; Address is the full name, which UAM may not always recognize, so get the abbreviation "RTN","DGUAMWS",95,0) S DGSTCODE=$P(DGSTATEPROV,"^",2) "RTN","DGUAMWS",96,0) I DGSTCODE'="" S $P(DGSTATEPROV,"^",1)=$$GET1^DIQ(5,DGSTCODE,1) "RTN","DGUAMWS",97,0) I (DGFORGN=1)&($G(DGADDRESS(1,DGPROV))'="") S DGSTATEPROV=DGADDRESS(1,DGPROV) "RTN","DGUAMWS",98,0) ; DGSTATEPROV and DGADDRESS(1,DGCOUNTRY) will be stripped of the "^CODE" coming from VistA "RTN","DGUAMWS",99,0) S DGJSON("requestAddress","addressLine1")=$G(DGADDRESS(1,DGADDRLN1)) "RTN","DGUAMWS",100,0) S DGJSON("requestAddress","addressLine2")=$G(DGADDRESS(1,DGADDRLN2)) "RTN","DGUAMWS",101,0) S DGJSON("requestAddress","addressLine3")=$G(DGADDRESS(1,DGADDRLN3)) "RTN","DGUAMWS",102,0) S DGJSON("requestAddress","addressPOU")="CORRESPONDENCE" "RTN","DGUAMWS",103,0) S DGJSON("requestAddress","city")=$G(DGADDRESS(1,DGCITY)) "RTN","DGUAMWS",104,0) S DGJSON("requestAddress","internationalPostalCode")=$G(DGADDRESS(1,DGPOSTCODE)) "RTN","DGUAMWS",105,0) S DGJSON("requestAddress","requestCountry","countryCode")="" "RTN","DGUAMWS",106,0) S DGJSON("requestAddress","requestCountry","countryName")=$P($G(DGADDRESS(1,DGCOUNTRY)),"^",1) "RTN","DGUAMWS",107,0) S DGJSON("requestAddress","stateProvince","name")=$P(DGSTATEPROV,"^",1) "RTN","DGUAMWS",108,0) S DGJSON("requestAddress","stateProvince","code")="" "RTN","DGUAMWS",109,0) S DGJSON("requestAddress","zipCode4")="" "RTN","DGUAMWS",110,0) S DGJSON("requestAddress","zipCode5")=$G(DGADDRESS(1,DGZIP)) "RTN","DGUAMWS",111,0) D ENCODE^XLFJSON("DGJSON","DGJSON") "RTN","DGUAMWS",112,0) ; "RTN","DGUAMWS",113,0) ; The resultant DGJSON string above is formatted as follows "RTN","DGUAMWS",114,0) ; { "RTN","DGUAMWS",115,0) ; "requestAddress": { "RTN","DGUAMWS",116,0) ; "addressLine1": ($G(DGADDRESS(1,DGADDRLN1))), "RTN","DGUAMWS",117,0) ; "addressLine2": ($G(DGADDRESS(1,DGADDRLN2))), "RTN","DGUAMWS",118,0) ; "addressLine3": ($G(DGADDRESS(1,DGADDRLN3))), "RTN","DGUAMWS",119,0) ; "addressPOU": "CORRESPONDENCE", "RTN","DGUAMWS",120,0) ; "city": ($G(DGADDRESS(1,DGCITY))), "RTN","DGUAMWS",121,0) ; "internationalPostalCode": ($G(DGADDRESS(1,DGPOSTCODE))), "RTN","DGUAMWS",122,0) ; "requestCountry": { "RTN","DGUAMWS",123,0) ; "countryCode": "", "RTN","DGUAMWS",124,0) ; "countryName": ($P($G(DGADDRESS(1,DGCOUNTRY)),"^",1))}, "RTN","DGUAMWS",125,0) ; "stateProvince": { "RTN","DGUAMWS",126,0) ; "code": "", "RTN","DGUAMWS",127,0) ; "name": ($P(DGSTATEPROV,"^",1))}, "RTN","DGUAMWS",128,0) ; "zipCode4": "", "RTN","DGUAMWS",129,0) ; "zipCode5": ($G(DGADDRESS(1,DGZIP)))} "RTN","DGUAMWS",130,0) ; } "RTN","DGUAMWS",131,0) Q DGJSON(1) "RTN","DGUAMWS",132,0) ; "RTN","DGUAMWS",133,0) CANDRESULTS(DGADDRESS,DGARRAY) ; handles domestic address response from the Candidate web service. Multiple addresses possible. "RTN","DGUAMWS",134,0) ; Input : DGADDRESS (Required, pass by reference) - Array containing the address to be updated and returned "RTN","DGUAMWS",135,0) ; DGARRAY - Array representation of JSON response. "RTN","DGUAMWS",136,0) ; Return: DGADDRESS "RTN","DGUAMWS",137,0) N DGADDR,DGTEMP,DGCNT,DGADDCNT "RTN","DGUAMWS",138,0) S DGADDCNT=1,DGCNT="" "RTN","DGUAMWS",139,0) F S DGCNT=$O(DGARRAY("candidateAddresses",DGCNT)) Q:DGCNT="" D "RTN","DGUAMWS",140,0) . MERGE DGADDR=DGARRAY("candidateAddresses",DGCNT,"address") "RTN","DGUAMWS",141,0) . MERGE DGADDR=DGARRAY("candidateAddresses",DGCNT,"addressMetaData") "RTN","DGUAMWS",142,0) . I $$SETRRESULTS D "RTN","DGUAMWS",143,0) . . S DGADDCNT=DGADDCNT+1 "RTN","DGUAMWS",144,0) . . MERGE DGADDRESS(DGADDCNT)=DGTEMP ; DGADDRESS contains original address in 1 "RTN","DGUAMWS",145,0) Q "RTN","DGUAMWS",146,0) ; "RTN","DGUAMWS",147,0) VALRESULTS(DGADDRESS,DGARRAY) ; handles the foreign address response from the Validate web service. Only one address is returned. "RTN","DGUAMWS",148,0) ; Input : DGADDRESS (Required, pass by reference) - Array containing the address to be updated and returned "RTN","DGUAMWS",149,0) ; DGARRAY - Array representation of JSON response. "RTN","DGUAMWS",150,0) ; Return: DGADDRESS "RTN","DGUAMWS",151,0) N DGADDR,DGTEMP "RTN","DGUAMWS",152,0) MERGE DGADDR=DGARRAY("addressMetaData") "RTN","DGUAMWS",153,0) MERGE DGADDR=DGARRAY("address") "RTN","DGUAMWS",154,0) I $$SETRRESULTS MERGE DGADDRESS(2)=DGTEMP ; DGADDRESS contains original address in 1 "RTN","DGUAMWS",155,0) Q "RTN","DGUAMWS",156,0) ; "RTN","DGUAMWS",157,0) SETRRESULTS() ; checks if Confidence Score is greater than 80 and sets values. "RTN","DGUAMWS",158,0) ; Assumptions: DGADDR contains one address from DGADDRESS "RTN","DGUAMWS",159,0) ; Return: 1 - Confidence Score is at or above 80. 0 - Confidence Score is below 80. "RTN","DGUAMWS",160,0) ; DGTEMP contains data from address. "RTN","DGUAMWS",161,0) N DGVAL "RTN","DGUAMWS",162,0) S DGTEMP("confidenceScore")=$G(DGADDR("confidenceScore")) "RTN","DGUAMWS",163,0) S DGTEMP("deliveryPoint")=$G(DGADDR("deliveryPointValidation")) "RTN","DGUAMWS",164,0) I DGTEMP("confidenceScore")<80 Q 0 "RTN","DGUAMWS",165,0) S DGTEMP(DGADDRLN1)=$G(DGADDR("addressLine1")) "RTN","DGUAMWS",166,0) S DGTEMP(DGADDRLN2)=$G(DGADDR("addressLine2")) "RTN","DGUAMWS",167,0) S DGTEMP(DGADDRLN3)=$G(DGADDR("addressLine3")) "RTN","DGUAMWS",168,0) S DGTEMP(DGCITY)=$G(DGADDR("city")) "RTN","DGUAMWS",169,0) S DGTEMP(DGCOUNTRY)=$G(DGADDR("country","name")) "RTN","DGUAMWS",170,0) I DGFORGN=0 D "RTN","DGUAMWS",171,0) . S DGTEMP(DGSTATE)=$G(DGADDR("stateProvince","name")) "RTN","DGUAMWS",172,0) . ; Some addresses such as APO and FPO return state code only, not the name "RTN","DGUAMWS",173,0) . I DGTEMP(DGSTATE)="" S DGTEMP(DGSTATE)=$G(DGADDR("stateProvince","code")) "RTN","DGUAMWS",174,0) I DGFORGN S DGTEMP(DGPROV)=$G(DGADDR("stateProvince","name")) "RTN","DGUAMWS",175,0) S DGTEMP(DGZIP)=$G(DGADDR("zipCode5"))_$G(DGADDR("zipCode4")) "RTN","DGUAMWS",176,0) S DGTEMP(DGPOSTCODE)=$G(DGADDR("internationalPostalCode")) "RTN","DGUAMWS",177,0) ; traverse through DGTEMP array and convert all values to UPPERCASE. "RTN","DGUAMWS",178,0) S DGVAL="DGTEMP" F S DGVAL=$QUERY(@DGVAL) Q:DGVAL="" S @DGVAL=$$UPPER^DGUTL(@DGVAL) "RTN","DGUAMWS",179,0) Q 1 "RTN","DGUAMWS",180,0) INIT ; Initialized variables "RTN","DGUAMWS",181,0) ; Get foreign country exceptions "RTN","DGUAMWS",182,0) S DGFRGNEXCPTS="CAN^CANADA" "RTN","DGUAMWS",183,0) ; "RTN","DGUAMWS",184,0) ; 1 2 3 4 5 6 7 8 9 10 "RTN","DGUAMWS",185,0) ; Mapping: "AddressLine1,AddressLine2,AddressLine3,City,State,County,ZipCode,Province,PostalCode,Country" "RTN","DGUAMWS",186,0) ; DGFLDS will contain one of the following list of subscripts that are used by DGADDRESS "RTN","DGUAMWS",187,0) ; Permanent Address fields : ".111,.112,.113,.114,.115,.117,.1112,.1171,.1172,.1173" "RTN","DGUAMWS",188,0) ; Residential Address fields : ".1151,.1152,.1153,.1154,.1155,.1157,.1156,.11571,.11572,.11573" "RTN","DGUAMWS",189,0) ; Confidential Address fields: ".1411,.1412,.1413,.1414,.1415,.14111,.1416,.14114,.14115,.14116" "RTN","DGUAMWS",190,0) S DGADDRLN1=$P(DGFLDS,",",1) "RTN","DGUAMWS",191,0) S DGADDRLN2=$P(DGFLDS,",",2) "RTN","DGUAMWS",192,0) S DGADDRLN3=$P(DGFLDS,",",3) "RTN","DGUAMWS",193,0) S DGCITY=$P(DGFLDS,",",4) "RTN","DGUAMWS",194,0) S DGSTATE=$P(DGFLDS,",",5) "RTN","DGUAMWS",195,0) S DGZIP=$P(DGFLDS,",",7) "RTN","DGUAMWS",196,0) S DGPROV=$P(DGFLDS,",",8) "RTN","DGUAMWS",197,0) S DGPOSTCODE=$P(DGFLDS,",",9) "RTN","DGUAMWS",198,0) S DGCOUNTRY=$P(DGFLDS,",",10) "RTN","DGUAMWS",199,0) ; Response Codes/Text "RTN","DGUAMWS",200,0) S DGERR(200)="200 Successful Request/Response from server. " ; may append messages "RTN","DGUAMWS",201,0) S DGERR(400)="400 Error. " ; will append messages "RTN","DGUAMWS",202,0) S DGERR(403)="403 Not authorized. Please verify credentials used in the request. " "RTN","DGUAMWS",203,0) S DGERR(404)="404 The record you requested to retrieve or update could not be found. " "RTN","DGUAMWS",204,0) S DGERR(429)="429 You have exhausted the approved request quota for this API. This request should be retried after the quota window expires (default 60sec). " "RTN","DGUAMWS",205,0) S DGERR(500)="500 Error. " ; will append messages "RTN","DGUAMWS",206,0) Q "VER") 8.0^22.2 "BLD",12700,6) ^949 **END** **END**