- 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
