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

DGADDUT2.m

Go to the documentation of this file.
  1. 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
  1. ;a continuation of utilities from DGADDUTL
  1. ;
  1. UPDDTTM(DFN,TYPE) ; Update the PATIENT file #2 with the current date and time
  1. ;
  1. N %H,%,X,%Y,%D,%M,%I,ADDDTTM,DIE,DA,DR
  1. D NOW^%DTC
  1. S ADDDTTM=%,DIE="^DPT(",DA=DFN
  1. ;
  1. ; If it's the Temporary Address, the field is .12113
  1. ; If not, it should be the Permanent Address and the default field is .118
  1. S DR=$S(TYPE="TEMP":".12113///^S X=ADDDTTM",1:".118///^S X=ADDDTTM")
  1. D ^DIE
  1. Q
  1. UPDADDLG(DFN,DGPRIOR,DGINPUT) ; Update the IVM ADDRESS CHANGE LOG file #301.7
  1. ;
  1. N DGDATA
  1. ; Zero node:
  1. S DGDATA(.01)=DGINPUT(.118)
  1. S DGDATA(1)=DFN
  1. S DGDATA(2)=DGINPUT(.122)
  1. S DGDATA(3)=DGINPUT(.119)
  1. S DGDATA(3.5)=DGINPUT(.12)
  1. ;
  1. ; One node:
  1. S DGDATA(4)=DGPRIOR(.118)
  1. S DGDATA(5)=DGPRIOR(.122)
  1. S DGDATA(6)=DGPRIOR(.12)
  1. S DGDATA(7)=DGPRIOR(.119)
  1. S DGDATA(8)=DGPRIOR(.131)
  1. S DGDATA(9)=DGPRIOR(.111)
  1. S DGDATA(10)=DGPRIOR(.112)
  1. S DGDATA(11)=DGPRIOR(.114)
  1. S DGDATA(12)=DGPRIOR(.117)
  1. S DGDATA(13)=DGPRIOR(.115)
  1. S DGDATA(14)=DGPRIOR(.1112)
  1. S DGDATA(15)=DGPRIOR(.1171)
  1. S DGDATA(16)=DGPRIOR(.1172)
  1. S DGDATA(17)=DGPRIOR(.1173)
  1. S DGDATA(18)=DGPRIOR(.121)
  1. S DGDATA(19)=DGPRIOR(.113)
  1. ;
  1. I $$ADD^DGENDBS(301.7,,.DGDATA) ;
  1. Q
  1. CNTRY(DGARR) ;
  1. ;where DGARR is an array of values which includes a node for "CNTRY"
  1. ;DGARR("CNTRY") is returned in upper case display mode
  1. ;called from DGREGARP
  1. N DGC
  1. S DGC=$G(DGARR("CNTRY"))
  1. I '$D(^HL(779.004,"B",DGC)) Q ""
  1. S DGC=$$COUNTRY^DGADDUTL(DGC)
  1. S DGARR("CNTRY")=DGC
  1. Q
  1. ;
  1. DISPADD(DFN) ;Display Mailing Address (DG*5.3*851)
  1. Q:'$G(DFN)
  1. N DGRP,DGA1,DGA2,DGA,DGAD,DGI,DGCC,DGUN
  1. ;Get current address
  1. ;JAM Patch DG*5.3*941 Home and office phone now associated with Residential Address - remove retrieval of those fields
  1. S DGRP(.11)=$G(^DPT(DFN,.11))
  1. S DGUN="UNANSWERED"
  1. ;Format address data
  1. S DGAD=.11,(DGA1,DGA2)=1 D AL^DGRPU(35)
  1. ;DG*5.3*1056 remove "Permanent" from the following label:
  1. W !!," Mailing Address: "
  1. W !,?11,$S($D(DGA(1)):DGA(1),1:"NONE ON FILE")
  1. S DGI=1 F S DGI=$O(DGA(DGI)) Q:'DGI W !,?11,DGA(DGI)
  1. ; only print county info if it's a US address
  1. I '$$FORIEN^DGADDUTL($P(DGRP(.11),U,10)) D
  1. . 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)
  1. S DGCC=$S($G(DGCC)]"":"County: "_DGCC,1:"")
  1. W !?3,DGCC
  1. ;Display phone numbers
  1. ;JAM Patch DG*5.3*941 Home and office phone now associated with Residential Address - not shown with Permanent.
  1. ; - remove from being displayed here
  1. ;W !?4,"Phone: ",$S($P(DGRP(.13),U,1)]"":$P(DGRP(.13),U,1),1:DGUN)
  1. ;W !?3,"Office: ",$S($P(DGRP(.13),U,2)]"":$P(DGRP(.13),U,2),1:DGUN)
  1. ;Display Bad Address Indicator
  1. W !?1,"Bad Addr: ",$$EXTERNAL^DILFD(2,.121,"",$P(DGRP(.11),U,16))
  1. Q