DGREGCOP ;ALB/CLT - COPY RESIDENTIAL TO PERM AND PERM TO RESIDENTIAL ADDRESS ;23 May 2017 1:38 PM
;;5.3;Registration;**941**;Aug 13, 1993;Build 73
;
EN(DFN) ;PRIMARY ENTRY POINT
R2P(DFN) ;RESIDENTIAL TO PERMANENT ADDRESS COPY
N DGAR,I,DGZIP,IENS,FDA
S DGAR=^DPT(DFN,.115)
F I=1:1:10,19 S DGAR(I)=$P(^DPT(DFN,.115),U,I)
K ^DPT(DFN,.11)
S DGZIP=$E(DGAR(6),1,5)
S IENS=DFN_","
S FDA(2,IENS,.111)=DGAR(1)
S FDA(2,IENS,.112)=DGAR(2)
S FDA(2,IENS,.113)=DGAR(3)
S FDA(2,IENS,.114)=DGAR(4)
S FDA(2,IENS,.115)=DGAR(5)
S FDA(2,IENS,.116)=DGZIP
S FDA(2,IENS,.1112)=DGAR(6)
S FDA(2,IENS,.117)=DGAR(7)
S FDA(2,IENS,.1171)=DGAR(8)
S FDA(2,IENS,.1172)=DGAR(9)
S FDA(2,IENS,.1173)=DGAR(10)
S FDA(2,IENS,.1118)=DGAR(19)
D FILE^DIE("","FDA")
Q
P2R(DFN) ;PERMANENT TO RESIDENTIAL ADDRESS COPY
N DGAR,I,IENS,FDA
S DGAR=^DPT(DFN,.11)
F I=1:1:12,18 S DGAR(I)=$P(DGAR,U,I)
K ^DPT(DFN,.115)
S IENS=DFN_","
S FDA(2,IENS,.1151)=DGAR(1)
S FDA(2,IENS,.1152)=DGAR(2)
S FDA(2,IENS,.1153)=DGAR(3)
S FDA(2,IENS,.1154)=DGAR(4)
S FDA(2,IENS,.1155)=DGAR(5)
S FDA(2,IENS,.1156)=DGAR(12)
S FDA(2,IENS,.1157)=DGAR(7)
S FDA(2,IENS,.11571)=DGAR(8)
S FDA(2,IENS,.11572)=DGAR(9)
S FDA(2,IENS,.11573)=DGAR(10)
S FDA(2,IENS,.1159)=DGAR(18)
D FILE^DIE("","FDA")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGREGCOP 1304 printed Oct 16, 2024@18:55:28 Page 2
DGREGCOP ;ALB/CLT - COPY RESIDENTIAL TO PERM AND PERM TO RESIDENTIAL ADDRESS ;23 May 2017 1:38 PM
+1 ;;5.3;Registration;**941**;Aug 13, 1993;Build 73
+2 ;
EN(DFN) ;PRIMARY ENTRY POINT
R2P(DFN) ;RESIDENTIAL TO PERMANENT ADDRESS COPY
+1 NEW DGAR,I,DGZIP,IENS,FDA
+2 SET DGAR=^DPT(DFN,.115)
+3 FOR I=1:1:10,19
SET DGAR(I)=$PIECE(^DPT(DFN,.115),U,I)
+4 KILL ^DPT(DFN,.11)
+5 SET DGZIP=$EXTRACT(DGAR(6),1,5)
+6 SET IENS=DFN_","
+7 SET FDA(2,IENS,.111)=DGAR(1)
+8 SET FDA(2,IENS,.112)=DGAR(2)
+9 SET FDA(2,IENS,.113)=DGAR(3)
+10 SET FDA(2,IENS,.114)=DGAR(4)
+11 SET FDA(2,IENS,.115)=DGAR(5)
+12 SET FDA(2,IENS,.116)=DGZIP
+13 SET FDA(2,IENS,.1112)=DGAR(6)
+14 SET FDA(2,IENS,.117)=DGAR(7)
+15 SET FDA(2,IENS,.1171)=DGAR(8)
+16 SET FDA(2,IENS,.1172)=DGAR(9)
+17 SET FDA(2,IENS,.1173)=DGAR(10)
+18 SET FDA(2,IENS,.1118)=DGAR(19)
+19 DO FILE^DIE("","FDA")
+20 QUIT
P2R(DFN) ;PERMANENT TO RESIDENTIAL ADDRESS COPY
+1 NEW DGAR,I,IENS,FDA
+2 SET DGAR=^DPT(DFN,.11)
+3 FOR I=1:1:12,18
SET DGAR(I)=$PIECE(DGAR,U,I)
+4 KILL ^DPT(DFN,.115)
+5 SET IENS=DFN_","
+6 SET FDA(2,IENS,.1151)=DGAR(1)
+7 SET FDA(2,IENS,.1152)=DGAR(2)
+8 SET FDA(2,IENS,.1153)=DGAR(3)
+9 SET FDA(2,IENS,.1154)=DGAR(4)
+10 SET FDA(2,IENS,.1155)=DGAR(5)
+11 SET FDA(2,IENS,.1156)=DGAR(12)
+12 SET FDA(2,IENS,.1157)=DGAR(7)
+13 SET FDA(2,IENS,.11571)=DGAR(8)
+14 SET FDA(2,IENS,.11572)=DGAR(9)
+15 SET FDA(2,IENS,.11573)=DGAR(10)
+16 SET FDA(2,IENS,.1159)=DGAR(18)
+17 DO FILE^DIE("","FDA")
+18 QUIT
