DGCNTRY ;BAJ,JAM,JAM - REGISTRATION SCREEN 7/CROSS REFERENCE CLEANUP ;15 Feb 2018 4:03 PM
;;5.3;Registration;**688,941,997**;Aug 13, 1993;Build 42
;
; This routine is called by a New style MUMPS index named AXCNTRY
; The purpose of this routine is to clear certain fields when the Country field is changed
; Values: X1(#) contains the OLD values
; X2(#) contains the NEW values
;
; DG*5.3*941 - JAM - Updated for Residential Address fields - see tag DTABLE. Related to index AXRCNTRY.
; DG*5.3*997 - JAM - Updated for NOK/E-Contact Address fields - see tag DTABLE. Related to indexes AXNCNTRY, AXN2CNTRY, AXECNTRY, AXE2CNTRY, AXDCNTRY.
;
EN(FILE,ATYPE,FIELD) ; entry point
;
; Code to TRIGGER deletion of field data.
N DGENDA,DATA,FORGN,ERROR
Q:X=""
S DGENDA=DA,ERROR=""
S FORGN=$$FORGN(.X2) D SETARR(.DATA,FORGN,FILE,ATYPE,FIELD)
Q $$UPD^DGENDBS(FILE,.DGENDA,.DATA,.ERROR)
;
SETARR(DATA,FORGN,FILE,ATYPE,FIELD) ;set up data array
N CNT,CURFILE,CTRYFLD,FDFLG,ADDTYPE,T,FTYPE,CURFTYPE
; If foreign kill domestic fields and vice versa
S FTYPE=$S(FORGN:"D",1:"F")
F CNT=1:1 S T=$P($T(DTABLE+CNT),";;",3) Q:T="QUIT" D
. S CURFTYPE=$P(T,";",1),ADDTYPE=$P(T,";",2),CURFILE=$P(T,";",3),CTRYFLD=$P(T,";",4),CURFLD=$P(T,";",5)
. I CURFTYPE=FTYPE,CURFILE=FILE,ADDTYPE=ATYPE,CTRYFLD=FIELD S DATA(CURFLD)="@"
Q
FORGN(X2) ; logic to determine if COUNTRY is US or Foreign
Q $$FORIEN^DGADDUTL(X2(1))
;
DTABLE ;TABLE of Foreign and Domestic fields: structure -->>;DESCRIPTION;;(F)OREIGN/(D)OMESTIC;FILE;COUNTRY FIELD;FIELD
;;PROVINCE;;F;PERM;2;.1173;.1171
;;POSTAL CODE;;F;PERM;2;.1173;.1172
;;STATE;;D;PERM;2;.1173;.115
;;COUNTY;;D;PERM;2;.1173;.1117
;;ZIP+4;;D;PERM;2;.1173;.1112
;;PROVINCE;;F;TEMP;2;.1223;.1221
;;POSTAL CODE;;F;TEMP;2;.1223;.1222
;;STATE;;D;TEMP;2;.1223;.1215
;;COUNTY;;D;TEMP;2;.1223;.12111
;;ZIP+4;;D;TEMP;2;.1223;.12112
;;PROVINCE;;F;CONF;2;.14116;.14114
;;POSTAL CODE;;F;CONF;2;.14116;.14115
;;STATE;;D;CONF;2;.14116;.1415
;;COUNTY;;D;CONF;2;.14116;.14111
;;ZIP+4;;D;CONF;2;.14116;.1416
;;PROVINCE;;F;RESI;2;.11573;.11571
;;POSTAL CODE;;F;RESI;2;.11573;.11572
;;STATE;;D;RESI;2;.11573;.1155
;;COUNTY;;D;RESI;2;.11573;.1157
;;ZIP+4;;D;RESI;2;.11573;.1156
;;PROVINCE;;F;NOK;2;.221;.222
;;POSTAL CODE;;F;NOK;2;.221;.223
;;STATE;;D;NOK;2;.221;.217
;;ZIP+4;;D;NOK;2;.221;.2207
;;PROVINCE;;F;NOK2;2;.2101;.2102
;;POSTAL CODE;;F;NOK2;2;.2101;.2103
;;STATE;;D;NOK2;2;.2101;.2197
;;ZIP+4;;D;NOK2;2;.2101;.2203
;;PROVINCE;;F;EC;2;.3306;.3307
;;POSTAL CODE;;F;EC;2;.3306;.3308
;;STATE;;D;EC;2;.3306;.337
;;ZIP+4;;D;EC;2;.3306;.2201
;;PROVINCE;;F;EC2;2;.331012;.331013
;;POSTAL CODE;;F;EC2;2;.331012;.331014
;;STATE;;D;EC2;2;.331012;.3317
;;ZIP+4;;D;EC2;2;.331012;.2204
;;PROVINCE;;F;DES;2;.34012;.34013
;;POSTAL CODE;;F;DES;2;.34012;.34014
;;STATE;;D;DES;2;.34012;.347
;;ZIP+4;;D;DES;2;.34012;.2202
;;QUIT;;QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGCNTRY 2998 printed Sep 23, 2025@20:17:30 Page 2
DGCNTRY ;BAJ,JAM,JAM - REGISTRATION SCREEN 7/CROSS REFERENCE CLEANUP ;15 Feb 2018 4:03 PM
+1 ;;5.3;Registration;**688,941,997**;Aug 13, 1993;Build 42
+2 ;
+3 ; This routine is called by a New style MUMPS index named AXCNTRY
+4 ; The purpose of this routine is to clear certain fields when the Country field is changed
+5 ; Values: X1(#) contains the OLD values
+6 ; X2(#) contains the NEW values
+7 ;
+8 ; DG*5.3*941 - JAM - Updated for Residential Address fields - see tag DTABLE. Related to index AXRCNTRY.
+9 ; DG*5.3*997 - JAM - Updated for NOK/E-Contact Address fields - see tag DTABLE. Related to indexes AXNCNTRY, AXN2CNTRY, AXECNTRY, AXE2CNTRY, AXDCNTRY.
+10 ;
EN(FILE,ATYPE,FIELD) ; entry point
+1 ;
+2 ; Code to TRIGGER deletion of field data.
+3 NEW DGENDA,DATA,FORGN,ERROR
+4 if X=""
QUIT
+5 SET DGENDA=DA
SET ERROR=""
+6 SET FORGN=$$FORGN(.X2)
DO SETARR(.DATA,FORGN,FILE,ATYPE,FIELD)
+7 QUIT $$UPD^DGENDBS(FILE,.DGENDA,.DATA,.ERROR)
+8 ;
SETARR(DATA,FORGN,FILE,ATYPE,FIELD) ;set up data array
+1 NEW CNT,CURFILE,CTRYFLD,FDFLG,ADDTYPE,T,FTYPE,CURFTYPE
+2 ; If foreign kill domestic fields and vice versa
+3 SET FTYPE=$SELECT(FORGN:"D",1:"F")
+4 FOR CNT=1:1
SET T=$PIECE($TEXT(DTABLE+CNT),";;",3)
if T="QUIT"
QUIT
Begin DoDot:1
+5 SET CURFTYPE=$PIECE(T,";",1)
SET ADDTYPE=$PIECE(T,";",2)
SET CURFILE=$PIECE(T,";",3)
SET CTRYFLD=$PIECE(T,";",4)
SET CURFLD=$PIECE(T,";",5)
+6 IF CURFTYPE=FTYPE
IF CURFILE=FILE
IF ADDTYPE=ATYPE
IF CTRYFLD=FIELD
SET DATA(CURFLD)="@"
End DoDot:1
+7 QUIT
FORGN(X2) ; logic to determine if COUNTRY is US or Foreign
+1 QUIT $$FORIEN^DGADDUTL(X2(1))
+2 ;
DTABLE ;TABLE of Foreign and Domestic fields: structure -->>;DESCRIPTION;;(F)OREIGN/(D)OMESTIC;FILE;COUNTRY FIELD;FIELD
+1 ;;PROVINCE;;F;PERM;2;.1173;.1171
+2 ;;POSTAL CODE;;F;PERM;2;.1173;.1172
+3 ;;STATE;;D;PERM;2;.1173;.115
+4 ;;COUNTY;;D;PERM;2;.1173;.1117
+5 ;;ZIP+4;;D;PERM;2;.1173;.1112
+6 ;;PROVINCE;;F;TEMP;2;.1223;.1221
+7 ;;POSTAL CODE;;F;TEMP;2;.1223;.1222
+8 ;;STATE;;D;TEMP;2;.1223;.1215
+9 ;;COUNTY;;D;TEMP;2;.1223;.12111
+10 ;;ZIP+4;;D;TEMP;2;.1223;.12112
+11 ;;PROVINCE;;F;CONF;2;.14116;.14114
+12 ;;POSTAL CODE;;F;CONF;2;.14116;.14115
+13 ;;STATE;;D;CONF;2;.14116;.1415
+14 ;;COUNTY;;D;CONF;2;.14116;.14111
+15 ;;ZIP+4;;D;CONF;2;.14116;.1416
+16 ;;PROVINCE;;F;RESI;2;.11573;.11571
+17 ;;POSTAL CODE;;F;RESI;2;.11573;.11572
+18 ;;STATE;;D;RESI;2;.11573;.1155
+19 ;;COUNTY;;D;RESI;2;.11573;.1157
+20 ;;ZIP+4;;D;RESI;2;.11573;.1156
+21 ;;PROVINCE;;F;NOK;2;.221;.222
+22 ;;POSTAL CODE;;F;NOK;2;.221;.223
+23 ;;STATE;;D;NOK;2;.221;.217
+24 ;;ZIP+4;;D;NOK;2;.221;.2207
+25 ;;PROVINCE;;F;NOK2;2;.2101;.2102
+26 ;;POSTAL CODE;;F;NOK2;2;.2101;.2103
+27 ;;STATE;;D;NOK2;2;.2101;.2197
+28 ;;ZIP+4;;D;NOK2;2;.2101;.2203
+29 ;;PROVINCE;;F;EC;2;.3306;.3307
+30 ;;POSTAL CODE;;F;EC;2;.3306;.3308
+31 ;;STATE;;D;EC;2;.3306;.337
+32 ;;ZIP+4;;D;EC;2;.3306;.2201
+33 ;;PROVINCE;;F;EC2;2;.331012;.331013
+34 ;;POSTAL CODE;;F;EC2;2;.331012;.331014
+35 ;;STATE;;D;EC2;2;.331012;.3317
+36 ;;ZIP+4;;D;EC2;2;.331012;.2204
+37 ;;PROVINCE;;F;DES;2;.34012;.34013
+38 ;;POSTAL CODE;;F;DES;2;.34012;.34014
+39 ;;STATE;;D;DES;2;.34012;.347
+40 ;;ZIP+4;;D;DES;2;.34012;.2202
+41 ;;QUIT;;QUIT
