QANAUX1 ;;HISC/GJC-UTILITIES FOR INCIDENT REPORTING ;4/26/91
;;2.0;Incident Reporting;**26**;08/07/1992
;
EN0 ;Mark a incident record for deletion, also the associated patient(s).
W !!,$C(7),"This option will allow the user to open, close, or delete a record at the local level.",!,"The appropriate patient(s) records are marked to reflect the change."
K DIC,DINUM,DLAYGO S DIC=742.4,DIC(0)="QEAMZ",DIC("A")="Select Incident: "
D ^DIC K DIC,DINUM,DLAYGO Q:+Y=-1
S QANIEN=+Y K DIE,DR S DIE="^QA(742.4,",DA=QANIEN,DR=".09" D ^DIE K DIE,DR,DA S QAN0=$G(^QA(742.4,QANIEN,0))
I $D(Y)!(QAN0="") W !!,$C(7),"No action taken, premature exit action encountered." G KILL
S QANMSS(0)="W !!,$C(7),""Appropriate Patient(s) records now being marked as deleted!"""
S QANMSS(1)="W !!,$C(7),""Appropriate Patient(s) records now being marked as closed!"""
S QANMSS(2)="W !!,$C(7),""Appropriate Patient(s) records now being marked as open!"""
X $S(+$P(QAN0,U,8)=2:QANMSS(0),+$P(QAN0,U,8)=0:QANMSS(1),1:QANMSS(2))
K DIE,DR S DIE="^QA(742,",DR=$S(+$P(QAN0,U,8)=2:".13///^S X=""-1""",+$P(QAN0,U,8)=0:".13///^S X=""0""",1:".13///^S X=""1""")
F QAN=0:0 S QAN=$O(^QA(742,"BCS",QANIEN,QAN)) Q:QAN'>0 S DA=QAN D ^DIE
KILL K QANIEN,QAN0,QAN,DA,DIE,DR,QANMSS,Y
Q
EN1 ;Choose the MAILGROUP.
L +^QA(740,1,0):5 I '$T W !!?16,$C(7),"Another person is editing this entry." Q
K DA,DIE,DR S DIE="^QA(740,",DA=1,DR="[QAQA QAN SITE PARAMETERS]" D ^DIE
L -^QA(740,1,0)
K %X,%Y,D,D0,DA,DI,DIC,DIE,DQ,DR
Q
EN2 ;INCIDENT STATUS ENTER/EDIT
S (DIC,DIE)="^QA(742.1,",DIC("A")="Select Incident Type: ",DIC(0)="QEALMNZ",D="B^BUPPER",DIC("S")="I $P(^(0),U,6)'=""N"""
D MIX^DIC1 K DIC,DINUM,DLAYGO Q:+Y=-1
S QANQAN=+Y,DA=QANQAN
I $P(Y,U,3)=1 S DR=".07///"_"L" D ^DIE
L +^QA(742.1,QANQAN,0):5 I '$T W !!?16,$C(7),"Another person is editing this entry." Q
S DR=".01 INCIDENT" D ^DIE
I $D(Y) L -^QA(742.1,QANQAN,0) Q
S QAN0=$G(^QA(742.1,QANQAN,0))
S DA=QANQAN,DR=".02;.04;.06" D ^DIE ;remove .03 and .05 from DR in QAN26
K DIR S DIR(0)="SA^1:INACTIVE;L:LOCAL",DIR("A")="Incident Status: "
S DIR("?")="Enter ""1"" for Inactive, ""L"" for Local."
S DIR("B")=$S($P(QAN0,U,6)="L":"LOCAL",1:"INACTIVE") D ^DIR K DIR
I $D(DTOUT)!($D(DUOUT))!($D(DIROUT)) L -^QA(742.1,QANQAN,0) Q
S DR=$S(Y=1:".07///1",1:".07///L") D ^DIE
L -^QA(742.1,QANQAN,0)
Q
EN3 ;Choose X again.
W !!?5,$C(7),"Number """_X_""" previously chosen, try again"
K X
Q
HDR ;Header generator.
S PAGE=PAGE+1 W @IOF,!,?$S(IOM=132:114,1:69),TODAY,!,?$S(IOM=132:114,1:69),"Page: ",PAGE,!!
W ?(IOM-$L(QANHEAD(0))\2),QANHEAD(0)
I $D(QANCHOS),QANCHOS="I" W !,?(IOM-$L(QANHEAD(1))\2),QANHEAD(1)
I '$D(QANCHOS) W !,?(IOM-$L(QANHEAD(1))\2),QANHEAD(1)
I $D(QANCHOS),QANCHOS="W" W !,?(IOM-$L(QANHEAD(2))\2),QANHEAD(2)
W !,?(IOM-$L(QANHEAD(3))\2),QANHEAD(3),!
I $G(QANDVFLG)=1 W !,?(IOM-$L(QANHEAD(4))\2),QANHEAD(4),!
F LOOP=1:1:2 W BNDRY,!
W:$D(QANCHOS) !,$S(QANCHOS="I":"INCIDENT LOCATION",1:"PATIENT'S WARD"),?35,"INCIDENT",?70,"NUMBER",!,"------------------",?35,"--------",?70,"------",!
W:'$D(QANCHOS) !?17,"INCIDENT",?57,"NUMBER",!?17,"--------",?57,"------"
Q
WARN ;Deleting a patient's record.
W !?5,"Patient: ",$P(^DPT($P(^QA(742,QANPAT,0),U),0),U)_"// "
WARN1 F QAN=0:0 R QANST:DTIME S:'$T QANST="^" Q:QANST?1"@"!(QANST']"")!(QANST["^") W !!?5,$C(7),"Enter ""@"" to delete a record, <CR> to keep the patient active.",!!?5,"Patient: ",$P(^DPT($P(^QA(742,QANPAT,0),U),0),U)_"// "
Q:QANST["^"!(QANST']"")
WARN2 ;Checks for associated incident deletion
S QANYN=0
I QANST["@" W !!,$C(7),"Are you sure you want to delete?",!,"Deletion marks the associated incident as deleted."
I K DIR S DIR(0)="Y" D ^DIR S QANYN=+Y
I QANYN K DA,DIE,DR S DIE="^QA(742,",DA=QANPAT,DR=".13///^S X=""-1""" D ^DIE K DA,DIE,DR S DIE="^QA(742.4,",DA=QANINCD,DR=".09///^S X=""2""" D ^DIE K DA,DIE,DR
I QANYN D AUDIT
;CODE TO DELETE A PATIENT AND DELETE AN INCIDENT
Q
AUDIT ;Enter entries in the QA Audit file.
K QAUDIT S QAUDIT("FILE")="742^50",QAUDIT("DA")=QANPAT,QAUDIT("ACTION")="d",QAUDIT("COMMENT")="Delete a patient record" D ^QAQAUDIT
K QAUDIT S QAUDIT("FILE")="742.4^50",QAUDIT("DA")=QANINCD,QAUDIT("ACTION")="d",QAUDIT("COMMENT")="Delete an incident record" D ^QAQAUDIT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQANAUX1 4293 printed Dec 13, 2024@01:59:30 Page 2
QANAUX1 ;;HISC/GJC-UTILITIES FOR INCIDENT REPORTING ;4/26/91
+1 ;;2.0;Incident Reporting;**26**;08/07/1992
+2 ;
EN0 ;Mark a incident record for deletion, also the associated patient(s).
+1 WRITE !!,$CHAR(7),"This option will allow the user to open, close, or delete a record at the local level.",!,"The appropriate patient(s) records are marked to reflect the change."
+2 KILL DIC,DINUM,DLAYGO
SET DIC=742.4
SET DIC(0)="QEAMZ"
SET DIC("A")="Select Incident: "
+3 DO ^DIC
KILL DIC,DINUM,DLAYGO
if +Y=-1
QUIT
+4 SET QANIEN=+Y
KILL DIE,DR
SET DIE="^QA(742.4,"
SET DA=QANIEN
SET DR=".09"
DO ^DIE
KILL DIE,DR,DA
SET QAN0=$GET(^QA(742.4,QANIEN,0))
+5 IF $DATA(Y)!(QAN0="")
WRITE !!,$CHAR(7),"No action taken, premature exit action encountered."
GOTO KILL
+6 SET QANMSS(0)="W !!,$C(7),""Appropriate Patient(s) records now being marked as deleted!"""
+7 SET QANMSS(1)="W !!,$C(7),""Appropriate Patient(s) records now being marked as closed!"""
+8 SET QANMSS(2)="W !!,$C(7),""Appropriate Patient(s) records now being marked as open!"""
+9 XECUTE $SELECT(+$PIECE(QAN0,U,8)=2:QANMSS(0),+$PIECE(QAN0,U,8)=0:QANMSS(1),1:QANMSS(2))
+10 KILL DIE,DR
SET DIE="^QA(742,"
SET DR=$SELECT(+$PIECE(QAN0,U,8)=2:".13///^S X=""-1""",+$PIECE(QAN0,U,8)=0:".13///^S X=""0""",1:".13///^S X=""1""")
+11 FOR QAN=0:0
SET QAN=$ORDER(^QA(742,"BCS",QANIEN,QAN))
if QAN'>0
QUIT
SET DA=QAN
DO ^DIE
KILL KILL QANIEN,QAN0,QAN,DA,DIE,DR,QANMSS,Y
+1 QUIT
EN1 ;Choose the MAILGROUP.
+1 LOCK +^QA(740,1,0):5
IF '$TEST
WRITE !!?16,$CHAR(7),"Another person is editing this entry."
QUIT
+2 KILL DA,DIE,DR
SET DIE="^QA(740,"
SET DA=1
SET DR="[QAQA QAN SITE PARAMETERS]"
DO ^DIE
+3 LOCK -^QA(740,1,0)
+4 KILL %X,%Y,D,D0,DA,DI,DIC,DIE,DQ,DR
+5 QUIT
EN2 ;INCIDENT STATUS ENTER/EDIT
+1 SET (DIC,DIE)="^QA(742.1,"
SET DIC("A")="Select Incident Type: "
SET DIC(0)="QEALMNZ"
SET D="B^BUPPER"
SET DIC("S")="I $P(^(0),U,6)'=""N"""
+2 DO MIX^DIC1
KILL DIC,DINUM,DLAYGO
if +Y=-1
QUIT
+3 SET QANQAN=+Y
SET DA=QANQAN
+4 IF $PIECE(Y,U,3)=1
SET DR=".07///"_"L"
DO ^DIE
+5 LOCK +^QA(742.1,QANQAN,0):5
IF '$TEST
WRITE !!?16,$CHAR(7),"Another person is editing this entry."
QUIT
+6 SET DR=".01 INCIDENT"
DO ^DIE
+7 IF $DATA(Y)
LOCK -^QA(742.1,QANQAN,0)
QUIT
+8 SET QAN0=$GET(^QA(742.1,QANQAN,0))
+9 ;remove .03 and .05 from DR in QAN26
SET DA=QANQAN
SET DR=".02;.04;.06"
DO ^DIE
+10 KILL DIR
SET DIR(0)="SA^1:INACTIVE;L:LOCAL"
SET DIR("A")="Incident Status: "
+11 SET DIR("?")="Enter ""1"" for Inactive, ""L"" for Local."
+12 SET DIR("B")=$SELECT($PIECE(QAN0,U,6)="L":"LOCAL",1:"INACTIVE")
DO ^DIR
KILL DIR
+13 IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIROUT))
LOCK -^QA(742.1,QANQAN,0)
QUIT
+14 SET DR=$SELECT(Y=1:".07///1",1:".07///L")
DO ^DIE
+15 LOCK -^QA(742.1,QANQAN,0)
+16 QUIT
EN3 ;Choose X again.
+1 WRITE !!?5,$CHAR(7),"Number """_X_""" previously chosen, try again"
+2 KILL X
+3 QUIT
HDR ;Header generator.
+1 SET PAGE=PAGE+1
WRITE @IOF,!,?$SELECT(IOM=132:114,1:69),TODAY,!,?$SELECT(IOM=132:114,1:69),"Page: ",PAGE,!!
+2 WRITE ?(IOM-$LENGTH(QANHEAD(0))\2),QANHEAD(0)
+3 IF $DATA(QANCHOS)
IF QANCHOS="I"
WRITE !,?(IOM-$LENGTH(QANHEAD(1))\2),QANHEAD(1)
+4 IF '$DATA(QANCHOS)
WRITE !,?(IOM-$LENGTH(QANHEAD(1))\2),QANHEAD(1)
+5 IF $DATA(QANCHOS)
IF QANCHOS="W"
WRITE !,?(IOM-$LENGTH(QANHEAD(2))\2),QANHEAD(2)
+6 WRITE !,?(IOM-$LENGTH(QANHEAD(3))\2),QANHEAD(3),!
+7 IF $GET(QANDVFLG)=1
WRITE !,?(IOM-$LENGTH(QANHEAD(4))\2),QANHEAD(4),!
+8 FOR LOOP=1:1:2
WRITE BNDRY,!
+9 if $DATA(QANCHOS)
WRITE !,$SELECT(QANCHOS="I":"INCIDENT LOCATION",1:"PATIENT'S WARD"),?35,"INCIDENT",?70,"NUMBER",!,"------------------",?35,"--------",?70,"------",!
+10 if '$DATA(QANCHOS)
WRITE !?17,"INCIDENT",?57,"NUMBER",!?17,"--------",?57,"------"
+11 QUIT
WARN ;Deleting a patient's record.
+1 WRITE !?5,"Patient: ",$PIECE(^DPT($PIECE(^QA(742,QANPAT,0),U),0),U)_"// "
WARN1 FOR QAN=0:0
READ QANST:DTIME
if '$TEST
SET QANST="^"
if QANST?1"@"!(QANST']"")!(QANST["^")
QUIT
WRITE !!?5,$CHAR(7),"Enter ""@"" to delete a record, <CR> to keep the patient active.",!!?5,"Patient: ",$PIECE(^DPT($PIECE(^QA(742,QANPAT,0),U),0),U)_"// "
+1 if QANST["^"!(QANST']"")
QUIT
WARN2 ;Checks for associated incident deletion
+1 SET QANYN=0
+2 IF QANST["@"
WRITE !!,$CHAR(7),"Are you sure you want to delete?",!,"Deletion marks the associated incident as deleted."
+3 IF $TEST
KILL DIR
SET DIR(0)="Y"
DO ^DIR
SET QANYN=+Y
+4 IF QANYN
KILL DA,DIE,DR
SET DIE="^QA(742,"
SET DA=QANPAT
SET DR=".13///^S X=""-1"""
DO ^DIE
KILL DA,DIE,DR
SET DIE="^QA(742.4,"
SET DA=QANINCD
SET DR=".09///^S X=""2"""
DO ^DIE
KILL DA,DIE,DR
+5 IF QANYN
DO AUDIT
+6 ;CODE TO DELETE A PATIENT AND DELETE AN INCIDENT
+7 QUIT
AUDIT ;Enter entries in the QA Audit file.
+1 KILL QAUDIT
SET QAUDIT("FILE")="742^50"
SET QAUDIT("DA")=QANPAT
SET QAUDIT("ACTION")="d"
SET QAUDIT("COMMENT")="Delete a patient record"
DO ^QAQAUDIT
+2 KILL QAUDIT
SET QAUDIT("FILE")="742.4^50"
SET QAUDIT("DA")=QANINCD
SET QAUDIT("ACTION")="d"
SET QAUDIT("COMMENT")="Delete an incident record"
DO ^QAQAUDIT
+3 QUIT
