Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGADDUTL

DGADDUTL.m

Go to the documentation of this file. 
  1. DGADDUTL ;ALB/PHH,EG,BAJ,ERC,CKN,TDM-PATIENT ADDRESS ; 4/2/09 2:29pm
  1.  ;;5.3;PIMS;**1016**;JUN 30, 2012;Build 20
  1.  Q
  1. ADDR ; validate/edit Patient address (entry for DG ADDRESS UPDATE option)
  1.  N %,QUIT,DIC,Y,DFN,USERSEL
  1. ADDRLOOP ;
  1.  W !!
  1.  K DIC,Y,DFN,USERSEL
  1.  S DIC="^DPT(",DIC(0)="AEMZQ",DIC("A")="Veteran Name/SSN: " D ^DIC
  1.  I $D(DTOUT)!($D(DUOUT)) Q
  1.  Q:Y'>0
  1.  ;
  1.  S DFN=+Y,QUIT=0
  1.  L +^DPT(DFN):3 E  W !!,"Patient is being edited. Try again later."  G ADDR
  1.  F  D  Q:QUIT
  1.  .W !!,"Do you want to update the (P)ermanent Address, (T)emporary Address, or (B)oth? "
  1.  .R USERSEL:300
  1.  .I '$T S USERSEL="^"
  1.  .I USERSEL["^"!(USERSEL="") S QUIT=1 Q
  1.  .S USERSEL=$TR(USERSEL,"ptb","PTB")
  1.  .I USERSEL'="P",USERSEL'="T",USERSEL'="B" D  Q
  1.  ..W !,"Invalid selection!"
  1.  .I USERSEL="P"!(USERSEL="B") W ! D UPDATE(DFN,"PERM")
  1.  .I USERSEL="T"!(USERSEL="B") D UPDATE(DFN,"TEMP")
  1.  .S QUIT=1
  1.  L -^DPT(DFN)
  1.  G ADDRLOOP
  1. ADD(DFN) ; validate/edit Patient address (entry point for routine DGREG)
  1.  ;         Input  -- DFN
  1.  ;
  1.  N RETVAL,ADDYN
  1.  S (RETVAL,ADDYN)=0
  1.  F  D  Q:ADDYN
  1.  .S ADDYN=$$ADDYN("Do you want to validate/edit the Patient's Address")
  1.  .S RETVAL=ADDYN
  1.  .I ADDYN'=1,ADDYN'=2 S (ADDYN,RETVAL)=0
  1.  .I 'ADDYN W !?5,"Enter 'YES' to validate/edit Patient's Address or 'NO' to continue."
  1.  I ADDYN=1,$G(DFN)'="",$D(^DPT(DFN,0)) D
  1.  .D UPDATE(DFN,"PERM")
  1.  .S RETVAL=1
  1.  Q RETVAL
  1. ADDYN(PROMPT) ; Yes/No Prompt to Edit/Validate Address
  1.  ;         Input  -- None
  1.  ;         Output --  1 = YES
  1.  ;                    2 = NO
  1.  ;                   -1 = Aborted
  1.  ;
  1.  N %
  1.  W !,PROMPT
  1.  D YN^DICN
  1.  Q %
  1. UPDATE(DFN,TYPE) ; Update the Address
  1.  ;         Input  -- TYPE = "PERM" for Permanent Address
  1.  ;                        = "TEMP" for Temporary Address
  1.  ;         Output -- None
  1.  ;         
  1.  I TYPE'="PERM",TYPE'="TEMP" Q
  1.  I TYPE="PERM" D
  1.  .W !
  1.  .N FLG S (FLG(1),FLG(2))=1
  1.  .D ADDRED(DFN,.FLG)
  1.  ;
  1.  I TYPE="TEMP" D
  1.  .D EDITTADR(DFN)
  1.  Q
  1. UPDDTTM(DFN,TYPE) ; Update the PATIENT file #2 with the current date and time
  1.  ;
  1.  D UPDDTTM^DGADDUT2(DFN,TYPE)
  1.  Q
  1. ADDRED(DFN,FLG) ; Address Edit (Code copied from DGREGAED and modified)
  1.  ;Input:
  1.  ;  DFN (required) - Internal Entry # of Patient File (#2)
  1.  ;  FLG (optional) - Flags of 1 or 0; if null, 0 is assumed. Details:
  1.  ;    FLG(1) - if 1, let user edit phone numbers (field #.131 and #.132)
  1.  ;    FLG(2) - if 1, display before & after address for user confirmation
  1.  N SRC,%,DGINPUT,I,X,Y
  1.  S SRC="ADDUTL"
  1.  D EN^DGREGAED(DFN,.FLG,SRC)
  1.  ;
  1.  ; Update the Date/Time Stamp
  1.  D UPDDTTM(DFN,TYPE)
  1.  Q
  1. GETPRIOR(DFN,DGPRIOR) ; Get prior address fields.
  1.  N DGCURR,DGN,DGARRY,DGCIEN,DGST,DGCNTY
  1.  D GETS^DIQ(2,DFN_",",".111;.112;.113;.114;.115;.117;.1112;.131;.132;.121;.118;.119;.12;.122;.1171:.1173","I","DGCURR")
  1.  F DGN=.111,.112,.113,.114,.115,.117,.1112,.131,.132,.121,.118,.119,.12,.122,.1171,.1172,.1173 D
  1.  . S DGARRY("OLD",DGN)=$G(DGCURR(2,DFN_",",DGN,"I"))
  1.  M DGPRIOR=DGARRY("OLD")
  1.  Q
  1. GETUPDTS(DFN,DGINPUT) ; Get current address fields.
  1.  N DGCURR,DGN,DGARRY
  1.  D GETS^DIQ(2,DFN_",",".118;.119;.12;.122","I","DGCURR")
  1.  F DGN=.118,.119,.12,.122 D
  1.  . S DGARRY("NEW",DGN)=$G(DGCURR(2,DFN_",",DGN,"I"))
  1.  M DGINPUT=DGARRY("NEW")
  1.  Q
  1. FILEYN(DGOLD,DGNEW) ; Determine whether or not to file to #301.7
  1.  N RETVAL
  1.  S RETVAL=0
  1.  D
  1.  .I DGOLD(.111)'=$G(DGNEW(.111)) S RETVAL=1 Q
  1.  .I DGOLD(.112)'=$G(DGNEW(.112)) S RETVAL=1 Q
  1.  .I DGOLD(.113)'=$G(DGNEW(.113)) S RETVAL=1 Q
  1.  .I DGOLD(.114)'=$G(DGNEW(.114)) S RETVAL=1 Q
  1.  .I DGOLD(.115)'=$P($G(DGNEW(.115)),"^",2) S RETVAL=1 Q
  1.  .I DGOLD(.1112)'=$G(DGNEW(.1112)) S RETVAL=1 Q
  1.  .I DGOLD(.117)'=$P($G(DGNEW(.117)),"^",2) S RETVAL=1 Q
  1.  .I DGOLD(.131)'=$G(DGNEW(.131)) S RETVAL=1 Q
  1.  .I DGOLD(.1171)'=$G(DGNEW(.1171)) S RETVAL=1 Q
  1.  .I DGOLD(.1172)'=$G(DGNEW(.1172)) S RETVAL=1 Q
  1.  .I DGOLD(.1173)'=$P($G(DGNEW(.1173)),"^",2) S RETVAL=1 Q
  1.  .I DGOLD(.121)'=$G(DGNEW(.121)) S RETVAL=1 Q
  1.  Q RETVAL
  1. FOREIGN(DFN,CIEN,FILE,FIELD,COUNTRY) ;
  1.  ; ** NOTE we have to default the value for "US" into the prompt if it is blank
  1.  N FORGN,DA,DIR,DTOUT,DUOUT,DIROUT,DONE,INDX
  1.  S:'$G(FILE) FILE=2  I '$G(FIELD) S FIELD=.1173
  1.  S DIR(0)=FILE_","_FIELD,DA=DFN,DONE=0
  1.  S DIR("B")=$E($$CNTRYI^DGADDUTL(CIEN),1,19) I DIR("B")=-1 S DIR("B")="UNKNOWN COUNTRY"
  1.  F  D  Q:DONE
  1.  . D ^DIR
  1.  . I $D(DTOUT) S DONE=1,FORGN=-1 Q
  1.  . I $D(DUOUT)!$D(DIROUT) W !,"EXIT NOT ALLOWED" Q
  1.  . I $D(DIRUT) W !,"This is a required response." Q
  1.  . S COUNTRY=$P($G(Y),"^",2),FORGN=$$FORIEN($P($G(Y),"^")),DONE=1
  1.  Q FORGN
  1. UPDADDLG(DFN,DGPRIOR,DGINPUT) ; Update the IVM ADDRESS CHANGE LOG file #301.7
  1.  ;
  1.  D UPDADDLG^DGADDUT2(DFN,.DGPRIOR,.DGINPUT)
  1.  Q
  1. EDITTADR(DFN) ; Edit Temporary Address
  1.  N DGPRIOR,DGCH,DGRPAN,DGDR,DGRPS
  1.  I $G(DFN)="" Q
  1.  ;I ($G(DFN)'?.N) Q
  1.  ;
  1.  ; Get the current Temporary Address and display it
  1.  D GETTADR(DFN,.DGPRIOR)
  1.  D DISPTADR(DFN,.DGPRIOR)
  1.  W !!
  1.  ;
  1.  S DGCH=5,DGRPAN="1,2,3,4,5,",DGDR="",DGRPS=1
  1.  D CHOICE^DGRPP
  1.  D ^DGRPE
  1.  ; Update the Date/Time Stamp
  1.  D UPDDTTM(DFN,TYPE)
  1.  Q
  1. GETTADR(DFN,DGPRIOR) ; Get prior temporary address fields.
  1.  N DGCURR,DGN,DGARRY,DGCIEN,DGST,DGCNTY
  1.  D GETS^DIQ(2,DFN_",",".1211;.1212;.1213;.1214;.1215;.1216;.1217;.1218;.12105;.1219;.12111;.12112;.12113;.12114;.1221:.1223","I","DGCURR")
  1.  F DGN=.1211,.1212,.1213,.1214,.1215,.1216,.1217,.1218,.12105,.1219,.12111,.12112,.12113,.12114,.1221,.1222,.1223 D
  1.  .S DGARRY("OLD",DGN)=$G(DGCURR(2,DFN_",",DGN,"I"))
  1.  M DGPRIOR=DGARRY("OLD")
  1.  Q
  1. DISPTADR(DFN,DGARRY) ; Display Temporary Address
  1.  N DGADRACT,DGADR1,DGADR2,DGADR3,DGCITY,DGSTATE,DGZIP
  1.  N DGCOUNTY,DGPHONE,DGFROMDT,DGTODT,DGPROV,DGPCODE,DGCNTRY,DGFORN
  1.  ;
  1.  S DGADRACT=$G(DGARRY(.12105))
  1.  S DGADR1=$G(DGARRY(.1211))
  1.  S DGADR2=$G(DGARRY(.1212))
  1.  S DGADR3=$G(DGARRY(.1213))
  1.  S DGCITY=$G(DGARRY(.1214))
  1.  S DGSTATE=$G(DGARRY(.1215))
  1.  S DGZIP=$G(DGARRY(.1216))
  1.  S DGCOUNTY=$G(DGARRY(.12111))
  1.  I DGCOUNTY'="",DGSTATE'="",$D(^DIC(5,DGSTATE,1,DGCOUNTY,0)) D
  1.  .S DGCOUNTY=$P(^DIC(5,DGSTATE,1,DGCOUNTY,0),"^")_" ("_$P(^DIC(5,DGSTATE,1,DGCOUNTY,0),"^",4)_")"
  1.  I DGADRACT'="Y" S DGCOUNTY="NOT APPLICABLE"
  1.  I DGSTATE'="",$D(^DIC(5,DGSTATE,0)) S DGSTATE=$P(^DIC(5,DGSTATE,0),"^",2)
  1.  S DGPROV=$G(DGARRY(.1221))
  1.  S DGPCODE=$G(DGARRY(.1222))
  1.  S DGCNTRY=$G(DGARRY(.1223))
  1.  S DGFORN=$$FORIEN(DGCNTRY)
  1.  I DGCNTRY]"" S DGCNTRY=$$CNTRYI(DGCNTRY)
  1.  S DGPHONE=$G(DGARRY(.1219))
  1.  S DGFROMDT=$$FMTE^XLFDT($G(DGARRY(.1217)))
  1.  S DGTODT=$$FMTE^XLFDT($G(DGARRY(.1218)))
  1.  ;
  1.  W !!,"Temporary Address: "
  1.  I DGADRACT="Y" D
  1.  .W:DGADR1'="" !?9,DGADR1
  1.  .W:DGADR2'="" !?9,DGADR2
  1.  .W:DGADR3'="" !?9,DGADR3
  1.  .I DGFORN=0 D
  1.  ..W !?9,$S(DGCITY'="":DGCITY,1:"")_$S(DGCITY'="":",",1:" ")_$S(DGSTATE'="":DGSTATE,1:"")_" "_$S(DGZIP'="":DGZIP,1:"")
  1.  .I DGFORN W !?9,$S(DGPCODE'="":DGPCODE,1:"")_" "_$S(DGCITY'="":DGCITY,1:"")_$S(DGCITY'="":",",1:" ")_$S(DGPROV'="":DGPROV,1:"")
  1.  .W !?9,$S(DGCITY'="":DGCITY,1:"")_","_$S(DGSTATE'="":DGSTATE,1:"")_" "_$S(DGZIP'="":DGZIP,1:"")
  1.  .W !," County: "_DGCOUNTY
  1.  .W !,"  Phone: "_DGPHONE
  1.  .W !,"From/To: "_$P(DGFROMDT,",")_","_$P(DGFROMDT,", ",2)_"-"_$P(DGTODT,",")_","_$P(DGTODT,", ",2)
  1.  ;
  1.  I $G(DGARRY(.12105))="N" D
  1.  .W:$G(DGARRY(.1211))="" !?9,"NO TEMPORARY ADDRESS"
  1.  .W:$G(DGARRY(.1212))="" !?9,""
  1.  .W !," County: NOT APPLICABLE"
  1.  .W !,"  Phone: NOT APPLICABLE"
  1.  .W !,"From/To: NOT APPLICABLE"
  1.  Q
  1. COUNTRY(DGC) ;
  1.  ;where DGC is the external value of the country
  1.  ;return value is in upper case display mode
  1.  ;if DGC is invalid, return -1
  1.  N DGCC,DGIEN
  1.  ; if input is NULL change to US
  1.  I $G(DGC)="" S DGC="USA"
  1.  ; Get IEN from B index, error if not found
  1.  S DGIEN=$O(^HL(779.004,"B",DGC,"")) Q:DGIEN']"" -1
  1.  ; xlate IEN to POSTAL NAME
  1.  S DGCC=$P(^HL(779.004,DGIEN,"SDS"),U,3)
  1.  ; if POSTAL NAME = "<NULL>" return DESCRIPTION
  1.  I DGCC="<NULL>" D
  1.  . S DGCC=$$UPPER^DGUTL($P(^HL(779.004,DGIEN,0),U,2))
  1.  Q DGCC
  1. FOR(DGC) ;returns a 1 if address is foreign, a 0 if domestic, -1 if DGC is not valid
  1.  ; DGC is the external value of the country (.01 field of file 779.004)
  1.  N DGFOR
  1.  S DGFOR=0
  1.  I $G(DGC)="" Q DGFOR
  1.  I '$D(^HL(779.004,"B",DGC)) Q -1
  1.  I DGC'="USA" S DGFOR=1
  1.  Q DGFOR
  1. CNTRYI(DGIEN) ;where DGC is the internal value of the country
  1.  ;return DGC as the display value for the country
  1.  ;if the input value is not a valid IEN, return -1
  1.  ;if the input value is null, return null
  1.  N DGCC
  1.  I $G(DGIEN)="" Q ""
  1.  I '$D(^HL(779.004,DGIEN,0)) Q -1
  1.  ; xlate IEN to POSTAL NAME
  1.  S DGCC=$P(^HL(779.004,DGIEN,"SDS"),U,3)
  1.  ; if POSTAL NAME = "<NULL>" return DESCRIPTION
  1.  I DGCC="<NULL>" D
  1.  . S DGCC=$$UPPER^DGUTL($P(^HL(779.004,DGIEN,0),U,2))
  1.  Q DGCC
  1. FORIEN(DGC) ;returns a 1 if address is foreign, a 0 if domestic, -1 if DGC is invalid
  1.  ;DGC is the IEN of the country file (#779.004)
  1.  N DGFOR
  1.  S DGFOR=0
  1.  I $G(DGC)="" Q DGFOR
  1.  I DGC'?1.3N Q -1
  1.  I '$D(^HL(779.004,DGC,0)) Q -1
  1.  I DGC]"",(DGC'=$O(^HL(779.004,"B","USA",""))) S DGFOR=1
  1.  Q DGFOR