DGREGCOP.m

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 ---DGREGCOP   1304     printed  Apr 09, 2024@21:52:09                                                                                                                                                                                                    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