DPTDZFCH.m

DPTDZFCH ; IHS/TUCSON/JCM - CHANGE CHART NUMBERS FOR MERGED PATIENTS ; [ 02/02/94  4:52 PM ]

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

 ;

START ;

 W:$D(IOF) @IOF W !,"This program will switch chart numbers for patients who have been merged ",!,"together and who have had the wrong chart number kept for the patient.",!!

 D GETFROM

 G:DPTDZFCH("FROM")="" END

 D GETSITE

 G:DPTDZFCH("CHART SITE")="" END

 D DISPLAY

 D GETOK

 I DPTDZFCH("OK")="" W !,"Okay, Bye!!" G END

 D CHGCHART

 D DISPLAY2

END ;END OF JOB

 K DPTDZFCH,AUPNDAYS,AUPNSEX,AUPNPAT,AUPNDOB,AUPNDOD,APCHSPAT,APCHSTYP,AGQI,AGQT,AGTP

 K DA,DIE,DIC,DIK,DR,DO,D0,D,DI,DIW,DIWT,I,X,Y,XY,C,E,DQ,DN,DFN

 Q

 ;

GETFROM ;get the from patient (DFN)

 S DPTDZFCH("FROM")=""

 W !

 S DIR(0)="NO^1::0",DIR("A")="Enter the DFN of the From Patient",DIR("?")="Enter the internal entry number of the From (merged away) patient.  You can find this number on the mail message." D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 Q:$D(DIRUT)

 I '$D(^DPT(Y,0)) W !!,$C(7),$C(7),"That patient does not exist!!" K DIRUT,Y G GETFROM

 I $P(^DPT(Y,0),U,19)="" W !!,$C(7),$C(7),"That patient has NOT been merged away!!" K DIRUT,Y G GETFROM

 S DPTDZFCH("FROM")=Y,DPTDZFCH("TO")=$P(^DPT(DPTDZFCH("FROM"),0),U,19)

 Q

GETSITE ; GET the site for the chart number to be switched

 S DPTDZFCH("CHART SITE")=""

 S DIC("A")="Enter the facility of the chart number to be switched: ",DIC="^AUTTLOC(",DIC(0)="AEMQ" D ^DIC K DIC

 Q:Y=-1

 I '$D(^AUPNPAT(DPTDZFCH("FROM"),41,+Y)) W !!,$C(7),$C(7),"The 'From' patient, ",$P(^DPT(DPTDZFCH("FROM"),0),U)," does not have a chart at that facility." K Y G GETSITE

 I '$D(^AUPNPAT(DPTDZFCH("TO"),41,+Y)) W !!,$C(7),$C(7),"The 'To' patient, ",$P(^DPT(DPTDZFCH("TO"),0),U)," does not have a chart at that facility." K Y G GETSITE

 S DPTDZFCH("CHART SITE")=+Y

 S DPTDZFCH("FROM CHART")=$P(^AUPNPAT(DPTDZFCH("FROM"),41,DPTDZFCH("CHART SITE"),0),U,2)

 S DPTDZFCH("TO CHART")=$P(^AUPNPAT(DPTDZFCH("TO"),41,DPTDZFCH("CHART SITE"),0),U,2)

 Q

DISPLAY ;DISPLAY CURRENT CHART NUMBERS

 W:$D(IOF) @IOF

 W !!?28,"Current Chart Number Data"

 W !!,"From DFN:  ",DPTDZFCH("FROM"),?22,"Name:  ",$P(^DPT(DPTDZFCH("FROM"),0),U),?59,"Chart No.:  ",DPTDZFCH("FROM CHART")

 W !,"  To DFN:  ",DPTDZFCH("TO"),?22,"Name:  ",$P(^DPT(DPTDZFCH("TO"),0),U),?59,"Chart No.:  ",DPTDZFCH("TO CHART")

 Q

GETOK ;

 S DPTDZFCH("OK")=""

 W !!,"I will switch the chart numbers listed above.",!

 S DIR(0)="Y",DIR("A")="Do you want to continue",DIR("B")="N" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 Q:$D(DIRUT)

 I Y=0 W !!,"Okay, I won't" Q

 S DPTDZFCH("OK")=1

 Q

