DGREGCP1.m

DGREGCP1 ;ALB/CLT,ARF - ADDRESS COPY UTILITIES ; 18 May 2017  2:54 PM

 ;;5.3;Registration;**941,1010,1040,1056**;Aug 13, 1993;Build 18

 ;

RESDISP(DFN) ;DISPLAY THE RESIDENTIAL ADDRESS

 N DGA1,DGA2,DGA3,DGA4,DGA9,DGA10,DGA1315,DGZIP

 N DGE,DGXX,DGFORGN,X,Y,DGCIEN,DGST,DGCNTRY,DGCNTY

 ;DG*5.3*1056 remove Permanent from the message following displayed message

 W !,"Residential Address to copy to the Mailing Address:",!

 I $G(^DPT(DFN,.115))="" D  Q

 .W !?5,"NO RESIDENTIAL ADDRESS"

 ;DISPLAY THE CURRENT RESIDENTIAL ADDRESS

 S DGXX=^DPT(DFN,.115),DGA1=$P(DGXX,"^",1),DGA2=$P(DGXX,"^",2),DGA3=$P(DGXX,"^",3),DGA4=$P(DGXX,"^",4)

 S DGA9=$P(DGXX,"^",9)

 S DGA10=$P(DGXX,"^",10) S:'DGA10 DGA10=""

 S DGCNTRY=$E($$CNTRYI^DGADDUTL(DGA10),1,25),DGFORGN=$$FORIEN^DGADDUTL(DGA10)

 I DGCNTRY=-1 S DGCNTRY="UNKNOWN COUNTRY"

 W:DGA1'="" !?3,DGA1 W:$G(DGA2)'="" !?3,DGA2 W:$G(DGA3)'="" !?3,DGA3

 ;FORDISP ;DISPLAY FOREIGN ADDRESS

 I DGA1="" W !

 I 'DGFORGN D

 . W ?43,"County: "

 . I $P(DGXX,U,5)=""!($P(DGXX,U,7)="") W "UNKNOWN" Q

 . I $P(DGXX,U,7)'="" I $D(^DIC(5,$P(DGXX,U,5),1,$P(DGXX,U,7),0)) D

 .. S DGST=$P(DGXX,U,5),DGCIEN=$P(DGXX,U,7)

 .. S DGCNTY=$$CNTY^DGREGAZL(DGST,DGCIEN) W $P(DGCNTY,"^",1),"(",$P(DGCNTY,"^",3),")"

 E  D

 . W ?43,"Province: "

 . W $S($P(DGXX,U,8)'="":$P(DGXX,U,8),1:"UNKNOWN")

 ;I DGFORGN W !?3,DGA9_" "_DGA4 ;DG*1010 comment out

 I DGFORGN W !?3,DGA4_" "_DGA9 ;DG*1010 - display postal code last

 I 'DGFORGN W !?3,DGA4 D

 . I $D(^DIC(5,+$P(^DPT(DFN,.115),"^",5),0)) W ",",$P(^DIC(5,+$P(^DPT(DFN,.115),"^",5),0),"^",2)

 . S DGZIP=$P(^DPT(DFN,.115),"^",6) I $L(DGZIP)>5 S DGZIP=$E(DGZIP,1,5)_"-"_$E(DGZIP,6,12)

 . W "  ",DGZIP

 W !?3,DGCNTRY,!

 Q

 ;

PERMDISP(DFN) ;DISPLAY MAILING ADDRESS

 N DGA1,DGA9,DGA10,DGA1315,DGA2,DGA3,DGA4,DGZIP

 N DGE,DGXX,DGFORGN,X,Y,DGCIEN,DGST,DGCNTRY,DGCNTY

 ;DG*5.3*1056 remove Permanent from the message following display messages and comment

 W !,"Mailing Address to copy to Residential Address:",!

 I $G(^DPT(DFN,.11))="" D  Q

 .W !?5,"NO MAILING ADDRESS"

 ;DISPLAY THE CURRENT MAILING ADDRESS

 S DGXX=^DPT(DFN,.11),DGA1=$P(DGXX,"^",1),DGA2=$P(DGXX,"^",2),DGA3=$P(DGXX,"^",3),DGA4=$P(DGXX,"^",4)

 S DGA9=$P(DGXX,"^",9)

 S DGA10=$P(DGXX,"^",10) S:'DGA10 DGA10=""

 S DGCNTRY=$E($$CNTRYI^DGADDUTL(DGA10),1,25),DGFORGN=$$FORIEN^DGADDUTL(DGA10)

 I DGCNTRY=-1 S DGCNTRY="UNKNOWN COUNTRY"

 W:DGA1'="" !?3,DGA1 W:$G(DGA2)'="" !?3,DGA2 W:$G(DGA3)'="" !?3,DGA3

 ;FORGNCHK ;CHECK FOR FOREIGN ADDRESS

 I DGA1="" W !

 I 'DGFORGN D

 . W ?43,"County: "

 . I $P(DGXX,U,5)=""!($P(DGXX,U,7)="") W "UNKNOWN" Q

 . I $P(DGXX,U,7)'="" I $D(^DIC(5,$P(DGXX,U,5),1,$P(DGXX,U,7),0)) D

 .. S DGST=$P(DGXX,U,5),DGCIEN=$P(DGXX,U,7)

 .. S DGCNTY=$$CNTY^DGREGAZL(DGST,DGCIEN) W $P(DGCNTY,"^",1),"(",$P(DGCNTY,"^",3),")"

 E  D

 . W ?43,"Province: "

 . W $S($P(DGXX,U,8)'="":$P(DGXX,U,8),1:"UNKNOWN")

 ;I DGFORGN W !?3,DGA9_" "_DGA4 ;DG*1010 comment out

 I DGFORGN W !?3,DGA4_" "_DGA9 ;DG*1010 - display postal code last

 I 'DGFORGN W !?3,DGA4 D

 . I $D(^DIC(5,+$P(^DPT(DFN,.11),"^",5),0)) W ",",$P(^DIC(5,+$P(^DPT(DFN,.11),"^",5),0),"^",2)

 . S DGZIP=$P(^DPT(DFN,.11),"^",6) I $L(DGZIP)>5 S DGZIP=$E(DGZIP,1,5)_"-"_$E(DGZIP,6,12)

 . W "  ",DGZIP

 W !?3,DGCNTRY,!

 Q

 ;

RESMVQ(DFN) ;DISPLAY RESIDENTIAL ADDRESS AND QUESTION IF COPY TO PERM IS DESIRED

 I $G(^DPT(DFN,.115))="" Q

 N DIR,X,Y,DTOUT,DUOUT

 ;DG*5.3*1056 remove Permanent from the message following displayed prompts

 S DIR(0)="Y",DIR("A")="Copy the Residential Address to the Mailing Address",DIR("B")="NO"

 S DIR("?",1)="Enter 'YES' to copy the Residential Address ",DIR("?")="to the Mailing Address."

 D ^DIR

 ; DG*5.3*1040 - Check for timeout of the Copy prompt

 I $D(DTOUT) S DGTMOT=1 Q

 I $G(Y)=1 D

 . W !

 . D RESDISP(DFN)

 . S DIR(0)="Y",DIR("A")="Are you sure you want to copy",DIR("B")=""

 . S DIR("?",1)="If you answer 'YES' the current Residential Address will be copied",DIR("?")="to the Permanent Mailing Address."

 . D ^DIR

 . ; DG*5.3*1040 - Set variable DGTMOT=1, if timeout

 . I $D(DTOUT) S DGTMOT=1 Q

 . ; DG*5.3*1040 - QUIT if variable Y = 0

 . Q:$G(Y)=0

 . I $D(DUOUT)!$D(DIROUT) Q

 . D R2P^DGREGCOP(DFN)

 . W !,"Copy completed."

 . D EOP

 Q

 ;

PERMMVQ(DFN) ;DISPLAY MAILING ADDRESS AND QUESTION IF COPY TO RESIDENTIAL IS DESIRED

 ; First check for a valid Mailing Address that can be copied to residential address

 N DGXX,DGA10,DFORGN

 S DGXX=$G(^DPT(DFN,.11))

 ; Quit if nothing in Perm address line 1 field

 I $P(DGXX,"^",1)="" Q

 ; Quit if nothing in Perm address City field

 I $P(DGXX,"^",4)="" Q

 ; Quit if no Perm address zipcode defined for a domestic address

 S DGA10=$P(DGXX,"^",10) S:'DGA10 DGA10=""

 S DGFORGN=$$FORIEN^DGADDUTL(DGA10)

 I 'DGFORGN&($P(DGXX,"^",6)="") Q

 ; required address fields exist for copying to Residential address

 ; now check for PO Box or General Delivery address and notify user if not valid address and quit

 N DGADD,DIR,X,Y,DGRESADD,DGRESX

 K DIRUT

 I $$POBOXPM^DGREGCP2(DFN) D  Q

 . W !!?3,*7,"P.O. Box and GENERAL DELIVERY cannot be used in residential address." W !

 . ;DG*5.3*1056 remove Permanent from the following message displayed messages

 . W !,"Because the Mailing Address line 1 contains P.O. Box"

 . W " or General",!,"Delivery the Mailing Address cannot be copied to"

 . W !,"the Residential Address."

 . D EOP

 . ; DG*5.3*1040 - Check for timeout

 . Q:+$G(DGTMOT)

 ; Perm address is valid for use as a Residential address

ASK ; 

 W !

 ;DG*5.3*1056 remove Permanent from the following message displayed message and prompt

 S DIR(0)="Y",DIR("A")="Copy the Mailing Address to the Residential Address"

 S DIR("?",1)="Answer 'YES' or 'NO'. 'YES' will copy the current Mailing Address",DIR("?")="to the Residential Address."

 D ^DIR

 I X="Y"!(X="YES") S Y=1,Y(0)="YES"

 ; DG*5.3*1040 - Set variable DGTMOT=1, if timeout

 I $D(DTOUT) S DGTMOT=1 Q

 ; DG*5.3*1040 - QUIT if Y = 0

 Q:$G(Y)=0

 I $D(DUOUT)!$D(DIROUT) Q

 I $D(DIRUT) G ASK

 I Y=1 D

 . W !

 . D PERMDISP(DFN) ;; W !! D RESDISP(DFN) W !

 . S DIR(0)="Y",DIR("A")="Are you sure you want to copy",DIR("B")=""

 . ;DG*5.3*1056 remove Permanent from the following message displayed prompt

 . S DIR("?",1)="If you answer 'YES' the current Mailing Address will be copied",DIR("?")="to the Residential Address."

 . D ^DIR

 . ; DG*5.3*1040 - Set variable DGTMOT=1, if timeout

 . I $D(DTOUT) S DGTMOT=1 Q

 . ; DG*5.3*1040 - QUIT if Y = 0

 . Q:$G(Y)=0

 . I $D(DUOUT)!$D(DIROUT) Q

 . D P2R^DGREGCOP(DFN)

 . W !,"Copy completed."

 . D EOP

 ; DG*5.3*1040 - Check for timeout

 Q:+$G(DGTMOT)

 Q

EOP ;End of page prompt

 N DIR,DTOUT,DUOUT,DIROUT,X,Y

 S DIR(0)="E"

 S DIR("A")="Press ENTER to continue"

 D ^DIR

 ; DG*5.3*1040 - Set variable DGTMOT=1 to track timeout

 I $D(DTOUT) S DGTMOT=1 Q

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DGREGCP1   6846     printed  Mar 13, 2025@21:59:39                                                                                                                                                                                                    Page 2

DGREGCP1  ;ALB/CLT,ARF - ADDRESS COPY UTILITIES ; 18 May 2017  2:54 PM

 +1       ;;5.3;Registration;**941,1010,1040,1056**;Aug 13, 1993;Build 18

 +2       ;

RESDISP(DFN) ;DISPLAY THE RESIDENTIAL ADDRESS

 +1        NEW DGA1,DGA2,DGA3,DGA4,DGA9,DGA10,DGA1315,DGZIP

 +2        NEW DGE,DGXX,DGFORGN,X,Y,DGCIEN,DGST,DGCNTRY,DGCNTY

 +3       ;DG*5.3*1056 remove Permanent from the message following displayed message

 +4        WRITE !,"Residential Address to copy to the Mailing Address:",!

 +5        IF $GET(^DPT(DFN,.115))=""

               Begin DoDot:1

 +6                WRITE !?5,"NO RESIDENTIAL ADDRESS"

               End DoDot:1

               QUIT 

 +7       ;DISPLAY THE CURRENT RESIDENTIAL ADDRESS

 +8        SET DGXX=^DPT(DFN,.115)

           SET DGA1=$PIECE(DGXX,"^",1)

           SET DGA2=$PIECE(DGXX,"^",2)

           SET DGA3=$PIECE(DGXX,"^",3)

           SET DGA4=$PIECE(DGXX,"^",4)

 +9        SET DGA9=$PIECE(DGXX,"^",9)

 +10       SET DGA10=$PIECE(DGXX,"^",10)

           if 'DGA10

               SET DGA10=""

 +11       SET DGCNTRY=$EXTRACT($$CNTRYI^DGADDUTL(DGA10),1,25)

           SET DGFORGN=$$FORIEN^DGADDUTL(DGA10)

 +12       IF DGCNTRY=-1

               SET DGCNTRY="UNKNOWN COUNTRY"

 +13       if DGA1'=""

               WRITE !?3,DGA1

           if $GET(DGA2)'=""

               WRITE !?3,DGA2

           if $GET(DGA3)'=""

               WRITE !?3,DGA3

 +14      ;FORDISP ;DISPLAY FOREIGN ADDRESS

 +15       IF DGA1=""

               WRITE !

 +16       IF 'DGFORGN

               Begin DoDot:1

 +17               WRITE ?43,"County: "

 +18               IF $PIECE(DGXX,U,5)=""!($PIECE(DGXX,U,7)="")

                       WRITE "UNKNOWN"

                       QUIT 

 +19               IF $PIECE(DGXX,U,7)'=""

                       IF $DATA(^DIC(5,$PIECE(DGXX,U,5),1,$PIECE(DGXX,U,7),0))

                           Begin DoDot:2

 +20                           SET DGST=$PIECE(DGXX,U,5)

                               SET DGCIEN=$PIECE(DGXX,U,7)

 +21                           SET DGCNTY=$$CNTY^DGREGAZL(DGST,DGCIEN)

                               WRITE $PIECE(DGCNTY,"^",1),"(",$PIECE(DGCNTY,"^",3),")"

                           End DoDot:2

               End DoDot:1

 +22      IF '$TEST

               Begin DoDot:1

 +23               WRITE ?43,"Province: "

 +24               WRITE $SELECT($PIECE(DGXX,U,8)'="":$PIECE(DGXX,U,8),1:"UNKNOWN")

               End DoDot:1

 +25      ;I DGFORGN W !?3,DGA9_" "_DGA4 ;DG*1010 comment out

 +26      ;DG*1010 - display postal code last

           IF DGFORGN

               WRITE !?3,DGA4_" "_DGA9

 +27       IF 'DGFORGN

               WRITE !?3,DGA4

               Begin DoDot:1

 +28               IF $DATA(^DIC(5,+$PIECE(^DPT(DFN,.115),"^",5),0))

                       WRITE ",",$PIECE(^DIC(5,+$PIECE(^DPT(DFN,.115),"^",5),0),"^",2)

 +29               SET DGZIP=$PIECE(^DPT(DFN,.115),"^",6)

                   IF $LENGTH(DGZIP)>5

                       SET DGZIP=$EXTRACT(DGZIP,1,5)_"-"_$EXTRACT(DGZIP,6,12)

 +30               WRITE "  ",DGZIP

               End DoDot:1

 +31       WRITE !?3,DGCNTRY,!

 +32       QUIT 

 +33      ;

PERMDISP(DFN) ;DISPLAY MAILING ADDRESS

 +1        NEW DGA1,DGA9,DGA10,DGA1315,DGA2,DGA3,DGA4,DGZIP

 +2        NEW DGE,DGXX,DGFORGN,X,Y,DGCIEN,DGST,DGCNTRY,DGCNTY

 +3       ;DG*5.3*1056 remove Permanent from the message following display messages and comment

 +4        WRITE !,"Mailing Address to copy to Residential Address:",!

 +5        IF $GET(^DPT(DFN,.11))=""

               Begin DoDot:1

 +6                WRITE !?5,"NO MAILING ADDRESS"

               End DoDot:1

               QUIT 

 +7       ;DISPLAY THE CURRENT MAILING ADDRESS

 +8        SET DGXX=^DPT(DFN,.11)

           SET DGA1=$PIECE(DGXX,"^",1)

           SET DGA2=$PIECE(DGXX,"^",2)

           SET DGA3=$PIECE(DGXX,"^",3)

           SET DGA4=$PIECE(DGXX,"^",4)

 +9        SET DGA9=$PIECE(DGXX,"^",9)

 +10       SET DGA10=$PIECE(DGXX,"^",10)

           if 'DGA10

               SET DGA10=""

 +11       SET DGCNTRY=$EXTRACT($$CNTRYI^DGADDUTL(DGA10),1,25)

           SET DGFORGN=$$FORIEN^DGADDUTL(DGA10)

 +12       IF DGCNTRY=-1

               SET DGCNTRY="UNKNOWN COUNTRY"

 +13       if DGA1'=""

               WRITE !?3,DGA1

           if $GET(DGA2)'=""

               WRITE !?3,DGA2

           if $GET(DGA3)'=""

               WRITE !?3,DGA3

 +14      ;FORGNCHK ;CHECK FOR FOREIGN ADDRESS

 +15       IF DGA1=""

               WRITE !

 +16       IF 'DGFORGN

               Begin DoDot:1

 +17               WRITE ?43,"County: "

 +18               IF $PIECE(DGXX,U,5)=""!($PIECE(DGXX,U,7)="")

                       WRITE "UNKNOWN"

                       QUIT 

 +19               IF $PIECE(DGXX,U,7)'=""

                       IF $DATA(^DIC(5,$PIECE(DGXX,U,5),1,$PIECE(DGXX,U,7),0))

                           Begin DoDot:2

 +20                           SET DGST=$PIECE(DGXX,U,5)

                               SET DGCIEN=$PIECE(DGXX,U,7)

 +21                           SET DGCNTY=$$CNTY^DGREGAZL(DGST,DGCIEN)

                               WRITE $PIECE(DGCNTY,"^",1),"(",$PIECE(DGCNTY,"^",3),")"

                           End DoDot:2

               End DoDot:1

 +22      IF '$TEST

               Begin DoDot:1

 +23               WRITE ?43,"Province: "

 +24               WRITE $SELECT($PIECE(DGXX,U,8)'="":$PIECE(DGXX,U,8),1:"UNKNOWN")

               End DoDot:1

 +25      ;I DGFORGN W !?3,DGA9_" "_DGA4 ;DG*1010 comment out

 +26      ;DG*1010 - display postal code last

           IF DGFORGN

               WRITE !?3,DGA4_" "_DGA9

 +27       IF 'DGFORGN

               WRITE !?3,DGA4

               Begin DoDot:1

 +28               IF $DATA(^DIC(5,+$PIECE(^DPT(DFN,.11),"^",5),0))

                       WRITE ",",$PIECE(^DIC(5,+$PIECE(^DPT(DFN,.11),"^",5),0),"^",2)

 +29               SET DGZIP=$PIECE(^DPT(DFN,.11),"^",6)

                   IF $LENGTH(DGZIP)>5

                       SET DGZIP=$EXTRACT(DGZIP,1,5)_"-"_$EXTRACT(DGZIP,6,12)

 +30               WRITE "  ",DGZIP

               End DoDot:1

 +31       WRITE !?3,DGCNTRY,!

 +32       QUIT 

 +33      ;

RESMVQ(DFN) ;DISPLAY RESIDENTIAL ADDRESS AND QUESTION IF COPY TO PERM IS DESIRED

 +1        IF $GET(^DPT(DFN,.115))=""

               QUIT 

 +2        NEW DIR,X,Y,DTOUT,DUOUT

 +3       ;DG*5.3*1056 remove Permanent from the message following displayed prompts

 +4        SET DIR(0)="Y"

           SET DIR("A")="Copy the Residential Address to the Mailing Address"

           SET DIR("B")="NO"

 +5        SET DIR("?",1)="Enter 'YES' to copy the Residential Address "

           SET DIR("?")="to the Mailing Address."

 +6        DO ^DIR

 +7       ; DG*5.3*1040 - Check for timeout of the Copy prompt

 +8        IF $DATA(DTOUT)

               SET DGTMOT=1

               QUIT 

 +9        IF $GET(Y)=1

               Begin DoDot:1

 +10               WRITE !

 +11               DO RESDISP(DFN)

 +12               SET DIR(0)="Y"

                   SET DIR("A")="Are you sure you want to copy"

                   SET DIR("B")=""

 +13               SET DIR("?",1)="If you answer 'YES' the current Residential Address will be copied"

                   SET DIR("?")="to the Permanent Mailing Address."

 +14               DO ^DIR

 +15      ; DG*5.3*1040 - Set variable DGTMOT=1, if timeout

 +16               IF $DATA(DTOUT)

                       SET DGTMOT=1

                       QUIT 

 +17      ; DG*5.3*1040 - QUIT if variable Y = 0

 +18               if $GET(Y)=0

                       QUIT 

 +19               IF $DATA(DUOUT)!$DATA(DIROUT)

                       QUIT 

 +20               DO R2P^DGREGCOP(DFN)

 +21               WRITE !,"Copy completed."

 +22               DO EOP

               End DoDot:1

 +23       QUIT 

 +24      ;

PERMMVQ(DFN) ;DISPLAY MAILING ADDRESS AND QUESTION IF COPY TO RESIDENTIAL IS DESIRED

 +1       ; First check for a valid Mailing Address that can be copied to residential address

 +2        NEW DGXX,DGA10,DFORGN

 +3        SET DGXX=$GET(^DPT(DFN,.11))

 +4       ; Quit if nothing in Perm address line 1 field

 +5        IF $PIECE(DGXX,"^",1)=""

               QUIT 

 +6       ; Quit if nothing in Perm address City field

 +7        IF $PIECE(DGXX,"^",4)=""

               QUIT 

 +8       ; Quit if no Perm address zipcode defined for a domestic address

 +9        SET DGA10=$PIECE(DGXX,"^",10)

           if 'DGA10

               SET DGA10=""

 +10       SET DGFORGN=$$FORIEN^DGADDUTL(DGA10)

 +11       IF 'DGFORGN&($PIECE(DGXX,"^",6)="")

               QUIT 

 +12      ; required address fields exist for copying to Residential address

 +13      ; now check for PO Box or General Delivery address and notify user if not valid address and quit

 +14       NEW DGADD,DIR,X,Y,DGRESADD,DGRESX

 +15       KILL DIRUT

 +16       IF $$POBOXPM^DGREGCP2(DFN)

               Begin DoDot:1

 +17               WRITE !!?3,*7,"P.O. Box and GENERAL DELIVERY cannot be used in residential address."

                   WRITE !

 +18      ;DG*5.3*1056 remove Permanent from the following message displayed messages

 +19               WRITE !,"Because the Mailing Address line 1 contains P.O. Box"

 +20               WRITE " or General",!,"Delivery the Mailing Address cannot be copied to"

 +21               WRITE !,"the Residential Address."

 +22               DO EOP

 +23      ; DG*5.3*1040 - Check for timeout

 +24               if +$GET(DGTMOT)

                       QUIT 

               End DoDot:1

               QUIT 

 +25      ; Perm address is valid for use as a Residential address

ASK       ; 

 +1        WRITE !

 +2       ;DG*5.3*1056 remove Permanent from the following message displayed message and prompt

 +3        SET DIR(0)="Y"

           SET DIR("A")="Copy the Mailing Address to the Residential Address"

 +4        SET DIR("?",1)="Answer 'YES' or 'NO'. 'YES' will copy the current Mailing Address"

           SET DIR("?")="to the Residential Address."

 +5        DO ^DIR

 +6        IF X="Y"!(X="YES")

               SET Y=1

               SET Y(0)="YES"

 +7       ; DG*5.3*1040 - Set variable DGTMOT=1, if timeout

 +8        IF $DATA(DTOUT)

               SET DGTMOT=1

               QUIT 

 +9       ; DG*5.3*1040 - QUIT if Y = 0

 +10       if $GET(Y)=0

               QUIT 

 +11       IF $DATA(DUOUT)!$DATA(DIROUT)

               QUIT 

 +12       IF $DATA(DIRUT)

               GOTO ASK

 +13       IF Y=1

               Begin DoDot:1

 +14               WRITE !

 +15      ;; W !! D RESDISP(DFN) W !

                   DO PERMDISP(DFN)

 +16               SET DIR(0)="Y"

                   SET DIR("A")="Are you sure you want to copy"

                   SET DIR("B")=""

 +17      ;DG*5.3*1056 remove Permanent from the following message displayed prompt

 +18               SET DIR("?",1)="If you answer 'YES' the current Mailing Address will be copied"

                   SET DIR("?")="to the Residential Address."

 +19               DO ^DIR

 +20      ; DG*5.3*1040 - Set variable DGTMOT=1, if timeout

 +21               IF $DATA(DTOUT)

                       SET DGTMOT=1

                       QUIT 

 +22      ; DG*5.3*1040 - QUIT if Y = 0

 +23               if $GET(Y)=0

                       QUIT 

 +24               IF $DATA(DUOUT)!$DATA(DIROUT)

                       QUIT 

 +25               DO P2R^DGREGCOP(DFN)

 +26               WRITE !,"Copy completed."

 +27               DO EOP

               End DoDot:1

 +28      ; DG*5.3*1040 - Check for timeout

 +29       if +$GET(DGTMOT)

               QUIT 

 +30       QUIT 

EOP       ;End of page prompt

 +1        NEW DIR,DTOUT,DUOUT,DIROUT,X,Y

 +2        SET DIR(0)="E"

 +3        SET DIR("A")="Press ENTER to continue"

 +4        DO ^DIR

 +5       ; DG*5.3*1040 - Set variable DGTMOT=1 to track timeout

 +6        IF $DATA(DTOUT)

               SET DGTMOT=1

               QUIT 

 +7        QUIT