DGREGCOP ;ALB/CLT,JAM - COPY RESIDENTIAL TO PERM AND PERM TO RESIDENTIAL ADDRESS ;23 May 2017 1:38 PM
;;5.3;Registration;**941,1127,1143**;Aug 13, 1993;Build 36
;
; TOTDO - REMOVE 1143 CODE FROM HERE
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
;
R2PLOCAL(DFN) ; DG*5.3*1143 - RESIDENTIAL TO PERMANENT ADDRESS COPY - with RTA active
; If the DGADDGRP1 local array for Residential Address exists, copy mailing address data from Group 1 array to Group 2
I $G(DGADDGRP1(.1151))'="" D
.; LINE 1
.S DGADDGRP2(.111)=$G(DGADDGRP1(.1151))
.; LINE 2
.S DGADDGRP2(.112)=$G(DGADDGRP1(.1152))
.; LINE 3
.S DGADDGRP2(.113)=$G(DGADDGRP1(.1153))
.; CITY
.S DGADDGRP2(.114)=$G(DGADDGRP1(.1154))
.; STATE
.S DGADDGRP2(.115)=$G(DGADDGRP1(.1155))
.; ZIP
.S DGADDGRP2(.116)=$E($G(DGADDGRP1(.1156)),1,5)
.; ZIP+4
.S DGADDGRP2(.1112)=$G(DGADDGRP1(.1156))
.; COUNTY
.S DGADDGRP2(.117)=$G(DGADDGRP1(.1157))
.; PROVINCE
.S DGADDGRP2(.1171)=$G(DGADDGRP1(.11571))
.; POSTAL CODE
.S DGADDGRP2(.1172)=$G(DGADDGRP1(.11572))
.; COUNTRY
.S DGADDGRP2(.1173)=$G(DGADDGRP1(.11573))
.; CASS INDICATOR
.S DGADDGRP2(.1118)=$G(DGADDGRP1(.1159))
.; OVERRIDE KEY
.S DGADDGRP2(.1119)=$G(DGADDGRP1(.11591))
E D
.; Else, DGADDGRP1 local array not defined, so copy Residential Address from the DB to the local array DGADDGRP2
.N DGAR,DGI,DGZIP
.S DGAR=^DPT(DFN,.115)
.F DGI=1:1:10,19,20 S DGAR(DGI)=$P(DGAR,U,DGI)
.S DGZIP=$E(DGAR(6),1,5)
.; LINE 1
.S DGADDGRP2(.111)=DGAR(1)
.; LINE 2
.S DGADDGRP2(.112)=DGAR(2)
.; LINE 3
.S DGADDGRP2(.113)=DGAR(3)
.; CITY
.S DGADDGRP2(.114)=DGAR(4)
.; STATE
.S DGADDGRP2(.115)=DGAR(5)
.; ZIP
.S DGADDGRP2(.116)=DGZIP
.; ZIP+4
.S DGADDGRP2(.1112)=DGAR(6)
.; COUNTY
.S DGADDGRP2(.117)=DGAR(7)
.; PROVINCE
.S DGADDGRP2(.1171)=DGAR(8)
.; POSTAL CODE
.S DGADDGRP2(.1172)=DGAR(9)
.; COUNTRY
.S DGADDGRP2(.1173)=DGAR(10)
.; CASS INDICATOR
.S DGADDGRP2(.1118)=DGAR(19)
.; OVDERRIDE KEY
.S DGADDGRP2(.1119)=DGAR(20)
;
; Clear out the Mailing address BAI field
S DGADDGRP2(.121)=""
; Set edit flag for group 2
S DGADDEDIT(2)=1
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
;
P2RLOCAL(DFN) ; DG*5.3*1143 - PERMANENT TO RESIDENTIAL ADDRESS COPY with RTA active
; If the local array DGADDGRP2 for Mailing Address exists, copy address data from Group 2 array to Group 1 array DGADDGRP1
I $G(DGADDGRP2(.111))'="" D
.; LINE 1
.S DGADDGRP1(.1151)=$G(DGADDGRP2(.111))
.; LINE 2
.S DGADDGRP1(.1152)=$G(DGADDGRP2(.112))
.; LINE 3
.S DGADDGRP1(.1153)=$G(DGADDGRP2(.113))
.; CITY
.S DGADDGRP1(.1154)=$G(DGADDGRP2(.114))
.; STATE
.S DGADDGRP1(.1155)=$G(DGADDGRP2(.115))
.; ZIP+4
.S DGADDGRP1(.1156)=$G(DGADDGRP2(.1112))
.; COUNTY
.S DGADDGRP1(.1157)=$G(DGADDGRP2(.117))
.; PROVINCE
.S DGADDGRP1(.11571)=$G(DGADDGRP2(.1171))
.; POSTAL CODE
.S DGADDGRP1(.11572)=$G(DGADDGRP2(.1172))
.; COUNTRY
.S DGADDGRP1(.11573)=$G(DGADDGRP2(.1173))
.; CASS INDICATOR
.S DGADDGRP1(.1159)=$G(DGADDGRP2(.1118))
.; OVERRIDE KEY
.S DGADDGRP1(.11591)=$G(DGADDGRP2(.1119))
E D
.; Local array not defined, so copy Mailing Address from the DB to the local array for Residential Address
.N DGAR,DGI
.S DGAR=^DPT(DFN,.11)
.F DGI=1:1:12,18,19 S DGAR(DGI)=$P(DGAR,U,DGI)
.; LINE 1
.S DGADDGRP1(.1151)=DGAR(1)
.; LINE 2
.S DGADDGRP1(.1152)=DGAR(2)
.; LINE 3
.S DGADDGRP1(.1153)=DGAR(3)
.; CITY
.S DGADDGRP1(.1154)=DGAR(4)
.; STATE
.S DGADDGRP1(.1155)=DGAR(5)
.; ZIP+4
.S DGADDGRP1(.1156)=DGAR(12)
.; COUNTY
.S DGADDGRP1(.1157)=DGAR(7)
.; PROVINCE
.S DGADDGRP1(.11571)=DGAR(8)
.; POSTAL CODE
.S DGADDGRP1(.11572)=DGAR(9)
.; COUNTRY
.S DGADDGRP1(.11573)=DGAR(10)
.; CASS INDICATOR
.S DGADDGRP1(.1159)=DGAR(18)
.; OVERRIDE KEY
.S DGADDGRP1(.11591)=DGAR(19)
;
; If no phone number fields currently defined in the group 1 array, load them from the database into the Group 1 local array so they are preserved
I '$D(DGADDGRP1(.131)) S DGADDGRP1(.131)=$P($G(^DPT(DFN,.13)),"^",1)
I '$D(DGADDGRP1(.132)) S DGADDGRP1(.132)=$P($G(^DPT(DFN,.13)),"^",2)
;
; Set edit flag for group 1
S DGADDEDIT(1)=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGREGCOP 5698 printed May 25, 2026@12:58:50 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,1143**;Aug 13, 1993;Build 36
+2 ;
+3 ; TOTDO - REMOVE 1143 CODE FROM HERE
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
+24 ;
R2PLOCAL(DFN) ; DG*5.3*1143 - RESIDENTIAL TO PERMANENT ADDRESS COPY - with RTA active
+1 ; If the DGADDGRP1 local array for Residential Address exists, copy mailing address data from Group 1 array to Group 2
+2 IF $GET(DGADDGRP1(.1151))'=""
Begin DoDot:1
+3 ; LINE 1
+4 SET DGADDGRP2(.111)=$GET(DGADDGRP1(.1151))
+5 ; LINE 2
+6 SET DGADDGRP2(.112)=$GET(DGADDGRP1(.1152))
+7 ; LINE 3
+8 SET DGADDGRP2(.113)=$GET(DGADDGRP1(.1153))
+9 ; CITY
+10 SET DGADDGRP2(.114)=$GET(DGADDGRP1(.1154))
+11 ; STATE
+12 SET DGADDGRP2(.115)=$GET(DGADDGRP1(.1155))
+13 ; ZIP
+14 SET DGADDGRP2(.116)=$EXTRACT($GET(DGADDGRP1(.1156)),1,5)
+15 ; ZIP+4
+16 SET DGADDGRP2(.1112)=$GET(DGADDGRP1(.1156))
+17 ; COUNTY
+18 SET DGADDGRP2(.117)=$GET(DGADDGRP1(.1157))
+19 ; PROVINCE
+20 SET DGADDGRP2(.1171)=$GET(DGADDGRP1(.11571))
+21 ; POSTAL CODE
+22 SET DGADDGRP2(.1172)=$GET(DGADDGRP1(.11572))
+23 ; COUNTRY
+24 SET DGADDGRP2(.1173)=$GET(DGADDGRP1(.11573))
+25 ; CASS INDICATOR
+26 SET DGADDGRP2(.1118)=$GET(DGADDGRP1(.1159))
+27 ; OVERRIDE KEY
+28 SET DGADDGRP2(.1119)=$GET(DGADDGRP1(.11591))
End DoDot:1
+29 IF '$TEST
Begin DoDot:1
+30 ; Else, DGADDGRP1 local array not defined, so copy Residential Address from the DB to the local array DGADDGRP2
+31 NEW DGAR,DGI,DGZIP
+32 SET DGAR=^DPT(DFN,.115)
+33 FOR DGI=1:1:10,19,20
SET DGAR(DGI)=$PIECE(DGAR,U,DGI)
+34 SET DGZIP=$EXTRACT(DGAR(6),1,5)
+35 ; LINE 1
+36 SET DGADDGRP2(.111)=DGAR(1)
+37 ; LINE 2
+38 SET DGADDGRP2(.112)=DGAR(2)
+39 ; LINE 3
+40 SET DGADDGRP2(.113)=DGAR(3)
+41 ; CITY
+42 SET DGADDGRP2(.114)=DGAR(4)
+43 ; STATE
+44 SET DGADDGRP2(.115)=DGAR(5)
+45 ; ZIP
+46 SET DGADDGRP2(.116)=DGZIP
+47 ; ZIP+4
+48 SET DGADDGRP2(.1112)=DGAR(6)
+49 ; COUNTY
+50 SET DGADDGRP2(.117)=DGAR(7)
+51 ; PROVINCE
+52 SET DGADDGRP2(.1171)=DGAR(8)
+53 ; POSTAL CODE
+54 SET DGADDGRP2(.1172)=DGAR(9)
+55 ; COUNTRY
+56 SET DGADDGRP2(.1173)=DGAR(10)
+57 ; CASS INDICATOR
+58 SET DGADDGRP2(.1118)=DGAR(19)
+59 ; OVDERRIDE KEY
+60 SET DGADDGRP2(.1119)=DGAR(20)
End DoDot:1
+61 ;
+62 ; Clear out the Mailing address BAI field
+63 SET DGADDGRP2(.121)=""
+64 ; Set edit flag for group 2
+65 SET DGADDEDIT(2)=1
+66 QUIT
+67 ;
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
+22 ;
P2RLOCAL(DFN) ; DG*5.3*1143 - PERMANENT TO RESIDENTIAL ADDRESS COPY with RTA active
+1 ; If the local array DGADDGRP2 for Mailing Address exists, copy address data from Group 2 array to Group 1 array DGADDGRP1
+2 IF $GET(DGADDGRP2(.111))'=""
Begin DoDot:1
+3 ; LINE 1
+4 SET DGADDGRP1(.1151)=$GET(DGADDGRP2(.111))
+5 ; LINE 2
+6 SET DGADDGRP1(.1152)=$GET(DGADDGRP2(.112))
+7 ; LINE 3
+8 SET DGADDGRP1(.1153)=$GET(DGADDGRP2(.113))
+9 ; CITY
+10 SET DGADDGRP1(.1154)=$GET(DGADDGRP2(.114))
+11 ; STATE
+12 SET DGADDGRP1(.1155)=$GET(DGADDGRP2(.115))
+13 ; ZIP+4
+14 SET DGADDGRP1(.1156)=$GET(DGADDGRP2(.1112))
+15 ; COUNTY
+16 SET DGADDGRP1(.1157)=$GET(DGADDGRP2(.117))
+17 ; PROVINCE
+18 SET DGADDGRP1(.11571)=$GET(DGADDGRP2(.1171))
+19 ; POSTAL CODE
+20 SET DGADDGRP1(.11572)=$GET(DGADDGRP2(.1172))
+21 ; COUNTRY
+22 SET DGADDGRP1(.11573)=$GET(DGADDGRP2(.1173))
+23 ; CASS INDICATOR
+24 SET DGADDGRP1(.1159)=$GET(DGADDGRP2(.1118))
+25 ; OVERRIDE KEY
+26 SET DGADDGRP1(.11591)=$GET(DGADDGRP2(.1119))
End DoDot:1
+27 IF '$TEST
Begin DoDot:1
+28 ; Local array not defined, so copy Mailing Address from the DB to the local array for Residential Address
+29 NEW DGAR,DGI
+30 SET DGAR=^DPT(DFN,.11)
+31 FOR DGI=1:1:12,18,19
SET DGAR(DGI)=$PIECE(DGAR,U,DGI)
+32 ; LINE 1
+33 SET DGADDGRP1(.1151)=DGAR(1)
+34 ; LINE 2
+35 SET DGADDGRP1(.1152)=DGAR(2)
+36 ; LINE 3
+37 SET DGADDGRP1(.1153)=DGAR(3)
+38 ; CITY
+39 SET DGADDGRP1(.1154)=DGAR(4)
+40 ; STATE
+41 SET DGADDGRP1(.1155)=DGAR(5)
+42 ; ZIP+4
+43 SET DGADDGRP1(.1156)=DGAR(12)
+44 ; COUNTY
+45 SET DGADDGRP1(.1157)=DGAR(7)
+46 ; PROVINCE
+47 SET DGADDGRP1(.11571)=DGAR(8)
+48 ; POSTAL CODE
+49 SET DGADDGRP1(.11572)=DGAR(9)
+50 ; COUNTRY
+51 SET DGADDGRP1(.11573)=DGAR(10)
+52 ; CASS INDICATOR
+53 SET DGADDGRP1(.1159)=DGAR(18)
+54 ; OVERRIDE KEY
+55 SET DGADDGRP1(.11591)=DGAR(19)
End DoDot:1
+56 ;
+57 ; If no phone number fields currently defined in the group 1 array, load them from the database into the Group 1 local array so they are preserved
+58 IF '$DATA(DGADDGRP1(.131))
SET DGADDGRP1(.131)=$PIECE($GET(^DPT(DFN,.13)),"^",1)
+59 IF '$DATA(DGADDGRP1(.132))
SET DGADDGRP1(.132)=$PIECE($GET(^DPT(DFN,.13)),"^",2)
+60 ;
+61 ; Set edit flag for group 1
+62 SET DGADDEDIT(1)=1
+63 QUIT