CHGCHART ;change chart number

 ;change from chart number to to's chart number

 S DIE="^AUPNPAT("_DPTDZFCH("FROM")_",41,",DA(1)=DPTDZFCH("FROM"),DA=DPTDZFCH("CHART SITE"),DR=".02///"_DPTDZFCH("TO CHART") D ^DIE

 I $D(Y) W !!,"OOPS.. Changing the From patient chart number failed in DIE!" K Y,DIE Q

 S DIE="^AUPNPAT("_DPTDZFCH("TO")_",41,",DA(1)=DPTDZFCH("TO"),DA=DPTDZFCH("CHART SITE"),DR=".02///"_DPTDZFCH("FROM CHART") D ^DIE

 I $D(Y) W !!,"OOPS.. Changing the To patient chart number failed in DIE!" K Y,DIE Q

 Q

DISPLAY2 ; print new chart info, face sheet and health summary

 W !!?30,"NEW Chart Number Data"

 W !!,"From DFN:  ",DPTDZFCH("FROM"),?22,"Name:  ",$P(^DPT(DPTDZFCH("FROM"),0),U),?59,"Chart No.:  ",$P(^AUPNPAT(DPTDZFCH("FROM"),41,DPTDZFCH("CHART SITE"),0),U,2)

 W !,"  To DFN:  ",DPTDZFCH("TO"),?22,"Name:  ",$P(^DPT(DPTDZFCH("TO"),0),U),?59,"Chart No.:  ",$P(^AUPNPAT(DPTDZFCH("TO"),41,DPTDZFCH("CHART SITE"),0),U,2)

 S DPTDZFCH("QFLG")=0

 D ASK G:DPTDZFCH("QFLG") END

 S DPTDZFCH("PAT")=DPTDZFCH("TO")

 D DEVICE G:DPTDZFCH("QFLG") END

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

 D FACE K AGOPT

 Q

 ;

ASK ;

 K DIR

 W !!

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

 I $P(^AUTTSITE(1,0),U,8)="Y" S DIR("A")=DIR("A")_" and health summary for the 'TO' patient" S DPTDZFCH("PCC")=""

 D ^DIR K DIR

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

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

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

 .S X=$S($D(^APCHSCTL("B","PATIENT MERGE (COMPLETE)")):"PATIENT MERGE (COMPLETE)",1:"ADULT REGULAR"),DIC("B")=X D ^DIC S:Y>0 DPTDZFCH("TYPE")=+Y S:Y'>0 DPTDZFCH("QFLG")=1 K DIC

ASKX K Y

 Q

 ;

DEVICE ;

 S:$D(DPTDZFCH("DEVICE")) IOP=DPTDZFCH("DEVICE")

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

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

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

DEVICEX K %ZIS,POP

 Q

 ;

HEALTH ;

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

 K APCHSPAT,APCHSTYP

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

 D EN^APCHS

 Q

 ;

FACE ;

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

 S DFN=DPTDZFCH("PAT")

 D START^AGFACE K AGOPT

 Q

DPTDZFCH  ; IHS/TUCSON/JCM - CHANGE CHART NUMBERS FOR MERGED PATIENTS ; [ 02/02/94  4:52 PM ]

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

 +2       ;

START     ;

 +1        IF $DATA(IOF)

               WRITE @IOF

           WRITE !,"This program will switch chart numbers for patients who have been merged ",!,"together and who have had the wrong chart number kept for the patient.",!!

 +2        DO GETFROM

 +3        IF DPTDZFCH("FROM")=""

               GOTO END

 +4        DO GETSITE

 +5        IF DPTDZFCH("CHART SITE")=""

               GOTO END

 +6        DO DISPLAY

 +7        DO GETOK

 +8        IF DPTDZFCH("OK")=""

               WRITE !,"Okay, Bye!!"

               GOTO END

 +9        DO CHGCHART

 +10       DO DISPLAY2

