Routine: DPTDZPO1

DPTDZPO1 ; IHS/TUCSON/JCM - PRE-MERGE INIT FOR PATIENT MERGE ; [ 09/10/2001  11:43 AM ]

 ;;1.0;PATIENT MERGE;;FEB 02, 1994

 ;IHS/ANMC/LJF 9/10/2001 made temp fix so HS/FS prints to TO pat

 ; This routine is part of the post merge action that occurs it is

 ; responsible for the printing of the health summary and the

 ; face sheet for the newly merged to patient.

 ; Input variables: XDRMRG("TO")

 ; Calls: START^AGFACE,EN^APCHS

 ; Called by: DPTDZPO

 ;--------------------------------------------------------------------

START ;

 K DPTDZPO1

 S DPTDZPO1("QFLG")=0

 S DPTDZPO1("DFN")=$S($D(DFN):DFN,1:"")

 D ASK G:DPTDZPO1("QFLG") END

 S DPTDZPO1("PAT")=XDRMRG("TO")

 D DEVICE G:DPTDZPO1("QFLG") END

 D:$D(DPTDZPO1("PCC")) HEALTH

 D FACE K AGOPT

END D EOJ

ASK ;

 K DIR

 S DIR(0)="YO",DIR("B")="Y",DIR("A")="Do you wish to print a face sheet"

 I $P(^AUTTSITE(1,0),U,8)="Y" S DIR("A")=DIR("A")_" and health summary" S DPTDZPO1("PCC")=""

 D ^DIR K DIR

 I $D(DUOUT)!($D(DTOUT)) S DPTDZPO1("QFLG")=1 G ASKX

 I 'Y S DPTDZPO1("QFLG")=1 G ASKX

 I $D(DPTDZPO1("PCC")) K DIC,Y S DIC=9001015,DIC("A")="Select health summary type: ",DIC(0)="AEQ" D

 .;S XX=$S($D(^APCHSCTL("B","PATIENT MERGE (COMPLETE)")):"PATIENT MERGE (COMPLETE)",1:"ADULT REGULAR"),DIC("B")=X D ^DIC S:Y>0 DPTDZPO1("TYPE")=+Y S:Y'>0 DPTDZPO1("QFLG")=1 K DIC  ;IHS/ANMC/LJF 9/10/2001

 .S X=$S($D(^APCHSCTL("B","PATIENT MERGE (COMPLETE)")):"PATIENT MERGE (COMPLETE)",1:"ADULT REGULAR"),DIC("B")=X D ^DIC S:Y>0 DPTDZPO1("TYPE")=+Y S:Y'>0 DPTDZPO1("QFLG")=1 K DIC  ;IHS/ANMC/LJF 9/10/2001

ASKX K Y

DEVICE ;

 ;S:$D(DPTDZPO1("DEVICE")) IOP=DPTDZPO1("DEVICE")  ;IHS/ANMC/LJF 9/10/2001

 S %ZIS(0)="MP" D ^%ZIS

 I POP S DPTDZPO1("QFLG")=1 G DEVICEX

 S DPTDZPO1("DEVICE")=$P(IO,";")_";"_IOST_";"_IOM_";"_IOSL

DEVICEX K %ZIS,POP

HEALTH ;

 I $D(^%ZOSF("XY"))#2 S (DX,DY)=0 X ^("XY") K DX,DY

 K APCHSPAT,APCHSTYP

 S APCHSPAT=DPTDZPO1("PAT"),APCHSTYP=DPTDZPO1("TYPE")

 D EN^APCHS

FACE ;

 I $D(^%ZOSF("XY"))#2 S (DX,DY)=0 X ^("XY") K DX,DY

 S DFN=DPTDZPO1("PAT")

 D START^AGFACE K AGOPT

EOJ ;

 K:'DPTDZPO1("DFN") DFN S:DPTDZPO1("DFN") DFN=DPTDZPO1("DFN")

 K DPTDZPO1

DPTDZPO1  ; IHS/TUCSON/JCM - PRE-MERGE INIT FOR PATIENT MERGE ; [ 09/10/2001  11:43 AM ]

 +1       ;;1.0;PATIENT MERGE;;FEB 02, 1994

 +2       ;IHS/ANMC/LJF 9/10/2001 made temp fix so HS/FS prints to TO pat

 +3       ;

 +4       ; This routine is part of the post merge action that occurs it is

 +5       ; responsible for the printing of the health summary and the

 +6       ; face sheet for the newly merged to patient.

 +7       ;

 +8       ; Input variables: XDRMRG("TO")

 +9       ;

 +10      ; Calls: START^AGFACE,EN^APCHS

 +11      ; Called by: DPTDZPO

 +12      ;--------------------------------------------------------------------

 +13      ;

