- 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 Jan 18, 2025@03:41:50 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