DGREGCOP ;ALB/CLT,JAM - COPY RESIDENTIAL TO PERM AND PERM TO RESIDENTIAL ADDRESS ;23 May 2017 1:38 PM
;;5.3;Registration;**941,1127**;Aug 13, 1993;Build 11
;
EN(DFN) ;PRIMARY ENTRY POINT
R2P(DFN) ;RESIDENTIAL TO PERMANENT ADDRESS COPY
N DGAR,I,DGZIP,IENS,FDA
S DGAR=^DPT(DFN,.115)
; DG*5.3*1127 - Add RESIDENTIAL ADDR OVERRIDE IND field .11591 (piece 20) to the copy
F I=1:1:10,19,20 S DGAR(I)=$P(DGAR,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)
; DG*5.3*1127 - Copy RESIDENTIAL ADDR OVERRIDE IND field to MAILING ADDR OVERRIDE IND field .1119
S FDA(2,IENS,.1119)=DGAR(20)
D FILE^DIE("","FDA")
Q
P2R(DFN) ;PERMANENT TO RESIDENTIAL ADDRESS COPY
N DGAR,I,IENS,FDA
S DGAR=^DPT(DFN,.11)
; DG*5.3*1127 - Add MAILING ADDR OVERRIDE IND field .1119 (piece 19) to the copy
F I=1:1:12,18,19 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)
; DG*5.3*1127 - Copy MAILING ADDR OVERRIDE IND field to RESIDENTIAL ADDR OVERRIDE IND field .11591
S FDA(2,IENS,.11591)=DGAR(19)
D FILE^DIE("","FDA")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGREGCOP 1744 printed Sep 23, 2025@20:30:47 Page 2
DGREGCOP ;ALB/CLT,JAM - COPY RESIDENTIAL TO PERM AND PERM TO RESIDENTIAL ADDRESS ;23 May 2017 1:38 PM
+1 ;;5.3;Registration;**941,1127**;Aug 13, 1993;Build 11
+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 ; DG*5.3*1127 - Add RESIDENTIAL ADDR OVERRIDE IND field .11591 (piece 20) to the copy
+4 FOR I=1:1:10,19,20
SET DGAR(I)=$PIECE(DGAR,U,I)
+5 KILL ^DPT(DFN,.11)
+6 SET DGZIP=$EXTRACT(DGAR(6),1,5)
+7 SET IENS=DFN_","
+8 SET FDA(2,IENS,.111)=DGAR(1)
+9 SET FDA(2,IENS,.112)=DGAR(2)
+10 SET FDA(2,IENS,.113)=DGAR(3)
+11 SET FDA(2,IENS,.114)=DGAR(4)
+12 SET FDA(2,IENS,.115)=DGAR(5)
+13 SET FDA(2,IENS,.116)=DGZIP
+14 SET FDA(2,IENS,.1112)=DGAR(6)
+15 SET FDA(2,IENS,.117)=DGAR(7)
+16 SET FDA(2,IENS,.1171)=DGAR(8)
+17 SET FDA(2,IENS,.1172)=DGAR(9)
+18 SET FDA(2,IENS,.1173)=DGAR(10)
+19 SET FDA(2,IENS,.1118)=DGAR(19)
+20 ; DG*5.3*1127 - Copy RESIDENTIAL ADDR OVERRIDE IND field to MAILING ADDR OVERRIDE IND field .1119
+21 SET FDA(2,IENS,.1119)=DGAR(20)
+22 DO FILE^DIE("","FDA")
+23 QUIT
P2R(DFN) ;PERMANENT TO RESIDENTIAL ADDRESS COPY
+1 NEW DGAR,I,IENS,FDA
+2 SET DGAR=^DPT(DFN,.11)
+3 ; DG*5.3*1127 - Add MAILING ADDR OVERRIDE IND field .1119 (piece 19) to the copy
+4 FOR I=1:1:12,18,19
SET DGAR(I)=$PIECE(DGAR,U,I)
+5 KILL ^DPT(DFN,.115)
+6 SET IENS=DFN_","
+7 SET FDA(2,IENS,.1151)=DGAR(1)
+8 SET FDA(2,IENS,.1152)=DGAR(2)
+9 SET FDA(2,IENS,.1153)=DGAR(3)
+10 SET FDA(2,IENS,.1154)=DGAR(4)
+11 SET FDA(2,IENS,.1155)=DGAR(5)
+12 SET FDA(2,IENS,.1156)=DGAR(12)
+13 SET FDA(2,IENS,.1157)=DGAR(7)
+14 SET FDA(2,IENS,.11571)=DGAR(8)
+15 SET FDA(2,IENS,.11572)=DGAR(9)
+16 SET FDA(2,IENS,.11573)=DGAR(10)
+17 SET FDA(2,IENS,.1159)=DGAR(18)
+18 ; DG*5.3*1127 - Copy MAILING ADDR OVERRIDE IND field to RESIDENTIAL ADDR OVERRIDE IND field .11591
+19 SET FDA(2,IENS,.11591)=DGAR(19)
+20 DO FILE^DIE("","FDA")
+21 QUIT
