QANVAL ;;HISC/GJC-Utilities for Incident Reporting ;4/26/91
;;2.0;Incident Reporting;**1,27**;08/07/1992
;
EN1 ;
N QANBFLG,QANFFLG
S (QANFLAG(0),QANOUT,QANXIT,QANAGN)=0,(QAN(0),QANBFLG,QANFFLG)=0
W @IOF S QANIEN="" F QAN=0:0 S QANIEN=$O(^QA(742.4,"ACS",QANIEN)) Q:QANIEN="" I "02"'[+QANIEN F QAN=0:0 S QAN=$O(^QA(742.4,"ACS",QANIEN,QAN)) Q:QAN'>0 S QAN(0)=QAN(0)+1
I QAN(0)>0 W !!?12,$C(7),"There exist "_QAN(0)_" open INCIDENT CASE(S) on the system.",!!
E W !!?12,"There exists ZERO open INCIDENT CASE(S) on the system." K QAN,QANIEN
I 'QANAGN F W !!,"Do you wish to create a new incident event record" S %=2 D YN^DICN Q:"-112"[% W !,$C(7),"Enter (Y)es, or (N)o, or ""^"" to quit."
I 'QANAGN,%=-1 K QAN,QANIEN Q
I 'QANAGN,%=1 S (QANFLAG(0),QANFFLG)=1,QANF="" D ^QANCDNT Q:QANXIT
D:'QANFLAG(0) EDIT I QANXIT D CLEAN Q
D:$D(QANDFN)&$D(QANIEN) EN2^QANUTL2
F W !!,"Do you wish to edit a particular open incident" S %=2 D YN^DICN Q:"-112"[% W !!,"Enter (Y)es, (N)o, or ""^"" to exit"
I %=1 S QANAGN=1 G EN1
D CLEAN Q
CASE ;
K DIC S DIC=742.4,DIC(0)="QEANZ",DIC("A")="Select Case Number: ",DIC("S")="I ""13""[+$P(^(0),U,8)",DIC("W")="D EN1^QANUTL" D ^DIC K DIC
I +Y=-1 S QANXIT=1 W !!,$C(7),"Case Number not selected, exiting!!"
E S QANIEN=+Y
Q
DATE ;
K DIC,D S DIC="^QA(742.4,",DIC(0)="QEAMZ",DIC("A")="Select Date of Incident: ",D="BDT",DIC("S")="I ""13""[+$P(^(0),U,8)",DIC("W")="D EN1^QANUTL" D IX^DIC K DIC,D
I +Y=-1 S QANXIT=1 W !!,$C(7),"Date of Incident not selected, exiting!!"
E S QANIEN=+Y
Q
EDIT K DIR S DIR("A",1)="Would you like to: ",DIR("A",2)="1. Edit by the Case Number",DIR("A",3)="2. Edit by the Date of the Incident",DIR("A",4)="3. Edit by the Patient",DIR("A",5)="4. Edit by the Type of Incident"
S DIR("A")="Enter a number: (1-4) ",DIR(0)="NOA^1:4:0",DIR("B")=3,DIR("?",1)="Choose the manner in which you wish to edit the record.",DIR("?")="Enter a number no less than 1, no greater than 4."
D ^DIR K DIR
I $D(DTOUT)!($D(DUOUT))!($D(DIROUT)) S QANXIT=1 Q
S QANTYPE=+Y
D @$S(QANTYPE=1:"CASE",QANTYPE=2:"DATE",QANTYPE=3:"PAT^QANUTL1",1:"TYPE")
Q:$G(QANXIT)
I $G(QANBFLG)'=1 L +^QA(742.4,QANIEN):5 I '$T W !!?16,$C(7),"Another person is editing this Incident Report." S QANXIT=1
Q:QANXIT D:$G(QANTYPE)'=3 PAT0^QANUTL1
Q
TYPE ;
K DIC,D S DIC="^QA(742.4,",DIC(0)="QEAMZ",DIC("A")="Select Type of Incident: ",DIC("S")="I ""13""[+$P(^(0),U,8)",D="BINC",DIC("W")="D EN1^QANUTL" D IX^DIC K DIC,D
I +Y=-1 S QANXIT=1 W !!,$C(7),"Type of Incident not selected, exiting!!"
E S QANIEN=+Y
Q
PATMAN ;DELETING A PATIENT'S RECORD
;***********************************************************************
;*** NOTE: Execution of this subroutine deletes the "ACN" x-ref from ***
;*** the global ^QA(742.4! ***
;***********************************************************************
K DIC S (DIC,DIE)="^QA(742,",DIC(0)="QEAMZ",DIC("A")="Select Patient: "
S DIC("S")="I $D(^QA(742,""BPRS"",1,+Y))"
S DIC("W")="D DICW^QANUTL1",QANXX=1,D="B^BS5"
D MIX^DIC1 K DIC S QANPAT=+Y
I QANPAT'>0 G K9
S QANINCD=+$O(^QA(742.4,"ACN",QANPAT,"")) G:QANINCD'>0 K9
I $O(^QA(742,"BCS",QANINCD,""))=QANPAT,$O(^QA(742,"BCS",QANINCD,QANPAT))']"" D WARN^QANAUX1 G K9
S DIE="^QA(742,",DR=".13R",DA=QANPAT D ^DIE S QANPTST=+$P(^QA(742,QANPAT,0),U,12)
K QAUDIT S QAUDIT("FILE")="742^50",QAUDIT("DA")=QANPAT,QAUDIT("ACTION")=$S(QANPTST=1:"o",QANPTST=-1:"d",1:"c"),QAUDIT("COMMENT")=$S(QANPTST=1:"Open ",QANPTST=-1:"Delete ",1:"Close ")_"a patient record" D ^QAQAUDIT
K9 K %W,%X,%Y,C,D0,DA,DIE,DISYS,DR,QAN,QANINCD,QANPAT,QANSSN,QANST,QANXX,X
K QANPTST,QAUDIT,Y
Q
CLEAN ;Kill and quit.
K C,D,DIC,D0,DA,MSSG0,MSSG1,MSSG2,QAN,QANADM,QANADMDT,QANAFRM,QANAME
K QANCHK,QANCODE,QANDFN,QANDGPM,QANDT,QANDUZ,QANF,QANFLAG,QANHOME
K QANINC,QANIEN,QANINCR,QANINPAT,QANINV,QANMAIL,QANMIEN,QANOUT,QANPLC
K X,X1,X2,QANPID,QANPIEN,QANSITE,QANSSN,QANST,QANST1,QANTRSP,QANWARD
K QANXIT,QANZERO,QANPAT,QANTYPE,QANX,QANZER0,QANTTL,QANSERV,QANPSDO
K QANDOB,QANHOLD,^UTILITY($J),QANDOB,QANAGE,QANQAN,QANAGN,QANYN,POP
K QANEOP,QANHEAD,QANINS,QANLINE,QANRSP0,QANRSP1,QANSTAT,QANPAGE,QANCS
K QANDED,VAIN,VAERR,QANIRIN,QANLCTN,QANGLB0,QAUDIT,DTOUT,DUOUT,DIROUT
K %,%T,%W,%X,%Y,DI,DIR,DQ,J,QANIC,QANPT,QANYN,QANPT0,Y,DIRUT,%DT,DIE,DR
K QANPRS,QAHDNM,QAHDSSN,QAHOLD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQANVAL 4396 printed Oct 16, 2024@18:01:03 Page 2
QANVAL ;;HISC/GJC-Utilities for Incident Reporting ;4/26/91
+1 ;;2.0;Incident Reporting;**1,27**;08/07/1992
+2 ;
EN1 ;
+1 NEW QANBFLG,QANFFLG
+2 SET (QANFLAG(0),QANOUT,QANXIT,QANAGN)=0
SET (QAN(0),QANBFLG,QANFFLG)=0
+3 WRITE @IOF
SET QANIEN=""
FOR QAN=0:0
SET QANIEN=$ORDER(^QA(742.4,"ACS",QANIEN))
if QANIEN=""
QUIT
IF "02"'[+QANIEN
FOR QAN=0:0
SET QAN=$ORDER(^QA(742.4,"ACS",QANIEN,QAN))
if QAN'>0
QUIT
SET QAN(0)=QAN(0)+1
+4 IF QAN(0)>0
WRITE !!?12,$CHAR(7),"There exist "_QAN(0)_" open INCIDENT CASE(S) on the system.",!!
+5 IF '$TEST
WRITE !!?12,"There exists ZERO open INCIDENT CASE(S) on the system."
KILL QAN,QANIEN
+6 IF 'QANAGN
FOR
WRITE !!,"Do you wish to create a new incident event record"
SET %=2
DO YN^DICN
if "-112"[%
QUIT
WRITE !,$CHAR(7),"Enter (Y)es, or (N)o, or ""^"" to quit."
+7 IF 'QANAGN
IF %=-1
KILL QAN,QANIEN
QUIT
+8 IF 'QANAGN
IF %=1
SET (QANFLAG(0),QANFFLG)=1
SET QANF=""
DO ^QANCDNT
if QANXIT
QUIT
+9 if 'QANFLAG(0)
DO EDIT
IF QANXIT
DO CLEAN
QUIT
+10 if $DATA(QANDFN)&$DATA(QANIEN)
DO EN2^QANUTL2
+11 FOR
WRITE !!,"Do you wish to edit a particular open incident"
SET %=2
DO YN^DICN
if "-112"[%
QUIT
WRITE !!,"Enter (Y)es, (N)o, or ""^"" to exit"
+12 IF %=1
SET QANAGN=1
GOTO EN1
+13 DO CLEAN
QUIT
CASE ;
+1 KILL DIC
SET DIC=742.4
SET DIC(0)="QEANZ"
SET DIC("A")="Select Case Number: "
SET DIC("S")="I ""13""[+$P(^(0),U,8)"
SET DIC("W")="D EN1^QANUTL"
DO ^DIC
KILL DIC
+2 IF +Y=-1
SET QANXIT=1
WRITE !!,$CHAR(7),"Case Number not selected, exiting!!"
+3 IF '$TEST
SET QANIEN=+Y
+4 QUIT
DATE ;
+1 KILL DIC,D
SET DIC="^QA(742.4,"
SET DIC(0)="QEAMZ"
SET DIC("A")="Select Date of Incident: "
SET D="BDT"
SET DIC("S")="I ""13""[+$P(^(0),U,8)"
SET DIC("W")="D EN1^QANUTL"
DO IX^DIC
KILL DIC,D
+2 IF +Y=-1
SET QANXIT=1
WRITE !!,$CHAR(7),"Date of Incident not selected, exiting!!"
+3 IF '$TEST
SET QANIEN=+Y
+4 QUIT
EDIT KILL DIR
SET DIR("A",1)="Would you like to: "
SET DIR("A",2)="1. Edit by the Case Number"
SET DIR("A",3)="2. Edit by the Date of the Incident"
SET DIR("A",4)="3. Edit by the Patient"
SET DIR("A",5)="4. Edit by the Type of Incident"
+1 SET DIR("A")="Enter a number: (1-4) "
SET DIR(0)="NOA^1:4:0"
SET DIR("B")=3
SET DIR("?",1)="Choose the manner in which you wish to edit the record."
SET DIR("?")="Enter a number no less than 1, no greater than 4."
+2 DO ^DIR
KILL DIR
+3 IF $DATA(DTOUT)!($DATA(DUOUT))!($DATA(DIROUT))
SET QANXIT=1
QUIT
+4 SET QANTYPE=+Y
+5 DO @$SELECT(QANTYPE=1:"CASE",QANTYPE=2:"DATE",QANTYPE=3:"PAT^QANUTL1",1:"TYPE")
+6 if $GET(QANXIT)
QUIT
+7 IF $GET(QANBFLG)'=1
LOCK +^QA(742.4,QANIEN):5
IF '$TEST
WRITE !!?16,$CHAR(7),"Another person is editing this Incident Report."
SET QANXIT=1
+8 if QANXIT
QUIT
if $GET(QANTYPE)'=3
DO PAT0^QANUTL1
+9 QUIT
TYPE ;
+1 KILL DIC,D
SET DIC="^QA(742.4,"
SET DIC(0)="QEAMZ"
SET DIC("A")="Select Type of Incident: "
SET DIC("S")="I ""13""[+$P(^(0),U,8)"
SET D="BINC"
SET DIC("W")="D EN1^QANUTL"
DO IX^DIC
KILL DIC,D
+2 IF +Y=-1
SET QANXIT=1
WRITE !!,$CHAR(7),"Type of Incident not selected, exiting!!"
+3 IF '$TEST
SET QANIEN=+Y
+4 QUIT
PATMAN ;DELETING A PATIENT'S RECORD
+1 ;***********************************************************************
+2 ;*** NOTE: Execution of this subroutine deletes the "ACN" x-ref from ***
+3 ;*** the global ^QA(742.4! ***
+4 ;***********************************************************************
+5 KILL DIC
SET (DIC,DIE)="^QA(742,"
SET DIC(0)="QEAMZ"
SET DIC("A")="Select Patient: "
+6 SET DIC("S")="I $D(^QA(742,""BPRS"",1,+Y))"
+7 SET DIC("W")="D DICW^QANUTL1"
SET QANXX=1
SET D="B^BS5"
+8 DO MIX^DIC1
KILL DIC
SET QANPAT=+Y
+9 IF QANPAT'>0
GOTO K9
+10 SET QANINCD=+$ORDER(^QA(742.4,"ACN",QANPAT,""))
if QANINCD'>0
GOTO K9
+11 IF $ORDER(^QA(742,"BCS",QANINCD,""))=QANPAT
IF $ORDER(^QA(742,"BCS",QANINCD,QANPAT))']""
DO WARN^QANAUX1
GOTO K9
+12 SET DIE="^QA(742,"
SET DR=".13R"
SET DA=QANPAT
DO ^DIE
SET QANPTST=+$PIECE(^QA(742,QANPAT,0),U,12)
+13 KILL QAUDIT
SET QAUDIT("FILE")="742^50"
SET QAUDIT("DA")=QANPAT
SET QAUDIT("ACTION")=$SELECT(QANPTST=1:"o",QANPTST=-1:"d",1:"c")
SET QAUDIT("COMMENT")=$SELECT(QANPTST=1:"Open ",QANPTST=-1:"Delete ",1:"Close ")_"a patient record"
DO ^QAQAUDIT
K9 KILL %W,%X,%Y,C,D0,DA,DIE,DISYS,DR,QAN,QANINCD,QANPAT,QANSSN,QANST,QANXX,X
+1 KILL QANPTST,QAUDIT,Y
+2 QUIT
CLEAN ;Kill and quit.
+1 KILL C,D,DIC,D0,DA,MSSG0,MSSG1,MSSG2,QAN,QANADM,QANADMDT,QANAFRM,QANAME
+2 KILL QANCHK,QANCODE,QANDFN,QANDGPM,QANDT,QANDUZ,QANF,QANFLAG,QANHOME
+3 KILL QANINC,QANIEN,QANINCR,QANINPAT,QANINV,QANMAIL,QANMIEN,QANOUT,QANPLC
+4 KILL X,X1,X2,QANPID,QANPIEN,QANSITE,QANSSN,QANST,QANST1,QANTRSP,QANWARD
+5 KILL QANXIT,QANZERO,QANPAT,QANTYPE,QANX,QANZER0,QANTTL,QANSERV,QANPSDO
+6 KILL QANDOB,QANHOLD,^UTILITY($JOB),QANDOB,QANAGE,QANQAN,QANAGN,QANYN,POP
+7 KILL QANEOP,QANHEAD,QANINS,QANLINE,QANRSP0,QANRSP1,QANSTAT,QANPAGE,QANCS
+8 KILL QANDED,VAIN,VAERR,QANIRIN,QANLCTN,QANGLB0,QAUDIT,DTOUT,DUOUT,DIROUT
+9 KILL %,%T,%W,%X,%Y,DI,DIR,DQ,J,QANIC,QANPT,QANYN,QANPT0,Y,DIRUT,%DT,DIE,DR
+10 KILL QANPRS,QAHDNM,QAHDSSN,QAHOLD
+11 QUIT
