QANEDIT ;WCIOFO/ERC-Edit a Brief Incident ;4/22/99
;;2.0;Incident Reporting;**27,26,32**;08/07/1992;Build 3
;
START ;
W @IOF
N QANBFLG,QANIEN,QANNOPAT
F W !!,"Do you want to edit one of your open Incident Reports" S %=1 D YN^DICN Q:"-112"[% W !!,"Enter (Y)es, (N)o or ""^"" to exit"
I %=1 D EDIT
K QANXIT
Q
EDIT ;
K ^TMP("QAN EDIT")
S QANCNT=1
S QANDUZ=DUZ
S QANEE=0
F S QANEE=$O(^QA(742.4,"ACS",1,QANEE)) Q:QANEE'>0 D
. I QANDUZ=$P(^QA(742.4,QANEE,0),U,5) S ^TMP("QAN EDIT",$J,QANCNT,QANEE)="",QANCNT=QANCNT+1
W @IOF
I '$D(^TMP("QAN EDIT")) D Q
. W !!,"**** You have no open Incident Reports to edit. Exiting.",!!
W !!,"Here are your open Incident Reports."
S QANEE=0
S QANTOT=0
F S QANEE=$O(^TMP("QAN EDIT",$J,QANEE)) Q:QANEE'>0 D
. S QANIEN=$O(^TMP("QAN EDIT",$J,QANEE,0)) Q:QANIEN'>0
. S QAN0=^QA(742.4,QANIEN,0)
. S QANCC=0,QANCNT=1
. S QANTOT=QANTOT+1 ;gets number of IRs for selecting record to edit
. F S QANCC=$O(^QA(742,"BCS",QANIEN,QANCC)) Q:QANCC'>0 D
. . S QANNAME=$P(^DPT($P(^QA(742,QANCC,0),U),0),U)
. . S Y=$P(QAN0,U,3) D DD^%DT S QANDATE=Y
. . S QANINC=$P(^QA(742.1,$P(QAN0,U,2),0),U)
. . I $Y>(IOSL-6) K DIR S DIR(0)="E" D ^DIR K DIR W @IOF
. . I QANCNT=1 W !,QANEE,?4,QANDATE,?25,$E(QANINC,1,25),?51,QANNAME
. . I QANCNT>1 W !?51,QANNAME
. . S QANCNT=QANCNT+1
DIR ;
I $G(QANTOT)=1 S QANIEN=$O(^TMP("QAN EDIT",$J,1,0)) G DIE
K DIR
S DIR(0)="NOA"
S DIR("A")="Select a number from 1 to "_QANTOT_": "
D ^DIR K DIR Q:$D(DIRUT)!(+Y<1)
I +Y>QANTOT W !,"Number selected must be from 1 to "_QANTOT_", try again." G DIR
S QANIEN=$O(^TMP("QAN EDIT",$J,+Y,0))
I $G(QANIEN)]"",($D(^QA(742.4,QANIEN,0))) D
. L +^QA(742.4,QANIEN):5 I '$T W !!,"Another user is editing this record." Q
. S QANEDFLG=1
. D DIE
. I $O(^QA(742,"BCS",QANIEN,0))']"" D
. . ;if no patients entered, delete the incident
. . W !!,"No patients on this Incident Report - deleting Report."
. . S DIK="^QA(742.4,",DA=QANIEN D ^DIK K DIK
. D EXIT
Q
DIE ;
W !!
N QANCNT,QANEE
S QANEFLG=0
S QANEE=0
S QANCNT=1
F S QANEE=$O(^QA(742,"BCS",QANIEN,QANEE)) Q:QANEE'>0 D
. S QANPAT(QANCNT)=QANEE
. S QANCNT=QANCNT+1
K DIE S DIE="^QA(742.4,",DA=QANIEN,DR=".02;.03;.04"
D ^DIE K DIE
L -^QA(742.4,QANIEN)
PAT ;edit patient(s) on report
;if no patients entered go directly to PTADD
I $O(^QA(742,"BCS",QANIEN,0))']"" G PTADD
K QANPNAM,QANPNUM
W !,"Patient(s) on this Incident Report."
S QANEE=0
S QANCNT=1
F S QANEE=$O(QANPAT(QANEE)) Q:QANEE'>0 D
. S QANPNUM(QANEE)=$P(^QA(742,QANPAT(QANEE),0),U)
. S QANPNAM(QANEE)=$P(^DPT(QANPNUM(QANEE),0),U)
. W !?5,QANCNT," ",QANPNAM(QANEE)
. S QANCNT=QANCNT+1
S DIR("A")="Is this correct"
S DIR("B")="YES"
S DIR(0)="Y"
D ^DIR K DIR Q:$D(DIRUT)
I Y<1 D
. S DIR(0)="Y",DIR("A")="Would you like to add a patient"
. S DIR("B")="YES"
. K DIRUT
. D ^DIR K DIR Q:$D(DIRUT)
. I Y=1 D PTADD S (QANEFLG,QANEDFLG)=1 Q
. ;deleting patients from record only allowed if editing a new record
. I $G(QANBFLG)'=1 Q
. K DIR S DIR(0)="Y",DIR("A")="Would you like to delete a patient"
. S DIR("B")="NO"
. K DIRUT
. D ^DIR K DIR Q:$D(DIRUT)
. I Y=1 D PTDEL S (QANEFLG,QANEDFLG)=1
;if the user has deleted all patients and has not re-entered one,
;exit the subroutine (a message will be displayed & the record deleted)
I $G(QANNOPAT)=1 K QANNOPAT Q
I $G(QANEFLG)=1 S QANEFLG=0 G PAT
;if no patients on report skip description and witnessed and quit
I $O(^QA(742,"BCS",QANIEN,0))']"" Q
K DIE S DIE="^QA(742.4,",DR=".05;.08"
D ^DIE K DIE
Q
PTADD ;
K DIC S DIC="^DPT(",DIC(0)="QEAMNZ",DIC("A")="Select Patient: ",DIC("W")="W "" "",$P(^(0),U,9)",D="B^BS5"
D MIX^DIC1 K DIC
I +Y<1 S QANXIT=1 Q
F D Q:"-12"[%
. W !?5,$G(Y(0,0))_" OK"
. S %=1 D YN^DICN Q:"-12"[%
. W " Confirm that this is the correct patient."
I %=-1 S QANXIT=1 Q
I %=2 W " ??" G PTADD
S QANEE=0
F S QANEE=$O(QANPNUM(QANEE)) Q:QANEE'>0 D
. I +Y=QANPNUM(QANEE) W !!,$C(7),$P(^DPT(+Y,0),U)_" has been previously entered for this incident." K Y S QANXFLG=1 Q
I $G(QANXFLG)=1 S QANXFLG=0 G PTADD
I $D(^DPT(+Y,.35)),$P(^DPT(+Y,.35),U)]"",($P(^DPT(+Y,.35),U)<$P(^QA(742.4,QANIEN,0),U,3)) W !!,$C(7),"The date of death for patient: "_$P(^DPT(+Y,0),U)_" precedes the incident date." K Y G PTADD
S QANPIEN=+Y,QANZERO=Y(0),QANAME=Y(0,0),QANSSN=$P(QANZERO,U,9),^UTILITY($J,"QAN PAT",+Y)=""
S QANDOB=$P(^DPT(QANPIEN,0),U,3)
I QANDOB]"" S X=DT,X1=X,X2=QANDOB,X="" D:X2 ^%DTC S X=X\365.25,QANAGE=X
S QANPSDO(0)=Y(0),QANPSDO(0,0)=Y(0,0)
S QANPID=$$QANPID^QANCDNT(.Y)
D ADMDT^QANUTL1
K DIC,DD,DO,DINUM,DLAYGO S DLAYGO=742,DIC="^QA(742,",DIC(0)="L",X=QANPIEN D FILE^DICN K DIC,DD,DO,DINUM,DLAYGO
I +Y=-1,($G(QANFLAG)) S QANXIT=1 Q
S QANDFN=+Y
S $P(^QA(742,QANDFN,0),U,2,6)=QANPID_U_QANIEN_U_QANADMDT_U_QANINPAT_U_QANWARD
S $P(^QA(742,QANDFN,0),U,7)=QANTRSP,$P(^QA(742,QANDFN,0),U,12)=1
S DIK="^QA(742,",DA=QANDFN D IX1^DIK K DA,DIK
S QANNUM=$O(QANPAT(" "),-1)+1
S QANPAT(QANNUM)=QANDFN
S QANPNUM(QANNUM)=QANPIEN
S QANPNAM(QANNUM)=QANAME
S QANFLAG=1 D:'$D(QANF) BULL^QANUTL3
K QAUDIT S QAUDIT("FILE")="742^50",QAUDIT("DA")=QANDFN,QAUDIT("ACTION")="e",QAUDIT("COMMENT")="Edit a brief patient record" D ^QAQAUDIT
Q
PTDEL ;
S QANCC=0
F S QANCC=$O(QANPNUM(QANCC)) Q:QANCC'>0 D
. S QANNUM=QANCC
. W !?5,QANCC_" "_QANPNAM(QANCC)
I '$G(QANNUM) S QANXIT=1 Q
S DIR(0)="NOA"
S DIR("A")="Delete which patient number: "
D ^DIR K DIR Q:$D(DIRUT)
I $G(QANPNAM(+Y))']"" W !!?5,"Choice must be one of the displayed numbers." G PTDEL
I Y>QANNUM W !!?5,"Answer must be a number less than ",QANNUM+1 G PTDEL
I Y<1 S QANXIT=1 Q
S QANTEMP=+Y
S QANDFN=QANPAT(+Y)
S QANAME=QANPNAM(+Y)
S DIK="^QA(742,",DA=QANPAT(+Y) D ^DIK
;D BULL^QANUTL3
;K QAUDIT S QAUDIT("FILE")="742^50",QAUDIT("DA")=QANDFN,QAUDIT("ACTION")="d",QAUDIT("COMMENT")="Delete a brief patient record" D ^QAQAUDIT
K QANPAT(QANTEMP),QANPNUM(QANTEMP),QANPNAM(QANTEMP)
;if there are no patients on the report set a flag and go back to PTADD
I $O(^QA(742,"BCS",QANIEN,0))']"" W !!,"You must have at least one patient on an incident report." S QANNOPAT=1 G PTADD
G PTDEL
Q
EXIT ;
K QAN0,QANADMDT,QANCC,QANCNT,QANDATE,QANDFN,QANDOB,QANEE
K QANEDFLG,QANELFG,QANFLAG,QANIEN,QANINC,QANAME,QANNAME,QANNOPAT
K QANNUM,QANPAT,QANPID,QANPIEN,QANPNAM,QANPNUM,QANPSDO,QANTEMP
K QANTOT,QANTRSP,QANXFLG,QANXIT,QANY,QANZERO
Q
DIKAUDIT(QANFIL) ;
;deletes the entries for this Incident Report from
;the QA Audit file. Input is the QA file (742 for the patient,
;742.4 for the incident).
;
S QANID=$S(QANFIL=742:QANDFN,1:QANIEN)
S QANEE=$O(^QA(740.5,"B",QANFIL," "),-1)+1
F S QANEE=$O(^QA(740.5,"B",QANFIL,QANEE),-1) Q:QANEE'>0 I $P(^QA(740.5,QANEE,0),U,2)=QANID S QANAUD=QANID Q
I $G(QANAUD)]"" D
. S DIK="^QA(740.5,",DA=QANEE
. D ^DIK K DIK
. K QANID,QANAUD,QANEE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQANEDIT 6982 printed Jun 11, 2024@21:45:42 Page 2
QANEDIT ;WCIOFO/ERC-Edit a Brief Incident ;4/22/99
+1 ;;2.0;Incident Reporting;**27,26,32**;08/07/1992;Build 3
+2 ;
START ;
+1 WRITE @IOF
+2 NEW QANBFLG,QANIEN,QANNOPAT
+3 FOR
WRITE !!,"Do you want to edit one of your open Incident Reports"
SET %=1
DO YN^DICN
if "-112"[%
QUIT
WRITE !!,"Enter (Y)es, (N)o or ""^"" to exit"
+4 IF %=1
DO EDIT
+5 KILL QANXIT
+6 QUIT
EDIT ;
+1 KILL ^TMP("QAN EDIT")
+2 SET QANCNT=1
+3 SET QANDUZ=DUZ
+4 SET QANEE=0
+5 FOR
SET QANEE=$ORDER(^QA(742.4,"ACS",1,QANEE))
if QANEE'>0
QUIT
Begin DoDot:1
+6 IF QANDUZ=$PIECE(^QA(742.4,QANEE,0),U,5)
SET ^TMP("QAN EDIT",$JOB,QANCNT,QANEE)=""
SET QANCNT=QANCNT+1
End DoDot:1
+7 WRITE @IOF
+8 IF '$DATA(^TMP("QAN EDIT"))
Begin DoDot:1
+9 WRITE !!,"**** You have no open Incident Reports to edit. Exiting.",!!
End DoDot:1
QUIT
+10 WRITE !!,"Here are your open Incident Reports."
+11 SET QANEE=0
+12 SET QANTOT=0
+13 FOR
SET QANEE=$ORDER(^TMP("QAN EDIT",$JOB,QANEE))
if QANEE'>0
QUIT
Begin DoDot:1
+14 SET QANIEN=$ORDER(^TMP("QAN EDIT",$JOB,QANEE,0))
if QANIEN'>0
QUIT
+15 SET QAN0=^QA(742.4,QANIEN,0)
+16 SET QANCC=0
SET QANCNT=1
+17 ;gets number of IRs for selecting record to edit
SET QANTOT=QANTOT+1
+18 FOR
SET QANCC=$ORDER(^QA(742,"BCS",QANIEN,QANCC))
if QANCC'>0
QUIT
Begin DoDot:2
+19 SET QANNAME=$PIECE(^DPT($PIECE(^QA(742,QANCC,0),U),0),U)
+20 SET Y=$PIECE(QAN0,U,3)
DO DD^%DT
SET QANDATE=Y
+21 SET QANINC=$PIECE(^QA(742.1,$PIECE(QAN0,U,2),0),U)
+22 IF $Y>(IOSL-6)
KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
WRITE @IOF
+23 IF QANCNT=1
WRITE !,QANEE,?4,QANDATE,?25,$EXTRACT(QANINC,1,25),?51,QANNAME
+24 IF QANCNT>1
WRITE !?51,QANNAME
+25 SET QANCNT=QANCNT+1
End DoDot:2
End DoDot:1
DIR ;
+1 IF $GET(QANTOT)=1
SET QANIEN=$ORDER(^TMP("QAN EDIT",$JOB,1,0))
GOTO DIE
+2 KILL DIR
+3 SET DIR(0)="NOA"
+4 SET DIR("A")="Select a number from 1 to "_QANTOT_": "
+5 DO ^DIR
KILL DIR
if $DATA(DIRUT)!(+Y<1)
QUIT
+6 IF +Y>QANTOT
WRITE !,"Number selected must be from 1 to "_QANTOT_", try again."
GOTO DIR
+7 SET QANIEN=$ORDER(^TMP("QAN EDIT",$JOB,+Y,0))
+8 IF $GET(QANIEN)]""
IF ($DATA(^QA(742.4,QANIEN,0)))
Begin DoDot:1
+9 LOCK +^QA(742.4,QANIEN):5
IF '$TEST
WRITE !!,"Another user is editing this record."
QUIT
+10 SET QANEDFLG=1
+11 DO DIE
+12 IF $ORDER(^QA(742,"BCS",QANIEN,0))']""
Begin DoDot:2
+13 ;if no patients entered, delete the incident
+14 WRITE !!,"No patients on this Incident Report - deleting Report."
+15 SET DIK="^QA(742.4,"
SET DA=QANIEN
DO ^DIK
KILL DIK
End DoDot:2
+16 DO EXIT
End DoDot:1
+17 QUIT
DIE ;
+1 WRITE !!
+2 NEW QANCNT,QANEE
+3 SET QANEFLG=0
+4 SET QANEE=0
+5 SET QANCNT=1
+6 FOR
SET QANEE=$ORDER(^QA(742,"BCS",QANIEN,QANEE))
if QANEE'>0
QUIT
Begin DoDot:1
+7 SET QANPAT(QANCNT)=QANEE
+8 SET QANCNT=QANCNT+1
End DoDot:1
+9 KILL DIE
SET DIE="^QA(742.4,"
SET DA=QANIEN
SET DR=".02;.03;.04"
+10 DO ^DIE
KILL DIE
+11 LOCK -^QA(742.4,QANIEN)
PAT ;edit patient(s) on report
+1 ;if no patients entered go directly to PTADD
+2 IF $ORDER(^QA(742,"BCS",QANIEN,0))']""
GOTO PTADD
+3 KILL QANPNAM,QANPNUM
+4 WRITE !,"Patient(s) on this Incident Report."
+5 SET QANEE=0
+6 SET QANCNT=1
+7 FOR
SET QANEE=$ORDER(QANPAT(QANEE))
if QANEE'>0
QUIT
Begin DoDot:1
+8 SET QANPNUM(QANEE)=$PIECE(^QA(742,QANPAT(QANEE),0),U)
+9 SET QANPNAM(QANEE)=$PIECE(^DPT(QANPNUM(QANEE),0),U)
+10 WRITE !?5,QANCNT," ",QANPNAM(QANEE)
+11 SET QANCNT=QANCNT+1
End DoDot:1
+12 SET DIR("A")="Is this correct"
+13 SET DIR("B")="YES"
+14 SET DIR(0)="Y"
+15 DO ^DIR
KILL DIR
if $DATA(DIRUT)
QUIT
+16 IF Y<1
Begin DoDot:1
+17 SET DIR(0)="Y"
SET DIR("A")="Would you like to add a patient"
+18 SET DIR("B")="YES"
+19 KILL DIRUT
+20 DO ^DIR
KILL DIR
if $DATA(DIRUT)
QUIT
+21 IF Y=1
DO PTADD
SET (QANEFLG,QANEDFLG)=1
QUIT
+22 ;deleting patients from record only allowed if editing a new record
+23 IF $GET(QANBFLG)'=1
QUIT
+24 KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Would you like to delete a patient"
+25 SET DIR("B")="NO"
+26 KILL DIRUT
+27 DO ^DIR
KILL DIR
if $DATA(DIRUT)
QUIT
+28 IF Y=1
DO PTDEL
SET (QANEFLG,QANEDFLG)=1
End DoDot:1
+29 ;if the user has deleted all patients and has not re-entered one,
+30 ;exit the subroutine (a message will be displayed & the record deleted)
+31 IF $GET(QANNOPAT)=1
KILL QANNOPAT
QUIT
+32 IF $GET(QANEFLG)=1
SET QANEFLG=0
GOTO PAT
+33 ;if no patients on report skip description and witnessed and quit
+34 IF $ORDER(^QA(742,"BCS",QANIEN,0))']""
QUIT
+35 KILL DIE
SET DIE="^QA(742.4,"
SET DR=".05;.08"
+36 DO ^DIE
KILL DIE
+37 QUIT
PTADD ;
+1 KILL DIC
SET DIC="^DPT("
SET DIC(0)="QEAMNZ"
SET DIC("A")="Select Patient: "
SET DIC("W")="W "" "",$P(^(0),U,9)"
SET D="B^BS5"
+2 DO MIX^DIC1
KILL DIC
+3 IF +Y<1
SET QANXIT=1
QUIT
+4 FOR
Begin DoDot:1
+5 WRITE !?5,$GET(Y(0,0))_" OK"
+6 SET %=1
DO YN^DICN
if "-12"[%
QUIT
+7 WRITE " Confirm that this is the correct patient."
End DoDot:1
if "-12"[%
QUIT
+8 IF %=-1
SET QANXIT=1
QUIT
+9 IF %=2
WRITE " ??"
GOTO PTADD
+10 SET QANEE=0
+11 FOR
SET QANEE=$ORDER(QANPNUM(QANEE))
if QANEE'>0
QUIT
Begin DoDot:1
+12 IF +Y=QANPNUM(QANEE)
WRITE !!,$CHAR(7),$PIECE(^DPT(+Y,0),U)_" has been previously entered for this incident."
KILL Y
SET QANXFLG=1
QUIT
End DoDot:1
+13 IF $GET(QANXFLG)=1
SET QANXFLG=0
GOTO PTADD
+14 IF $DATA(^DPT(+Y,.35))
IF $PIECE(^DPT(+Y,.35),U)]""
IF ($PIECE(^DPT(+Y,.35),U)<$PIECE(^QA(742.4,QANIEN,0),U,3))
WRITE !!,$CHAR(7),"The date of death for patient: "_$PIECE(^DPT(+Y,0),U)_" precedes the incident date."
KILL Y
GOTO PTADD
+15 SET QANPIEN=+Y
SET QANZERO=Y(0)
SET QANAME=Y(0,0)
SET QANSSN=$PIECE(QANZERO,U,9)
SET ^UTILITY($JOB,"QAN PAT",+Y)=""
+16 SET QANDOB=$PIECE(^DPT(QANPIEN,0),U,3)
+17 IF QANDOB]""
SET X=DT
SET X1=X
SET X2=QANDOB
SET X=""
if X2
DO ^%DTC
SET X=X\365.25
SET QANAGE=X
+18 SET QANPSDO(0)=Y(0)
SET QANPSDO(0,0)=Y(0,0)
+19 SET QANPID=$$QANPID^QANCDNT(.Y)
+20 DO ADMDT^QANUTL1
+21 KILL DIC,DD,DO,DINUM,DLAYGO
SET DLAYGO=742
SET DIC="^QA(742,"
SET DIC(0)="L"
SET X=QANPIEN
DO FILE^DICN
KILL DIC,DD,DO,DINUM,DLAYGO
+22 IF +Y=-1
IF ($GET(QANFLAG))
SET QANXIT=1
QUIT
+23 SET QANDFN=+Y
+24 SET $PIECE(^QA(742,QANDFN,0),U,2,6)=QANPID_U_QANIEN_U_QANADMDT_U_QANINPAT_U_QANWARD
+25 SET $PIECE(^QA(742,QANDFN,0),U,7)=QANTRSP
SET $PIECE(^QA(742,QANDFN,0),U,12)=1
+26 SET DIK="^QA(742,"
SET DA=QANDFN
DO IX1^DIK
KILL DA,DIK
+27 SET QANNUM=$ORDER(QANPAT(" "),-1)+1
+28 SET QANPAT(QANNUM)=QANDFN
+29 SET QANPNUM(QANNUM)=QANPIEN
+30 SET QANPNAM(QANNUM)=QANAME
+31 SET QANFLAG=1
if '$DATA(QANF)
DO BULL^QANUTL3
+32 KILL QAUDIT
SET QAUDIT("FILE")="742^50"
SET QAUDIT("DA")=QANDFN
SET QAUDIT("ACTION")="e"
SET QAUDIT("COMMENT")="Edit a brief patient record"
DO ^QAQAUDIT
+33 QUIT
PTDEL ;
+1 SET QANCC=0
+2 FOR
SET QANCC=$ORDER(QANPNUM(QANCC))
if QANCC'>0
QUIT
Begin DoDot:1
+3 SET QANNUM=QANCC
+4 WRITE !?5,QANCC_" "_QANPNAM(QANCC)
End DoDot:1
+5 IF '$GET(QANNUM)
SET QANXIT=1
QUIT
+6 SET DIR(0)="NOA"
+7 SET DIR("A")="Delete which patient number: "
+8 DO ^DIR
KILL DIR
if $DATA(DIRUT)
QUIT
+9 IF $GET(QANPNAM(+Y))']""
WRITE !!?5,"Choice must be one of the displayed numbers."
GOTO PTDEL
+10 IF Y>QANNUM
WRITE !!?5,"Answer must be a number less than ",QANNUM+1
GOTO PTDEL
+11 IF Y<1
SET QANXIT=1
QUIT
+12 SET QANTEMP=+Y
+13 SET QANDFN=QANPAT(+Y)
+14 SET QANAME=QANPNAM(+Y)
+15 SET DIK="^QA(742,"
SET DA=QANPAT(+Y)
DO ^DIK
+16 ;D BULL^QANUTL3
+17 ;K QAUDIT S QAUDIT("FILE")="742^50",QAUDIT("DA")=QANDFN,QAUDIT("ACTION")="d",QAUDIT("COMMENT")="Delete a brief patient record" D ^QAQAUDIT
+18 KILL QANPAT(QANTEMP),QANPNUM(QANTEMP),QANPNAM(QANTEMP)
+19 ;if there are no patients on the report set a flag and go back to PTADD
+20 IF $ORDER(^QA(742,"BCS",QANIEN,0))']""
WRITE !!,"You must have at least one patient on an incident report."
SET QANNOPAT=1
GOTO PTADD
+21 GOTO PTDEL
+22 QUIT
EXIT ;
+1 KILL QAN0,QANADMDT,QANCC,QANCNT,QANDATE,QANDFN,QANDOB,QANEE
+2 KILL QANEDFLG,QANELFG,QANFLAG,QANIEN,QANINC,QANAME,QANNAME,QANNOPAT
+3 KILL QANNUM,QANPAT,QANPID,QANPIEN,QANPNAM,QANPNUM,QANPSDO,QANTEMP
+4 KILL QANTOT,QANTRSP,QANXFLG,QANXIT,QANY,QANZERO
+5 QUIT
DIKAUDIT(QANFIL) ;
+1 ;deletes the entries for this Incident Report from
+2 ;the QA Audit file. Input is the QA file (742 for the patient,
+3 ;742.4 for the incident).
+4 ;
+5 SET QANID=$SELECT(QANFIL=742:QANDFN,1:QANIEN)
+6 SET QANEE=$ORDER(^QA(740.5,"B",QANFIL," "),-1)+1
+7 FOR
SET QANEE=$ORDER(^QA(740.5,"B",QANFIL,QANEE),-1)
if QANEE'>0
QUIT
IF $PIECE(^QA(740.5,QANEE,0),U,2)=QANID
SET QANAUD=QANID
QUIT
+8 IF $GET(QANAUD)]""
Begin DoDot:1
+9 SET DIK="^QA(740.5,"
SET DA=QANEE
+10 DO ^DIK
KILL DIK
+11 KILL QANID,QANAUD,QANEE
End DoDot:1
+12 QUIT