END       ;END OF JOB

 +1        KILL DPTDZFCH,AUPNDAYS,AUPNSEX,AUPNPAT,AUPNDOB,AUPNDOD,APCHSPAT,APCHSTYP,AGQI,AGQT,AGTP

 +2        KILL DA,DIE,DIC,DIK,DR,DO,D0,D,DI,DIW,DIWT,I,X,Y,XY,C,E,DQ,DN,DFN

 +3        QUIT 

 +4       ;

GETFROM   ;get the from patient (DFN)

 +1        SET DPTDZFCH("FROM")=""

 +2        WRITE !

 +3        SET DIR(0)="NO^1::0"

           SET DIR("A")="Enter the DFN of the From Patient"

           SET DIR("?")="Enter the internal entry number of the From (merged away) patient.  You can find this number on the mail message."

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +4        IF $DATA(DIRUT)

               QUIT 

 +5        IF '$DATA(^DPT(Y,0))

               WRITE !!,$CHAR(7),$CHAR(7),"That patient does not exist!!"

               KILL DIRUT,Y

               GOTO GETFROM

 +6        IF $PIECE(^DPT(Y,0),U,19)=""

               WRITE !!,$CHAR(7),$CHAR(7),"That patient has NOT been merged away!!"

               KILL DIRUT,Y

               GOTO GETFROM

 +7        SET DPTDZFCH("FROM")=Y

           SET DPTDZFCH("TO")=$PIECE(^DPT(DPTDZFCH("FROM"),0),U,19)

 +8        QUIT 

GETSITE   ; GET the site for the chart number to be switched

 +1        SET DPTDZFCH("CHART SITE")=""

 +2        SET DIC("A")="Enter the facility of the chart number to be switched: "

           SET DIC="^AUTTLOC("

           SET DIC(0)="AEMQ"

           DO ^DIC

           KILL DIC

 +3        IF Y=-1

               QUIT 

 +4        IF '$DATA(^AUPNPAT(DPTDZFCH("FROM"),41,+Y))

               WRITE !!,$CHAR(7),$CHAR(7),"The 'From' patient, ",$PIECE(^DPT(DPTDZFCH("FROM"),0),U)," does not have a chart at that facility."

               KILL Y

               GOTO GETSITE

 +5        IF '$DATA(^AUPNPAT(DPTDZFCH("TO"),41,+Y))

               WRITE !!,$CHAR(7),$CHAR(7),"The 'To' patient, ",$PIECE(^DPT(DPTDZFCH("TO"),0),U)," does not have a chart at that facility."

               KILL Y

               GOTO GETSITE

 +6        SET DPTDZFCH("CHART SITE")=+Y

 +7        SET DPTDZFCH("FROM CHART")=$PIECE(^AUPNPAT(DPTDZFCH("FROM"),41,DPTDZFCH("CHART SITE"),0),U,2)

 +8        SET DPTDZFCH("TO CHART")=$PIECE(^AUPNPAT(DPTDZFCH("TO"),41,DPTDZFCH("CHART SITE"),0),U,2)

 +9        QUIT 

DISPLAY   ;DISPLAY CURRENT CHART NUMBERS

 +1        IF $DATA(IOF)

               WRITE @IOF

 +2        WRITE !!?28,"Current Chart Number Data"

 +3        WRITE !!,"From DFN:  ",DPTDZFCH("FROM"),?22,"Name:  ",$PIECE(^DPT(DPTDZFCH("FROM"),0),U),?59,"Chart No.:  ",DPTDZFCH("FROM CHART")

 +4        WRITE !,"  To DFN:  ",DPTDZFCH("TO"),?22,"Name:  ",$PIECE(^DPT(DPTDZFCH("TO"),0),U),?59,"Chart No.:  ",DPTDZFCH("TO CHART")

 +5        QUIT 

GETOK     ;

 +1        SET DPTDZFCH("OK")=""

 +2        WRITE !!,"I will switch the chart numbers listed above.",!

 +3        SET DIR(0)="Y"

           SET DIR("A")="Do you want to continue"

           SET DIR("B")="N"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +4        IF $DATA(DIRUT)

               QUIT 

 +5        IF Y=0

               WRITE !!,"Okay, I won't"

               QUIT 

 +6        SET DPTDZFCH("OK")=1

 +7        QUIT 

