DGREGAED ;ALB/DW/PHH,BAJ,TDM - Address Edit API; 01/03/2006 ; 4/2/09 2:29pm
;;5.3;PIMS;**522,560,658,730,1015,1016**;JUN 30, 2012;Build 20
;;
;; **688** Modifications for Country and Foreign address
;
EN(DFN,FLG,SRC) ;Entry point
;Input:
; DFN (required) - Internal Entry # of Patient File (#2)
; FLG (optional) - Flags of 1 or 0; if null, 0 is assumed. Details:
; FLG(1) - if 1 let user edit phone numbers (field #.131 and #.132)
; FLG(2) - if 1 display before & after address for user confirmation
K EASZIPLK
N DGINPUT,DGCMP,ICNTRY,CNTRY,FORGN,PSTR,OLDC
N I,X,Y
I $G(DFN)="" Q
;I ($G(DFN)'?.N) Q
S FLG(1)=$G(FLG(1)),FLG(2)=$G(FLG(2))
D GETOLD(.DGCMP,DFN)
S CNTRY="",ICNTRY=$P($G(^DPT(DFN,.11)),"^",10) I ICNTRY="" S ICNTRY=1 ;default country is USA if NULL
S OLDC=DGCMP("OLD",.1173),FORGN=$$FOREIGN^DGADDUTL(DFN,ICNTRY,2,.1173,.CNTRY) I FORGN=-1 Q
S FSTR=$$INPT1(DFN,FORGN,.PSTR) ;set up field string of address prompts
S DGINPUT=1 D INPUT(.DGINPUT,DFN,FSTR,CNTRY) I $G(DGINPUT)=-1 Q
I $G(FLG(2))=1 D COMPARE(.DGINPUT,.DGCMP,.FLG)
I '$$CONFIRM() W !,"Change aborted." D EOP Q
N DGPRIOR
D GETPRIOR^DGADDUTL(DFN,.DGPRIOR)
D SAVE(.DGINPUT,DFN,FSTR,FORGN) I $G(SRC)="",+$G(DGNEW) Q
Q:'$$FILEYN^DGADDUTL(.DGPRIOR,.DGINPUT)
D GETUPDTS^DGADDUTL(DFN,.DGINPUT)
D UPDADDLG^DGADDUTL(DFN,.DGPRIOR,.DGINPUT)
Q
INPUT(DGINPUT,DFN,FSTR,CNTRY) ;Let user input address changes
;Output: DGINPUT(field#)=external^internal(if any)
N DIR,X,Y,DA,DGR,DTOUT,DUOUT,DIROUT,DGN,L
F L=1:1:$L(FSTR,",") S DGN=$P(FSTR,",",L),DGINPUT(DGN)="" Q:DGINPUT=-1 D
. I $$SKIP(DGN,.DGINPUT,.FLG) Q
. I DGN=.1112 D ZIPINP(.DGINPUT,DFN) Q
. I '$$READ(DFN,DGN,.Y) S DGINPUT=-1 Q
. I DGN=.121 S Y=$G(Y) D Q
.. I Y="",DGINPUT(DGN)="" Q
.. I $P(Y,U)=$$GET1^DIQ(2,DFN_",",DGN,"I") S DGINPUT(DGN)=$$GET1^DIQ(2,DFN_",",DGN)_U_$P(Y,U) Q
.. S DGINPUT(DGN)=$P(Y(0),U)_U_Y
. S DGINPUT(DGN)=$G(Y)
I DGINPUT'=-1 S DGINPUT(.1173)=CNTRY_"^"_$O(^HL(779.004,"B",CNTRY,""))
Q
GETOLD(DGCMP,DFN) ;populate array with existing address info
N CCIEN,DGCURR,CFORGN,CFSTR,L,T,DGCIEN,DGST,DGCNTY,COUNTRY
S CFORGN=0
; get current country
; If current country is NULL it is old data
; Leave it NULL here because this is not an edit funtion
S CCIEN=$$GET1^DIQ(2,DFN_",","COUNTRY","I")
;I CCIEN="" S CCIEN=$O(^HL(779.004,"D","UNITED STATES",""))
S CFORGN=$$FORIEN^DGADDUTL(CCIEN)
;get current address fields and xlate to ^DIQ format
S CFSTR=$$INPT1(DFN,CFORGN),CFSTR=$TR(CFSTR,",",";")
; Domestic data needs some extra fields
I 'CFORGN S CFSTR=CFSTR_";.114;.115;.117"
D GETS^DIQ(2,DFN_",",CFSTR,"EI","DGCURR")
F L=1:1:$L(CFSTR,";") S T=$P(CFSTR,";",L),DGCMP("OLD",T)=$G(DGCURR(2,DFN_",",T,"E"))
S COUNTRY=$$CNTRYI^DGADDUTL(CCIEN) I COUNTRY=-1 S COUNTRY="UNKNOWN COUNTRY"
S DGCMP("OLD",.1173)=COUNTRY_"^"_CCIEN
I 'CFORGN D
. S DGCIEN=$G(DGCURR(2,DFN_",",.117,"I"))
. S DGST=$G(DGCURR(2,DFN_",",.115,"I"))
. S DGCNTY=$$CNTY^DGREGAZL(DGST,DGCIEN)
. I DGCNTY=-1 S DGCNTY=""
. S DGCMP("OLD",.117)=$P(DGCNTY,U)_" "_$P(DGCNTY,U,3)
Q
;
COMPARE(DGINPUT,DGCMP,FLG) ;Display before & after address fields.
N DGM
M DGCMP("NEW")=DGINPUT
F DGM="OLD","NEW" D
. I DGCMP(DGM,.1173)]"",$$FORIEN^DGADDUTL($P(DGCMP(DGM,.1173),U,2)) D DISPFGN(.DGCMP,DGM,.FLG) Q
. I DGM="NEW" D
. . S DGCNTY=$P($G(DGCMP("NEW",.117)),U)_" "_$P($G(DGCMP("NEW",.117)),U,3)
. . S DGCMP("NEW",.117)=DGCNTY
. . I ($L(DGCMP("NEW",.1112))>5)&($P(DGCMP("NEW",.1112),"-",2)="") S DGCMP("NEW",.1112)=$E(DGCMP("NEW",.1112),1,5)_"-"_$E(DGCMP("NEW",.1112),6,9)
. D DISPUS(.DGCMP,DGM,.FLG)
Q
;
DISPUS(DGCMP,DGM,FLG) ;tag to display US data
N DGCNTRY
W !,?2,"[",DGM," ADDRESS]"
W ?16,$P($G(DGCMP(DGM,.111)),U)
I $P($G(DGCMP(DGM,.112)),U)'="" W !,?16,$P($G(DGCMP(DGM,.112)),U)
I $P($G(DGCMP(DGM,.113)),U)'="" W !,?16,$P($G(DGCMP(DGM,.113)),U)
W !,?16,$P($G(DGCMP(DGM,.114)),U)
W:($P($G(DGCMP(DGM,.114)),U)'="")!($P($G(DGCMP(DGM,.115)),U)'="") ","
W $P($G(DGCMP(DGM,.115)),U)
W " ",$G(DGCMP(DGM,.1112))
S DGCNTRY=$$CNTRYI^DGADDUTL($P($G(DGCMP(DGM,.1173)),U,2))
I DGCNTRY]"",(DGCNTRY'=-1) W !?16,DGCNTRY
I $P($G(DGCMP(DGM,.117)),U)'="" W !,?6," County: ",$P($G(DGCMP(DGM,.117)),U)
I $G(FLG(1))=1 D
. W !,?6," Phone: ",?16,$P($G(DGCMP(DGM,.131)),U)
. W !,?6," Office: ",?16,$P($G(DGCMP(DGM,.132)),U)
W !,?6,"Bad Addr: ",?16,$P($G(DGCMP(DGM,.121)),U)
W !
Q
;
DISPFGN(DGCMP,DGM,FLG) ;tag to display Foreign data
N DGCNTRY
W !,?2,"[",DGM," ADDRESS]"
W ?16,$P($G(DGCMP(DGM,.111)),U)
I $P($G(DGCMP(DGM,.112)),U)'="" W !,?16,$P($G(DGCMP(DGM,.112)),U)
I $P($G(DGCMP(DGM,.113)),U)'="" W !,?16,$P($G(DGCMP(DGM,.113)),U)
W !,?16,$P($G(DGCMP(DGM,.1172)),U)_" "_$P($G(DGCMP(DGM,.114)),U)_" "_$P($G(DGCMP(DGM,.1171)),U)
S DGCNTRY=$$CNTRYI^DGADDUTL($P($G(DGCMP(DGM,.1173)),U,2))
S DGCNTRY=$S(DGCNTRY="":"UNSPECIFIED COUNTRY",DGCNTRY=-1:"UNKNOWN COUNTRY",1:DGCNTRY)
I DGCNTRY]"" W !?16,DGCNTRY
I $G(FLG(1))=1 D
. W !,?6," Phone: ",?16,$P($G(DGCMP(DGM,.131)),U)
. W !,?6," Office: ",?16,$P($G(DGCMP(DGM,.132)),U)
W !,?6,"Bad Addr: ",?16,$P($G(DGCMP(DGM,.121)),U)
W !
Q
;
CONFIRM() ;Confirm if user wants to save the change
N DIR,X,Y,DTOUT,DUOUT,DIROUT
S DIR(0)="Y"
S DIR("A")="Are you sure that you want to save the above changes"
S DIR("?")="Please answer Y for YES or N for NO."
D ^DIR
I $D(DTOUT)!($G(Y)=0) Q 0
I $D(DUOUT)!$D(DIROUT) Q 0
Q 1
SAVE(DGINPUT,DFN,FSTR,FORGN) ;Save changes
N DGN,DGER,DGM,L
S DGER=0
; need to get the country code into the DGINPUT array
; if it's a domestic address, we have to add in CITY,STATE & COUNTY
S FSTR=FSTR_$S('FORGN:",.114,.115,.117,.1173",1:",.1173")
F L=1:1:$L(FSTR,",") S DGN=$P(FSTR,",",L) D
. I ($G(FLG(1))'=1)&((DGN=.131)!(DGN=.132)) Q
. N DGCODE,DGNAME,FDA,MSG
. S DGCODE=$P($G(DGINPUT(DGN)),U,2)
. S DGNAME=$P($G(DGINPUT(DGN)),U)
. S FDA(2,DFN_",",DGN)=$S(DGCODE:DGCODE,1:DGNAME)
. D FILE^DIE($S(DGCODE:"",1:"E"),"FDA","MSG")
. I $D(MSG) D
.. S DGM="",DGER=1
.. W !,"Please review the saved changes!!",!
.. F S DGM=$O(MSG("DIERR",1,"TEXT",DGM)) Q:DGM="" D
... W $G(MSG("DIERR",1,"TEXT",DGM))
I $G(DGER)=0 W !,"Change saved."
D EOP
Q
READ(DFN,DGN,Y) ;Read input, return success
N SUCCESS,DIR,DA,DTOUT,DUOUT,DIROUT,L,POP
S SUCCESS=1,POP=0
F L=0:0 D Q:POP
. S DIR(0)=2_","_DGN
. S DA=DFN
. D ^DIR
. I $D(DTOUT) S POP=1,SUCCESS=0 Q
. I $D(DUOUT)!$D(DIROUT) D UPCT Q
. S POP=1
Q SUCCESS
INPT1(DFN,FORGN,PSTR) ; first address input prompts
N FSTR
; PSTR is the full set of fields domestic & foreign combined
; FSTR is the set of fields depending on Country code
S PSTR=".111,.112,.113,.114,.115,.117,.1112,.1171,.1172,.1173,.131,.132,.121"
S FSTR=".111,.112,.113,.1112,.131,.132,.121"
I FORGN S FSTR=".111,.112,.113,.114,.1171,.1172,.131,.132,.121"
Q FSTR
ZIPINP(DGINPUT,DFN) ; get ZIP+4 input
N DGR
D EN^DGREGAZL(.DGR,DFN)
I $G(DGR)=-1 Q
M DGINPUT=DGR
Q
SKIP(DGN,DGINPUT,FLG) ; determine whether or not to skip this step
N SKIP
S SKIP=0
I ($G(DGINPUT(.111))="")&((DGN=.112)!(DGN=.113)) S SKIP=1
I ($G(DGINPUT(.112))="")&(DGN=.113) S SKIP=1
I ($G(FLG(1))'=1)&((DGN=.131)!(DGN=.132)) S SKIP=1
Q SKIP
EOP ;End of page prompt
N DIR,DTOUT,DUOUT,DIROUT,X,Y
S DIR(0)="E"
S DIR("A")="Press ENTER to continue"
D ^DIR
Q
UPCT ;Indicate "^" or "^^" are unacceptable inputs.
W !,"EXIT NOT ALLOWED ??"
Q
DGREGAED ;ALB/DW/PHH,BAJ,TDM - Address Edit API; 01/03/2006 ; 4/2/09 2:29pm
+1 ;;5.3;PIMS;**522,560,658,730,1015,1016**;JUN 30, 2012;Build 20
+2 ;;
+3 ;; **688** Modifications for Country and Foreign address
+4 ;
EN(DFN,FLG,SRC) ;Entry point
+1 ;Input:
+2 ; DFN (required) - Internal Entry # of Patient File (#2)
+3 ; FLG (optional) - Flags of 1 or 0; if null, 0 is assumed. Details:
+4 ; FLG(1) - if 1 let user edit phone numbers (field #.131 and #.132)
+5 ; FLG(2) - if 1 display before & after address for user confirmation
+6 KILL EASZIPLK
+7 NEW DGINPUT,DGCMP,ICNTRY,CNTRY,FORGN,PSTR,OLDC
+8 NEW I,X,Y
+9 IF $GET(DFN)=""
QUIT
+10 ;I ($G(DFN)'?.N) Q
+11 SET FLG(1)=$GET(FLG(1))
SET FLG(2)=$GET(FLG(2))
+12 DO GETOLD(.DGCMP,DFN)
+13 ;default country is USA if NULL
SET CNTRY=""
SET ICNTRY=$PIECE($GET(^DPT(DFN,.11)),"^",10)
IF ICNTRY=""
SET ICNTRY=1
+14 SET OLDC=DGCMP("OLD",.1173)
SET FORGN=$$FOREIGN^DGADDUTL(DFN,ICNTRY,2,.1173,.CNTRY)
IF FORGN=-1
QUIT
+15 ;set up field string of address prompts
SET FSTR=$$INPT1(DFN,FORGN,.PSTR)
+16 SET DGINPUT=1
DO INPUT(.DGINPUT,DFN,FSTR,CNTRY)
IF $GET(DGINPUT)=-1
QUIT
+17 IF $GET(FLG(2))=1
DO COMPARE(.DGINPUT,.DGCMP,.FLG)
+18 IF '$$CONFIRM()
WRITE !,"Change aborted."
DO EOP
QUIT
+19 NEW DGPRIOR
+20 DO GETPRIOR^DGADDUTL(DFN,.DGPRIOR)
+21 DO SAVE(.DGINPUT,DFN,FSTR,FORGN)
IF $GET(SRC)=""
IF +$GET(DGNEW)
QUIT
+22 IF '$$FILEYN^DGADDUTL(.DGPRIOR,.DGINPUT)
QUIT
+23 DO GETUPDTS^DGADDUTL(DFN,.DGINPUT)
+24 DO UPDADDLG^DGADDUTL(DFN,.DGPRIOR,.DGINPUT)
+25 QUIT
INPUT(DGINPUT,DFN,FSTR,CNTRY) ;Let user input address changes
+1 ;Output: DGINPUT(field#)=external^internal(if any)
+2 NEW DIR,X,Y,DA,DGR,DTOUT,DUOUT,DIROUT,DGN,L
+3 FOR L=1:1:$LENGTH(FSTR,",")
SET DGN=$PIECE(FSTR,",",L)
SET DGINPUT(DGN)=""
IF DGINPUT=-1
QUIT
Begin DoDot:1
+4 IF $$SKIP(DGN,.DGINPUT,.FLG)
QUIT
+5 IF DGN=.1112
DO ZIPINP(.DGINPUT,DFN)
QUIT
+6 IF '$$READ(DFN,DGN,.Y)
SET DGINPUT=-1
QUIT
+7 IF DGN=.121
SET Y=$GET(Y)
Begin DoDot:2
+8 IF Y=""
IF DGINPUT(DGN)=""
QUIT
+9 IF $PIECE(Y,U)=$$GET1^DIQ(2,DFN_",",DGN,"I")
SET DGINPUT(DGN)=$$GET1^DIQ(2,DFN_",",DGN)_U_$PIECE(Y,U)
QUIT
+10 SET DGINPUT(DGN)=$PIECE(Y(0),U)_U_Y
End DoDot:2
QUIT
+11 SET DGINPUT(DGN)=$GET(Y)
End DoDot:1
+12 IF DGINPUT'=-1
SET DGINPUT(.1173)=CNTRY_"^"_$ORDER(^HL(779.004,"B",CNTRY,""))
+13 QUIT
GETOLD(DGCMP,DFN) ;populate array with existing address info
+1 NEW CCIEN,DGCURR,CFORGN,CFSTR,L,T,DGCIEN,DGST,DGCNTY,COUNTRY
+2 SET CFORGN=0
+3 ; get current country
+4 ; If current country is NULL it is old data
+5 ; Leave it NULL here because this is not an edit funtion
+6 SET CCIEN=$$GET1^DIQ(2,DFN_",","COUNTRY","I")
+7 ;I CCIEN="" S CCIEN=$O(^HL(779.004,"D","UNITED STATES",""))
+8 SET CFORGN=$$FORIEN^DGADDUTL(CCIEN)
+9 ;get current address fields and xlate to ^DIQ format
+10 SET CFSTR=$$INPT1(DFN,CFORGN)
SET CFSTR=$TRANSLATE(CFSTR,",",";")
+11 ; Domestic data needs some extra fields
+12 IF 'CFORGN
SET CFSTR=CFSTR_";.114;.115;.117"
+13 DO GETS^DIQ(2,DFN_",",CFSTR,"EI","DGCURR")
+14 FOR L=1:1:$LENGTH(CFSTR,";")
SET T=$PIECE(CFSTR,";",L)
SET DGCMP("OLD",T)=$GET(DGCURR(2,DFN_",",T,"E"))
+15 SET COUNTRY=$$CNTRYI^DGADDUTL(CCIEN)
IF COUNTRY=-1
SET COUNTRY="UNKNOWN COUNTRY"
+16 SET DGCMP("OLD",.1173)=COUNTRY_"^"_CCIEN
+17 IF 'CFORGN
Begin DoDot:1
+18 SET DGCIEN=$GET(DGCURR(2,DFN_",",.117,"I"))
+19 SET DGST=$GET(DGCURR(2,DFN_",",.115,"I"))
+20 SET DGCNTY=$$CNTY^DGREGAZL(DGST,DGCIEN)
+21 IF DGCNTY=-1
SET DGCNTY=""
+22 SET DGCMP("OLD",.117)=$PIECE(DGCNTY,U)_" "_$PIECE(DGCNTY,U,3)
End DoDot:1
+23 QUIT
+24 ;
COMPARE(DGINPUT,DGCMP,FLG) ;Display before & after address fields.
+1 NEW DGM
+2 MERGE DGCMP("NEW")=DGINPUT
+3 FOR DGM="OLD","NEW"
Begin DoDot:1
+4 IF DGCMP(DGM,.1173)]""
IF $$FORIEN^DGADDUTL($PIECE(DGCMP(DGM,.1173),U,2))
DO DISPFGN(.DGCMP,DGM,.FLG)
QUIT
+5 IF DGM="NEW"
Begin DoDot:2
+6 SET DGCNTY=$PIECE($GET(DGCMP("NEW",.117)),U)_" "_$PIECE($GET(DGCMP("NEW",.117)),U,3)
+7 SET DGCMP("NEW",.117)=DGCNTY
+8 IF ($LENGTH(DGCMP("NEW",.1112))>5)&($PIECE(DGCMP("NEW",.1112),"-",2)="")
SET DGCMP("NEW",.1112)=$EXTRACT(DGCMP("NEW",.1112),1,5)_"-"_$EXTRACT(DGCMP("NEW",.1112),6,9)
End DoDot:2
+9 DO DISPUS(.DGCMP,DGM,.FLG)
End DoDot:1
+10 QUIT
+11 ;
DISPUS(DGCMP,DGM,FLG) ;tag to display US data
+1 NEW DGCNTRY
+2 WRITE !,?2,"[",DGM," ADDRESS]"
+3 WRITE ?16,$PIECE($GET(DGCMP(DGM,.111)),U)
+4 IF $PIECE($GET(DGCMP(DGM,.112)),U)'=""
WRITE !,?16,$PIECE($GET(DGCMP(DGM,.112)),U)
+5 IF $PIECE($GET(DGCMP(DGM,.113)),U)'=""
WRITE !,?16,$PIECE($GET(DGCMP(DGM,.113)),U)
+6 WRITE !,?16,$PIECE($GET(DGCMP(DGM,.114)),U)
+7 IF ($PIECE($GET(DGCMP(DGM,.114)),U)'="")!($PIECE($GET(DGCMP(DGM,.115)),U)'="")
WRITE ","
+8 WRITE $PIECE($GET(DGCMP(DGM,.115)),U)
+9 WRITE " ",$GET(DGCMP(DGM,.1112))
+10 SET DGCNTRY=$$CNTRYI^DGADDUTL($PIECE($GET(DGCMP(DGM,.1173)),U,2))
+11 IF DGCNTRY]""
IF (DGCNTRY'=-1)
WRITE !?16,DGCNTRY
+12 IF $PIECE($GET(DGCMP(DGM,.117)),U)'=""
WRITE !,?6," County: ",$PIECE($GET(DGCMP(DGM,.117)),U)
+13 IF $GET(FLG(1))=1
Begin DoDot:1
+14 WRITE !,?6," Phone: ",?16,$PIECE($GET(DGCMP(DGM,.131)),U)
+15 WRITE !,?6," Office: ",?16,$PIECE($GET(DGCMP(DGM,.132)),U)
End DoDot:1
+16 WRITE !,?6,"Bad Addr: ",?16,$PIECE($GET(DGCMP(DGM,.121)),U)
+17 WRITE !
+18 QUIT
+19 ;
DISPFGN(DGCMP,DGM,FLG) ;tag to display Foreign data
+1 NEW DGCNTRY
+2 WRITE !,?2,"[",DGM," ADDRESS]"
+3 WRITE ?16,$PIECE($GET(DGCMP(DGM,.111)),U)
+4 IF $PIECE($GET(DGCMP(DGM,.112)),U)'=""
WRITE !,?16,$PIECE($GET(DGCMP(DGM,.112)),U)
+5 IF $PIECE($GET(DGCMP(DGM,.113)),U)'=""
WRITE !,?16,$PIECE($GET(DGCMP(DGM,.113)),U)
+6 WRITE !,?16,$PIECE($GET(DGCMP(DGM,.1172)),U)_" "_$PIECE($GET(DGCMP(DGM,.114)),U)_" "_$PIECE($GET(DGCMP(DGM,.1171)),U)
+7 SET DGCNTRY=$$CNTRYI^DGADDUTL($PIECE($GET(DGCMP(DGM,.1173)),U,2))
+8 SET DGCNTRY=$SELECT(DGCNTRY="":"UNSPECIFIED COUNTRY",DGCNTRY=-1:"UNKNOWN COUNTRY",1:DGCNTRY)
+9 IF DGCNTRY]""
WRITE !?16,DGCNTRY
+10 IF $GET(FLG(1))=1
Begin DoDot:1
+11 WRITE !,?6," Phone: ",?16,$PIECE($GET(DGCMP(DGM,.131)),U)
+12 WRITE !,?6," Office: ",?16,$PIECE($GET(DGCMP(DGM,.132)),U)
End DoDot:1
+13 WRITE !,?6,"Bad Addr: ",?16,$PIECE($GET(DGCMP(DGM,.121)),U)
+14 WRITE !
+15 QUIT
+16 ;
CONFIRM() ;Confirm if user wants to save the change
+1 NEW DIR,X,Y,DTOUT,DUOUT,DIROUT
+2 SET DIR(0)="Y"
+3 SET DIR("A")="Are you sure that you want to save the above changes"
+4 SET DIR("?")="Please answer Y for YES or N for NO."
+5 DO ^DIR
+6 IF $DATA(DTOUT)!($GET(Y)=0)
QUIT 0
+7 IF $DATA(DUOUT)!$DATA(DIROUT)
QUIT 0
+8 QUIT 1
SAVE(DGINPUT,DFN,FSTR,FORGN) ;Save changes
+1 NEW DGN,DGER,DGM,L
+2 SET DGER=0
+3 ; need to get the country code into the DGINPUT array
+4 ; if it's a domestic address, we have to add in CITY,STATE & COUNTY
+5 SET FSTR=FSTR_$SELECT('FORGN:",.114,.115,.117,.1173",1:",.1173")
+6 FOR L=1:1:$LENGTH(FSTR,",")
SET DGN=$PIECE(FSTR,",",L)
Begin DoDot:1
+7 IF ($GET(FLG(1))'=1)&((DGN=.131)!(DGN=.132))
QUIT
+8 NEW DGCODE,DGNAME,FDA,MSG
+9 SET DGCODE=$PIECE($GET(DGINPUT(DGN)),U,2)
+10 SET DGNAME=$PIECE($GET(DGINPUT(DGN)),U)
+11 SET FDA(2,DFN_",",DGN)=$SELECT(DGCODE:DGCODE,1:DGNAME)
+12 DO FILE^DIE($SELECT(DGCODE:"",1:"E"),"FDA","MSG")
+13 IF $DATA(MSG)
Begin DoDot:2
+14 SET DGM=""
SET DGER=1
+15 WRITE !,"Please review the saved changes!!",!
+16 FOR
SET DGM=$ORDER(MSG("DIERR",1,"TEXT",DGM))
IF DGM=""
QUIT
Begin DoDot:3
+17 WRITE $GET(MSG("DIERR",1,"TEXT",DGM))
End DoDot:3
End DoDot:2
End DoDot:1
+18 IF $GET(DGER)=0
WRITE !,"Change saved."
+19 DO EOP
+20 QUIT
READ(DFN,DGN,Y) ;Read input, return success
+1 NEW SUCCESS,DIR,DA,DTOUT,DUOUT,DIROUT,L,POP
+2 SET SUCCESS=1
SET POP=0
+3 FOR L=0:0
Begin DoDot:1
+4 SET DIR(0)=2_","_DGN
+5 SET DA=DFN
+6 DO ^DIR
+7 IF $DATA(DTOUT)
SET POP=1
SET SUCCESS=0
QUIT
+8 IF $DATA(DUOUT)!$DATA(DIROUT)
DO UPCT
QUIT
+9 SET POP=1
End DoDot:1
IF POP
QUIT
+10 QUIT SUCCESS
INPT1(DFN,FORGN,PSTR) ; first address input prompts
+1 NEW FSTR
+2 ; PSTR is the full set of fields domestic & foreign combined
+3 ; FSTR is the set of fields depending on Country code
+4 SET PSTR=".111,.112,.113,.114,.115,.117,.1112,.1171,.1172,.1173,.131,.132,.121"
+5 SET FSTR=".111,.112,.113,.1112,.131,.132,.121"
+6 IF FORGN
SET FSTR=".111,.112,.113,.114,.1171,.1172,.131,.132,.121"
+7 QUIT FSTR
ZIPINP(DGINPUT,DFN) ; get ZIP+4 input
+1 NEW DGR
+2 DO EN^DGREGAZL(.DGR,DFN)
+3 IF $GET(DGR)=-1
QUIT
+4 MERGE DGINPUT=DGR
+5 QUIT
SKIP(DGN,DGINPUT,FLG) ; determine whether or not to skip this step
+1 NEW SKIP
+2 SET SKIP=0
+3 IF ($GET(DGINPUT(.111))="")&((DGN=.112)!(DGN=.113))
SET SKIP=1
+4 IF ($GET(DGINPUT(.112))="")&(DGN=.113)
SET SKIP=1
+5 IF ($GET(FLG(1))'=1)&((DGN=.131)!(DGN=.132))
SET SKIP=1
+6 QUIT SKIP
EOP ;End of page prompt
+1 NEW DIR,DTOUT,DUOUT,DIROUT,X,Y
+2 SET DIR(0)="E"
+3 SET DIR("A")="Press ENTER to continue"
+4 DO ^DIR
+5 QUIT
UPCT ;Indicate "^" or "^^" are unacceptable inputs.
+1 WRITE !,"EXIT NOT ALLOWED ??"
+2 QUIT
