VPRSDAD.m

VPRSDAD ;OIT/CF -- SDA DPT utilities ;10/25/18  15:29

 ;;1.0;VIRTUAL PATIENT RECORD;**14**;Sep 01, 2011;Build 38

 ;;Per VHA Directive 6402, this routine should not be modified.

 ;

 ; External References          DBIA#

 ; -------------------          -----

 ; DIQ                           2056

 ;

SID ; -- State GET ID Action

 ; ForeignCountryFlag set & cleaned up patient address entities 

 Q:+$G(VPR("ForeignCountryFlag"))=0

 S DIENTY=+$O(^DDE("B","VPR CODE ONLY",0)) I DIENTY<1 S DDEOUT=1 Q

 S DNAME="State"

 Q

 ;

FCF ; set ForeignCountryFlag

 S VPR("ForeignCountryFlag")=1

 Q

 ;

NUSC(VPRX) ; boolean true if non-United States country

 Q VPRX'=""&(VPRX'="UNITED STATES")&(VPRX'="USA")

 ;

ADD(DFN) ; -- flag if foreign address fields for VPR PATIENT ADDRESS

 ; called from GET ID action

 S VAPA("HasCountry")=$$NUSC($$GET1^DIQ(2,DFN_",",.1173))

 D:VAPA("HasCountry")=1 

 .;S VATEMP("Province")=$$GET1^DIQ(2,DFN_",",.1171)

 .;S VATEMP("PostalCode")=$$GET1^DIQ(2,DFN_",",.1172)

 .D FCF

 Q

 ;

TEMP(DFN) ; -- populate foreign address fields for VPR PATIENT TEMP ADDRESS

 ; called from GET ID action

 S VATEMP("HasCountry")=$$NUSC($$GET1^DIQ(2,DFN_",",.1223))

 D:VATEMP("HasCountry")=1 

 .S VATEMP("Province")=$$GET1^DIQ(2,DFN_",",.1221)

 .S VATEMP("PostalCode")=$$GET1^DIQ(2,DFN_",",.1222)

 .D FCF

 Q

 ;

NOK(DFN) ; -- populate foreign address fields for VPR PATIENT NOK ADDRESS

 ; called from GET ID action

 S VAOA("HasCountry")=$$NUSC($$GET1^DIQ(2,DFN_",",.221))

 D:VAOA("HasCountry")=1 

 .S VAOA("Province")=$$GET1^DIQ(2,DFN_",",.222)

 .S VAOA("PostalCode")=$$GET1^DIQ(2,DFN_",",.223)

 .D FCF

 Q

 ;

NOK2(DFN) ; -- populate foreign address fields for VPR PATIENT NOK2 ADDRESS

 ; called from GET ID action

 S VAOA("HasCountry")=$$NUSC($$GET1^DIQ(2,DFN_",",.2101))

 D:VAOA("HasCountry")=1 

 .S VAOA("Province")=$$GET1^DIQ(2,DFN_",",.2102)

 .S VAOA("PostalCode")=$$GET1^DIQ(2,DFN_",",.2103)

 .D FCF

 Q

 ;

ECON(DFN) ; -- populate foreign address fields for VPR PATIENT ECON ADDRESS

 ; called from GET ID action

 S VAOA("HasCountry")=$$NUSC($$GET1^DIQ(2,DFN_",",.3306))

 D:VAOA("HasCountry")=1 

 .S VAOA("Province")=$$GET1^DIQ(2,DFN_",",.3307)

 .S VAOA("PostalCode")=$$GET1^DIQ(2,DFN_",",.3308)

 .D FCF

 Q

 ;

ECON2(DFN) ; -- populate foreign address fields for VPR PATIENT ECON2 ADDRESS

 ; called from GET ID action

 S VAOA("HasCountry")=$$NUSC($$GET1^DIQ(2,DFN_",",.331012))

 D:VAOA("HasCountry")=1 

 .S VAOA("Province")=$$GET1^DIQ(2,DFN_",",.331013)

 .S VAOA("PostalCode")=$$GET1^DIQ(2,DFN_",",.331014)

 .D FCF

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---VPRSDAD   2585     printed  Feb 19, 2025@00:12:15                                                                                                                                                                                                     Page 2

VPRSDAD   ;OIT/CF -- SDA DPT utilities ;10/25/18  15:29

 +1       ;;1.0;VIRTUAL PATIENT RECORD;**14**;Sep 01, 2011;Build 38

 +2       ;;Per VHA Directive 6402, this routine should not be modified.

 +3       ;

 +4       ; External References          DBIA#

 +5       ; -------------------          -----

 +6       ; DIQ                           2056

 +7       ;

SID       ; -- State GET ID Action

 +1       ; ForeignCountryFlag set & cleaned up patient address entities 

 +2        if +$GET(VPR("ForeignCountryFlag"))=0

               QUIT 

 +3        SET DIENTY=+$ORDER(^DDE("B","VPR CODE ONLY",0))

           IF DIENTY<1

               SET DDEOUT=1

               QUIT 

 +4        SET DNAME="State"

 +5        QUIT 

 +6       ;

FCF       ; set ForeignCountryFlag

 +1        SET VPR("ForeignCountryFlag")=1

 +2        QUIT 

 +3       ;

NUSC(VPRX) ; boolean true if non-United States country

 +1        QUIT VPRX'=""&(VPRX'="UNITED STATES")&(VPRX'="USA")

 +2       ;

ADD(DFN)  ; -- flag if foreign address fields for VPR PATIENT ADDRESS

 +1       ; called from GET ID action

 +2        SET VAPA("HasCountry")=$$NUSC($$GET1^DIQ(2,DFN_",",.1173))

 +3        if VAPA("HasCountry")=1

               Begin DoDot:1

 +4       ;S VATEMP("Province")=$$GET1^DIQ(2,DFN_",",.1171)

 +5       ;S VATEMP("PostalCode")=$$GET1^DIQ(2,DFN_",",.1172)

 +6                DO FCF

               End DoDot:1

 +7        QUIT 

 +8       ;

TEMP(DFN) ; -- populate foreign address fields for VPR PATIENT TEMP ADDRESS

 +1       ; called from GET ID action

 +2        SET VATEMP("HasCountry")=$$NUSC($$GET1^DIQ(2,DFN_",",.1223))

 +3        if VATEMP("HasCountry")=1

               Begin DoDot:1

 +4                SET VATEMP("Province")=$$GET1^DIQ(2,DFN_",",.1221)

 +5                SET VATEMP("PostalCode")=$$GET1^DIQ(2,DFN_",",.1222)

 +6                DO FCF

               End DoDot:1

 +7        QUIT 

 +8       ;

NOK(DFN)  ; -- populate foreign address fields for VPR PATIENT NOK ADDRESS

 +1       ; called from GET ID action

 +2        SET VAOA("HasCountry")=$$NUSC($$GET1^DIQ(2,DFN_",",.221))

 +3        if VAOA("HasCountry")=1

               Begin DoDot:1

 +4                SET VAOA("Province")=$$GET1^DIQ(2,DFN_",",.222)

 +5                SET VAOA("PostalCode")=$$GET1^DIQ(2,DFN_",",.223)

 +6                DO FCF

               End DoDot:1

 +7        QUIT 

 +8       ;

NOK2(DFN) ; -- populate foreign address fields for VPR PATIENT NOK2 ADDRESS

 +1       ; called from GET ID action

 +2        SET VAOA("HasCountry")=$$NUSC($$GET1^DIQ(2,DFN_",",.2101))

 +3        if VAOA("HasCountry")=1

               Begin DoDot:1

 +4                SET VAOA("Province")=$$GET1^DIQ(2,DFN_",",.2102)

 +5                SET VAOA("PostalCode")=$$GET1^DIQ(2,DFN_",",.2103)

 +6                DO FCF

               End DoDot:1

 +7        QUIT 

 +8       ;

ECON(DFN) ; -- populate foreign address fields for VPR PATIENT ECON ADDRESS

 +1       ; called from GET ID action

 +2        SET VAOA("HasCountry")=$$NUSC($$GET1^DIQ(2,DFN_",",.3306))

 +3        if VAOA("HasCountry")=1

               Begin DoDot:1

 +4                SET VAOA("Province")=$$GET1^DIQ(2,DFN_",",.3307)

 +5                SET VAOA("PostalCode")=$$GET1^DIQ(2,DFN_",",.3308)

 +6                DO FCF

               End DoDot:1

 +7        QUIT 

 +8       ;

ECON2(DFN) ; -- populate foreign address fields for VPR PATIENT ECON2 ADDRESS

 +1       ; called from GET ID action

 +2        SET VAOA("HasCountry")=$$NUSC($$GET1^DIQ(2,DFN_",",.331012))

 +3        if VAOA("HasCountry")=1

               Begin DoDot:1

 +4                SET VAOA("Province")=$$GET1^DIQ(2,DFN_",",.331013)

 +5                SET VAOA("PostalCode")=$$GET1^DIQ(2,DFN_",",.331014)

 +6                DO FCF

               End DoDot:1

 +7        QUIT