CHGCHART  ;change chart number

 +1       ;change from chart number to to's chart number

 +2        SET DIE="^AUPNPAT("_DPTDZFCH("FROM")_",41,"

           SET DA(1)=DPTDZFCH("FROM")

           SET DA=DPTDZFCH("CHART SITE")

           SET DR=".02///"_DPTDZFCH("TO CHART")

           DO ^DIE

 +3        IF $DATA(Y)

               WRITE !!,"OOPS.. Changing the From patient chart number failed in DIE!"

               KILL Y,DIE

               QUIT 

 +4        SET DIE="^AUPNPAT("_DPTDZFCH("TO")_",41,"

           SET DA(1)=DPTDZFCH("TO")

           SET DA=DPTDZFCH("CHART SITE")

           SET DR=".02///"_DPTDZFCH("FROM CHART")

           DO ^DIE

 +5        IF $DATA(Y)

               WRITE !!,"OOPS.. Changing the To patient chart number failed in DIE!"

               KILL Y,DIE

               QUIT 

 +6        QUIT 

DISPLAY2  ; print new chart info, face sheet and health summary

 +1        WRITE !!?30,"NEW Chart Number Data"

 +2        WRITE !!,"From DFN:  ",DPTDZFCH("FROM"),?22,"Name:  ",$PIECE(^DPT(DPTDZFCH("FROM"),0),U),?59,"Chart No.:  ",$PIECE(^AUPNPAT(DPTDZFCH("FROM"),41,DPTDZFCH("CHART SITE"),0),U,2)

 +3        WRITE !,"  To DFN:  ",DPTDZFCH("TO"),?22,"Name:  ",$PIECE(^DPT(DPTDZFCH("TO"),0),U),?59,"Chart No.:  ",$PIECE(^AUPNPAT(DPTDZFCH("TO"),41,DPTDZFCH("CHART SITE"),0),U,2)

 +4        SET DPTDZFCH("QFLG")=0

 +5        DO ASK

           IF DPTDZFCH("QFLG")

               GOTO END

 +6        SET DPTDZFCH("PAT")=DPTDZFCH("TO")

 +7        DO DEVICE

           IF DPTDZFCH("QFLG")

               GOTO END

 +8        IF $DATA(DPTDZFCH("PCC"))

               DO HEALTH

 +9        DO FACE

           KILL AGOPT

 +10       QUIT 

 +11      ;

ASK       ;

 +1        KILL DIR

 +2        WRITE !!

 +3        SET DIR(0)="YO"

           SET DIR("B")="Y"

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

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

               SET DIR("A")=DIR("A")_" and health summary for the 'TO' patient"

               SET DPTDZFCH("PCC")=""

 +5        DO ^DIR

           KILL DIR

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

               SET DPTDZFCH("QFLG")=1

               GOTO ASKX

 +7        IF 'Y

               SET DPTDZFCH("QFLG")=1

               GOTO ASKX

 +8        IF $DATA(DPTDZFCH("PCC"))

               KILL DIC,Y

               SET DIC=9001015

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

               SET DIC(0)="AEQ"

               Begin DoDot:1

 +9                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 DPTDZFCH("TYPE")=+Y

                   IF Y'>0

                       SET DPTDZFCH("QFLG")=1

                   KILL DIC

               End DoDot:1

ASKX       KILL Y

 +1        QUIT 

 +2       ;

DEVICE    ;

 +1        IF $DATA(DPTDZFCH("DEVICE"))

               SET IOP=DPTDZFCH("DEVICE")

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

           DO ^%ZIS

 +3        IF POP

               SET DPTDZFCH("QFLG")=1

               GOTO DEVICEX

 +4        SET DPTDZFCH("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=DPTDZFCH("PAT")

           SET APCHSTYP=DPTDZFCH("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=DPTDZFCH("PAT")

 +3        DO START^AGFACE

           KILL AGOPT

 +4        QUIT