DGADDUT2 ;ALB/ERC,CKN,LBD,JAM,ARF - CONTINUATION OF ADDRESS UTILITIES ;May 24, 2021@14:47:36
;;5.3;Registration;**688,851,925,941,1056**;AUG 13, 1993;Build 18
;a continuation of utilities from DGADDUTL
;
UPDDTTM(DFN,TYPE) ; Update the PATIENT file #2 with the current date and time
;
N %H,%,X,%Y,%D,%M,%I,ADDDTTM,DIE,DA,DR
D NOW^%DTC
S ADDDTTM=%,DIE="^DPT(",DA=DFN
;
; If it's the Temporary Address, the field is .12113
; If not, it should be the Permanent Address and the default field is .118
S DR=$S(TYPE="TEMP":".12113///^S X=ADDDTTM",1:".118///^S X=ADDDTTM")
D ^DIE
Q
UPDADDLG(DFN,DGPRIOR,DGINPUT) ; Update the IVM ADDRESS CHANGE LOG file #301.7
;
N DGDATA
; Zero node:
S DGDATA(.01)=DGINPUT(.118)
S DGDATA(1)=DFN
S DGDATA(2)=DGINPUT(.122)
S DGDATA(3)=DGINPUT(.119)
S DGDATA(3.5)=DGINPUT(.12)
;
; One node:
S DGDATA(4)=DGPRIOR(.118)
S DGDATA(5)=DGPRIOR(.122)
S DGDATA(6)=DGPRIOR(.12)
S DGDATA(7)=DGPRIOR(.119)
S DGDATA(8)=DGPRIOR(.131)
S DGDATA(9)=DGPRIOR(.111)
S DGDATA(10)=DGPRIOR(.112)
S DGDATA(11)=DGPRIOR(.114)
S DGDATA(12)=DGPRIOR(.117)
S DGDATA(13)=DGPRIOR(.115)
S DGDATA(14)=DGPRIOR(.1112)
S DGDATA(15)=DGPRIOR(.1171)
S DGDATA(16)=DGPRIOR(.1172)
S DGDATA(17)=DGPRIOR(.1173)
S DGDATA(18)=DGPRIOR(.121)
S DGDATA(19)=DGPRIOR(.113)
;
I $$ADD^DGENDBS(301.7,,.DGDATA) ;
Q
CNTRY(DGARR) ;
;where DGARR is an array of values which includes a node for "CNTRY"
;DGARR("CNTRY") is returned in upper case display mode
;called from DGREGARP
N DGC
S DGC=$G(DGARR("CNTRY"))
I '$D(^HL(779.004,"B",DGC)) Q ""
S DGC=$$COUNTRY^DGADDUTL(DGC)
S DGARR("CNTRY")=DGC
Q
;
DISPADD(DFN) ;Display Mailing Address (DG*5.3*851)
Q:'$G(DFN)
N DGRP,DGA1,DGA2,DGA,DGAD,DGI,DGCC,DGUN
;Get current address
;JAM Patch DG*5.3*941 Home and office phone now associated with Residential Address - remove retrieval of those fields
S DGRP(.11)=$G(^DPT(DFN,.11))
S DGUN="UNANSWERED"
;Format address data
S DGAD=.11,(DGA1,DGA2)=1 D AL^DGRPU(35)
;DG*5.3*1056 remove "Permanent" from the following label:
W !!," Mailing Address: "
W !,?11,$S($D(DGA(1)):DGA(1),1:"NONE ON FILE")
S DGI=1 F S DGI=$O(DGA(DGI)) Q:'DGI W !,?11,DGA(DGI)
; only print county info if it's a US address
I '$$FORIEN^DGADDUTL($P(DGRP(.11),U,10)) D
. S DGCC=$S($D(^DIC(5,+$P(DGRP(.11),U,5),1,+$P(DGRP(.11),U,7),0)):$E($P(^(0),U,1),1,20)_$S($P(^(0),U,3)]"":" ("_$P(^(0),U,3)_")",1:""),1:DGUN)
S DGCC=$S($G(DGCC)]"":"County: "_DGCC,1:"")
W !?3,DGCC
;Display phone numbers
;JAM Patch DG*5.3*941 Home and office phone now associated with Residential Address - not shown with Permanent.
; - remove from being displayed here
;W !?4,"Phone: ",$S($P(DGRP(.13),U,1)]"":$P(DGRP(.13),U,1),1:DGUN)
;W !?3,"Office: ",$S($P(DGRP(.13),U,2)]"":$P(DGRP(.13),U,2),1:DGUN)
;Display Bad Address Indicator
W !?1,"Bad Addr: ",$$EXTERNAL^DILFD(2,.121,"",$P(DGRP(.11),U,16))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGADDUT2 2950 printed Sep 23, 2025@20:17 Page 2
DGADDUT2 ;ALB/ERC,CKN,LBD,JAM,ARF - CONTINUATION OF ADDRESS UTILITIES ;May 24, 2021@14:47:36
+1 ;;5.3;Registration;**688,851,925,941,1056**;AUG 13, 1993;Build 18
+2 ;a continuation of utilities from DGADDUTL
+3 ;
UPDDTTM(DFN,TYPE) ; Update the PATIENT file #2 with the current date and time
+1 ;
+2 NEW %H,%,X,%Y,%D,%M,%I,ADDDTTM,DIE,DA,DR
+3 DO NOW^%DTC
+4 SET ADDDTTM=%
SET DIE="^DPT("
SET DA=DFN
+5 ;
+6 ; If it's the Temporary Address, the field is .12113
+7 ; If not, it should be the Permanent Address and the default field is .118
+8 SET DR=$SELECT(TYPE="TEMP":".12113///^S X=ADDDTTM",1:".118///^S X=ADDDTTM")
+9 DO ^DIE
+10 QUIT
UPDADDLG(DFN,DGPRIOR,DGINPUT) ; Update the IVM ADDRESS CHANGE LOG file #301.7
+1 ;
+2 NEW DGDATA
+3 ; Zero node:
+4 SET DGDATA(.01)=DGINPUT(.118)
+5 SET DGDATA(1)=DFN
+6 SET DGDATA(2)=DGINPUT(.122)
+7 SET DGDATA(3)=DGINPUT(.119)
+8 SET DGDATA(3.5)=DGINPUT(.12)
+9 ;
+10 ; One node:
+11 SET DGDATA(4)=DGPRIOR(.118)
+12 SET DGDATA(5)=DGPRIOR(.122)
+13 SET DGDATA(6)=DGPRIOR(.12)
+14 SET DGDATA(7)=DGPRIOR(.119)
+15 SET DGDATA(8)=DGPRIOR(.131)
+16 SET DGDATA(9)=DGPRIOR(.111)
+17 SET DGDATA(10)=DGPRIOR(.112)
+18 SET DGDATA(11)=DGPRIOR(.114)
+19 SET DGDATA(12)=DGPRIOR(.117)
+20 SET DGDATA(13)=DGPRIOR(.115)
+21 SET DGDATA(14)=DGPRIOR(.1112)
+22 SET DGDATA(15)=DGPRIOR(.1171)
+23 SET DGDATA(16)=DGPRIOR(.1172)
+24 SET DGDATA(17)=DGPRIOR(.1173)
+25 SET DGDATA(18)=DGPRIOR(.121)
+26 SET DGDATA(19)=DGPRIOR(.113)
+27 ;
+28 ;
IF $$ADD^DGENDBS(301.7,,.DGDATA)
+29 QUIT
CNTRY(DGARR) ;
+1 ;where DGARR is an array of values which includes a node for "CNTRY"
+2 ;DGARR("CNTRY") is returned in upper case display mode
+3 ;called from DGREGARP
+4 NEW DGC
+5 SET DGC=$GET(DGARR("CNTRY"))
+6 IF '$DATA(^HL(779.004,"B",DGC))
QUIT ""
+7 SET DGC=$$COUNTRY^DGADDUTL(DGC)
+8 SET DGARR("CNTRY")=DGC
+9 QUIT
+10 ;
DISPADD(DFN) ;Display Mailing Address (DG*5.3*851)
+1 if '$GET(DFN)
QUIT
+2 NEW DGRP,DGA1,DGA2,DGA,DGAD,DGI,DGCC,DGUN
+3 ;Get current address
+4 ;JAM Patch DG*5.3*941 Home and office phone now associated with Residential Address - remove retrieval of those fields
+5 SET DGRP(.11)=$GET(^DPT(DFN,.11))
+6 SET DGUN="UNANSWERED"
+7 ;Format address data
+8 SET DGAD=.11
SET (DGA1,DGA2)=1
DO AL^DGRPU(35)
+9 ;DG*5.3*1056 remove "Permanent" from the following label:
+10 WRITE !!," Mailing Address: "
+11 WRITE !,?11,$SELECT($DATA(DGA(1)):DGA(1),1:"NONE ON FILE")
+12 SET DGI=1
FOR
SET DGI=$ORDER(DGA(DGI))
if 'DGI
QUIT
WRITE !,?11,DGA(DGI)
+13 ; only print county info if it's a US address
+14 IF '$$FORIEN^DGADDUTL($PIECE(DGRP(.11),U,10))
Begin DoDot:1
+15 SET DGCC=$SELECT($DATA(^DIC(5,+$PIECE(DGRP(.11),U,5),1,+$PIECE(DGRP(.11),U,7),0)):$EXTRACT($PIECE(^(0),U,1),1,20)_$SELECT($PIECE(^(0),U,3)]"":" ("_$PIECE(^(0),U,3)_")",1:""),1:DGUN)
End DoDot:1
+16 SET DGCC=$SELECT($GET(DGCC)]"":"County: "_DGCC,1:"")
+17 WRITE !?3,DGCC
+18 ;Display phone numbers
+19 ;JAM Patch DG*5.3*941 Home and office phone now associated with Residential Address - not shown with Permanent.
+20 ; - remove from being displayed here
+21 ;W !?4,"Phone: ",$S($P(DGRP(.13),U,1)]"":$P(DGRP(.13),U,1),1:DGUN)
+22 ;W !?3,"Office: ",$S($P(DGRP(.13),U,2)]"":$P(DGRP(.13),U,2),1:DGUN)
+23 ;Display Bad Address Indicator
+24 WRITE !?1,"Bad Addr: ",$$EXTERNAL^DILFD(2,.121,"",$PIECE(DGRP(.11),U,16))
+25 QUIT