START     ;

 +1        KILL DPTDZPO1

 +2        SET DPTDZPO1("QFLG")=0

 +3        SET DPTDZPO1("DFN")=$SELECT($DATA(DFN):DFN,1:"")

 +4        DO ASK

           IF DPTDZPO1("QFLG")

               GOTO END

 +5        SET DPTDZPO1("PAT")=XDRMRG("TO")

 +6        DO DEVICE

           IF DPTDZPO1("QFLG")

               GOTO END

 +7        IF $DATA(DPTDZPO1("PCC"))

               DO HEALTH

 +8        DO FACE

           KILL AGOPT

END        DO EOJ

 +1        QUIT

 +2       ;

ASK       ;

 +1        KILL DIR

 +2        SET DIR(0)="YO"

           SET DIR("B")="Y"

           SET DIR("A")="Do you wish to print a face sheet"

 +3        IF $PIECE(^AUTTSITE(1,0),U,8)="Y"

               SET DIR("A")=DIR("A")_" and health summary"

               SET DPTDZPO1("PCC")=""

 +4        DO ^DIR

           KILL DIR

 +5        IF $DATA(DUOUT)!($DATA(DTOUT))

               SET DPTDZPO1("QFLG")=1

               GOTO ASKX

 +6        IF 'Y

               SET DPTDZPO1("QFLG")=1

               GOTO ASKX

 +7        IF $DATA(DPTDZPO1("PCC"))

               KILL DIC,Y

               SET DIC=9001015

               SET DIC("A")="Select health summary type: "

               SET DIC(0)="AEQ"

               Begin DoDot:1

 +8       ;S XX=$S($D(^APCHSCTL("B","PATIENT MERGE (COMPLETE)")):"PATIENT MERGE (COMPLETE)",1:"ADULT REGULAR"),DIC("B")=X D ^DIC S:Y>0 DPTDZPO1("TYPE")=+Y S:Y'>0 DPTDZPO1("QFLG")=1 K DIC  ;IHS/ANMC/LJF 9/10/2001

 +9       ;IHS/ANMC/LJF 9/10/2001

                   SET X=$SELECT($DATA(^APCHSCTL("B","PATIENT MERGE (COMPLETE)")):"PATIENT MERGE (COMPLETE)",1:"ADULT REGULAR")

                   SET DIC("B")=X

                   DO ^DIC

                   IF Y>0

                       SET DPTDZPO1("TYPE")=+Y

                   IF Y'>0

                       SET DPTDZPO1("QFLG")=1

                   KILL DIC

               End DoDot:1

ASKX       KILL Y

 +1        QUIT

 +2       ;

DEVICE    ;

 +1       ;S:$D(DPTDZPO1("DEVICE")) IOP=DPTDZPO1("DEVICE")  ;IHS/ANMC/LJF 9/10/2001

 +2        SET %ZIS(0)="MP"

           DO ^%ZIS

 +3        IF POP

               SET DPTDZPO1("QFLG")=1

               GOTO DEVICEX

 +4        SET DPTDZPO1("DEVICE")=$PIECE(IO,";")_";"_IOST_";"_IOM_";"_IOSL

DEVICEX    KILL %ZIS,POP

 +1        QUIT

 +2       ;

HEALTH    ;

 +1        IF $DATA(^%ZOSF("XY"))#2

               SET (DX,DY)=0

               XECUTE ^("XY")

               KILL DX,DY

 +2        KILL APCHSPAT,APCHSTYP

 +3        SET APCHSPAT=DPTDZPO1("PAT")

           SET APCHSTYP=DPTDZPO1("TYPE")

 +4        DO EN^APCHS

 +5        QUIT

 +6       ;

FACE      ;

 +1        IF $DATA(^%ZOSF("XY"))#2

               SET (DX,DY)=0

               XECUTE ^("XY")

               KILL DX,DY

 +2        SET DFN=DPTDZPO1("PAT")

 +3        DO START^AGFACE

           KILL AGOPT

 +4        QUIT

 +5       ;

EOJ       ;

 +1        IF 'DPTDZPO1("DFN")

               KILL DFN

           IF DPTDZPO1("DFN")

               SET DFN=DPTDZPO1("DFN")

 +2        KILL DPTDZPO1

 +3        QUIT

DPTDZPO1.m