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
