DPTDZDCH.m

DPTDZDCH ; IHS/TUCSON/JCM - DELETE CHARTS FROM MERGED FROM PATIENT ;

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

 ;

 ;

START ;

 W:$D(IOF) @IOF W !,"This program will delete chart numbers from patients who have been merged ",!,"away.",!

 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 DELCHART

 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 deleted: ",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

 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")

 Q

GETOK ;

 S DPTDZFCH("OK")=""

 W !!,"I will delete 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

DELCHART ;change chart number

 ;change from chart number to to's chart number

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

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

 Q

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

 W !!?30,"Remaining Chart Numbers for this patient"

 W !!,"From DFN:  ",DPTDZFCH("FROM"),?22,"Name:  ",$P(^DPT(DPTDZFCH("FROM"),0),U) D

 S X=0 F  S X=$O(^AUPNPAT(DPTDZFCH("FROM"),41,X)) Q:X'=+X  W !?20,$P(^DIC(4,$P(^AUPNPAT(DPTDZFCH("FROM"),41,X,0),U),0),U),"  ",$P(^AUPNPAT(DPTDZFCH("FROM"),41,X,0),U,2)

 Q

 ;

DPTDZDCH  ; IHS/TUCSON/JCM - DELETE CHARTS FROM MERGED FROM PATIENT ;

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

 +2       ;

 +3       ;

START     ;

 +1        IF $DATA(IOF)

               WRITE @IOF

           WRITE !,"This program will delete chart numbers from patients who have been merged ",!,"away.",!

 +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 DELCHART

 +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 deleted: "

           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        SET DPTDZFCH("CHART SITE")=+Y

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

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

 +8        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        QUIT 

GETOK     ;

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

 +2        WRITE !!,"I will delete 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 

DELCHART  ;change chart number

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

 +2        SET DITC=""

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

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

           SET DA=DPTDZFCH("CHART SITE")

           SET DR=".01///@"

           DO ^DIE

 +3        IF $DATA(Y)

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

               KILL Y,DIE

               QUIT 

 +4        QUIT 

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

 +1        WRITE !!?30,"Remaining Chart Numbers for this patient"

 +2        WRITE !!,"From DFN:  ",DPTDZFCH("FROM"),?22,"Name:  ",$PIECE(^DPT(DPTDZFCH("FROM"),0),U)

           Begin DoDot:1

           End DoDot:1

 +3        SET X=0

           FOR 

               SET X=$ORDER(^AUPNPAT(DPTDZFCH("FROM"),41,X))

               IF X'=+X

                   QUIT 

               WRITE !?20,$PIECE(^DIC(4,$PIECE(^AUPNPAT(DPTDZFCH("FROM"),41,X,0),U),0),U),"  ",$PIECE(^AUPNPAT(DPTDZFCH("FROM"),41,X,0),U,2)

 +4        QUIT 

 +5       ;