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 ;
