QANUTL4 ;HISC/GJC-Utilities for report generation ;6/16/93 12:05
;;2.0;Incident Reporting;**1,20,26**;08/07/1992
QANLOC ;Finding Incident Locations.
S (QANFLG,QANY)=0
W !!,"Enter the beginning and ending Incident Locations."
R !,"Start with Incident Location: First// ",X:DTIME
I '$T!(X["^") S QANY=1 Q
I X="" S QANLCFLG=1 Q
S X=$E(X)_$TR($E(X,2,999),"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
S DIC=742.5,DIC(0)="EZ" D ^DIC K DIC
I +Y>0 S:$D(Y(0,0)) QANDATA1=Y(0,0),QANDAT1=+Y G QANLOC1
I $D(DTOUT)!$D(DUOUT) S QANY=1 Q
I $D(X),$D(Y),X'["?",+Y=-1 W $C(7)," ??"
G QANLOC
QANLOC1 ;
R !,"End with Incident Location: Last// ",X:DTIME
I '$T!(X["^") S QANY=1 Q
I X="" S QANDATA2="~" D QANLOC3 Q
S X=$E(X)_$TR($E(X,2,999),"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
S DIC=742.5,DIC(0)="EZ" D ^DIC K DIC
I +Y>0 S:$D(Y(0,0)) QANDATA2=Y(0,0),QANDAT2=+Y G QANLOC2
I $D(DTOUT)!$D(DUOUT) S QANY=1 Q
I $D(X),$D(Y),X'["?",+Y=-1 W $C(7)," ??"
G QANLOC1
QANLOC2 I (QANDATA2']QANDATA1),(QANDATA2'=QANDATA1) D
. W !!,$C(7),"The 'Start With' value must fall before the 'End With' value."
. K QANDATA1,QANDATA2
. S QANFLG=1 Q
I $G(QANFLG) G QANLOC
QANLOC3 ;
N QANCC,QANEE
S QANEE=$E(QANDATA1,1,$L(QANDATA1)-1)
S QANCC=QANDATA2_"Z"
F S QANEE=$O(^QA(742.5,"B",QANEE)) Q:QANEE']""!(QANEE]QANCC) D
. S QANDD=$O(^QA(742.5,"B",QANEE,0)),^TMP("QANRPT1",$J,"LOC",QANDD)=QANEE
Q
WARD ;Grabbing the patient's Ward Location
S (QANFLG,QANY)=0
W !!,"Enter the beginning and ending ward/clinic locations for a patient."
S DIC=44,DIC(0)="QEAMNZ",DIC("A")="Start with Ward/Clinic: First// "
S DIC("S")="S QA=$P(^(0),U,3) I QA=""W""!(QA=""C"")" D ^DIC K DIC
I X="" S QANLCFLG=1 Q
I $D(DTOUT)!$D(DUOUT) S QANY=1 Q
S:$D(Y(0,0)) QANDATA1=Y(0,0),QANDAT1=+Y
WARD1 S DIC=44,DIC(0)="QEAMNZ",DIC("A")="End with Ward/Clinic: Last// ",DIC("S")="S QA=$P(^(0),U,3) I QA=""W""!(QA=""C"")" D ^DIC K DIC
I X="" S QANDATA2="~" G WARD2
I $D(DTOUT)!$D(DUOUT) S QANY=1 Q
S:$D(Y(0,0)) QANDATA2=Y(0,0),QANDAT2=+Y
WARD2 I (QANDATA2']QANDATA1),(QANDATA2'=QANDATA1) W !!,$C(7),"The 'Start with' values must fall before the 'End with' values." K QANDATA1,QANDATA2 G WARD
D WARD3
Q
WARD3 ;STORING THE WARD LOCATION
N QANCC,QANEE
S QANEE=$E(QANDATA1,1,$L(QANDATA1)-1) ;$S($G(QANDATA1)=" ":0,1:$E(QANDATA1,1,$L(QANDATA1)-1))
S QANCC=$S($G(QANDATA2)="~":"ZZ",1:QANDATA2_"Z")
F S QANEE=$O(^SC("B",QANEE)) Q:QANEE']""!(QANEE]QANCC) D
. S QANDD=$O(^SC("B",QANEE,0))
. S ^TMP("QANRPT1",$J,"LOC",QANDD)=QANEE
Q
INCD ;Grabbing the incident.
S QANY=0 W !!,"Enter the beginning and ending incident for a patient."
S DIC=742.1,DIC(0)="QEAMNZ",DIC("A")="Start with Incident: First// ",D="B^BUPPER" D MIX^DIC1 K D,DIC
I X="" S QANINFLG=1 Q
I $D(DTOUT)!$D(DUOUT) S QANY=1 Q
S:$D(Y(0,0)) QANDATA1=Y(0,0),QANDAT1=+Y
INCD1 S DIC=742.1,DIC(0)="QEAMNZ",DIC("A")="End with Incident: Last// ",D="B^BUPPER" D MIX^DIC1 K D,DIC
I X="" S QANDATA2="~" G INCD2
I $D(DTOUT)!$D(DUOUT) S QANY=1 Q
S:$D(Y(0,0)) QANDATA2=Y(0,0),QANDAT2=+Y
INCD2 I (QANDATA2']QANDATA1),(QANDATA2'=QANDATA1) W !!,$C(7),"The 'Start with' values must fall before the 'End with' values." K QANDATA1,QANDATA2 G INCD
D INCD3
Q
INCD3 ;STORING THE INCIDENT
N QANCC,QANEE
S QANEE=$E(QANDATA1,1,$L(QANDATA1)-1) ;$S(QANDATA1=" ":"A",1:$E(QANDATA1,1,$L(QANDATA1)-1))
S QANCC=QANDATA2_"Z"
F S QANEE=$O(^QA(742.1,"B",QANEE)) Q:QANEE']""!(QANEE]QANCC) D
. S QANDD=$O(^QA(742.1,"B",QANEE,0)),^TMP("QANRPT1",$J,"INC",QANDD)=QANEE
Q
CHECK ;Check for the final Incident type
W !!?10,"INCIDENT: "_$S(QANIRIN>0:$P(^QA(742.1,QANIRIN,0),U),1:""),!?10,"SEVERITY LEVEL: "_$S("16"'[QANIRIN:$P(^QA(742,QANDFN,0),U,10),"16"[QANIRIN:"3",1:"")
I "16"[QANIRIN,(+$P($G(^QA(742,QANDFN,0)),U,10)'=3) D
. K DA,DIE,DR S DA=QANDFN,DIE="^QA(742,",DR=".1///"_3 D ^DIE
. K DA,DIE,DR
S %=$S(+$P(^QA(742.4,QANIEN,0),U,17)=1:1,1:2)
CHK1 F W !!,"Is this the final incident type" D YN^DICN Q:"-112"[% W !!,"Enter ""N""o if you wish to enter a new Incident and Severity Level,",!,"""Y""es if the current Incident and Severity Level are correct."
S QANYN=%
K DA,DR,DIE S DIE="^QA(742.4,",DA=QANIEN,DR=".19///"_$S(%=1:1,1:0) D ^DIE K DA,DR,DIE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQANUTL4 4287 printed Apr 09, 2024@21:01:18 Page 2
QANUTL4 ;HISC/GJC-Utilities for report generation ;6/16/93 12:05
+1 ;;2.0;Incident Reporting;**1,20,26**;08/07/1992
QANLOC ;Finding Incident Locations.
+1 SET (QANFLG,QANY)=0
+2 WRITE !!,"Enter the beginning and ending Incident Locations."
+3 READ !,"Start with Incident Location: First// ",X:DTIME
+4 IF '$TEST!(X["^")
SET QANY=1
QUIT
+5 IF X=""
SET QANLCFLG=1
QUIT
+6 SET X=$EXTRACT(X)_$TRANSLATE($EXTRACT(X,2,999),"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
+7 SET DIC=742.5
SET DIC(0)="EZ"
DO ^DIC
KILL DIC
+8 IF +Y>0
if $DATA(Y(0,0))
SET QANDATA1=Y(0,0)
SET QANDAT1=+Y
GOTO QANLOC1
+9 IF $DATA(DTOUT)!$DATA(DUOUT)
SET QANY=1
QUIT
+10 IF $DATA(X)
IF $DATA(Y)
IF X'["?"
IF +Y=-1
WRITE $CHAR(7)," ??"
+11 GOTO QANLOC
QANLOC1 ;
+1 READ !,"End with Incident Location: Last// ",X:DTIME
+2 IF '$TEST!(X["^")
SET QANY=1
QUIT
+3 IF X=""
SET QANDATA2="~"
DO QANLOC3
QUIT
+4 SET X=$EXTRACT(X)_$TRANSLATE($EXTRACT(X,2,999),"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
+5 SET DIC=742.5
SET DIC(0)="EZ"
DO ^DIC
KILL DIC
+6 IF +Y>0
if $DATA(Y(0,0))
SET QANDATA2=Y(0,0)
SET QANDAT2=+Y
GOTO QANLOC2
+7 IF $DATA(DTOUT)!$DATA(DUOUT)
SET QANY=1
QUIT
+8 IF $DATA(X)
IF $DATA(Y)
IF X'["?"
IF +Y=-1
WRITE $CHAR(7)," ??"
+9 GOTO QANLOC1
QANLOC2 IF (QANDATA2']QANDATA1)
IF (QANDATA2'=QANDATA1)
Begin DoDot:1
+1 WRITE !!,$CHAR(7),"The 'Start With' value must fall before the 'End With' value."
+2 KILL QANDATA1,QANDATA2
+3 SET QANFLG=1
QUIT
End DoDot:1
+4 IF $GET(QANFLG)
GOTO QANLOC
QANLOC3 ;
+1 NEW QANCC,QANEE
+2 SET QANEE=$EXTRACT(QANDATA1,1,$LENGTH(QANDATA1)-1)
+3 SET QANCC=QANDATA2_"Z"
+4 FOR
SET QANEE=$ORDER(^QA(742.5,"B",QANEE))
if QANEE']""!(QANEE]QANCC)
QUIT
Begin DoDot:1
+5 SET QANDD=$ORDER(^QA(742.5,"B",QANEE,0))
SET ^TMP("QANRPT1",$JOB,"LOC",QANDD)=QANEE
End DoDot:1
+6 QUIT
WARD ;Grabbing the patient's Ward Location
+1 SET (QANFLG,QANY)=0
+2 WRITE !!,"Enter the beginning and ending ward/clinic locations for a patient."
+3 SET DIC=44
SET DIC(0)="QEAMNZ"
SET DIC("A")="Start with Ward/Clinic: First// "
+4 SET DIC("S")="S QA=$P(^(0),U,3) I QA=""W""!(QA=""C"")"
DO ^DIC
KILL DIC
+5 IF X=""
SET QANLCFLG=1
QUIT
+6 IF $DATA(DTOUT)!$DATA(DUOUT)
SET QANY=1
QUIT
+7 if $DATA(Y(0,0))
SET QANDATA1=Y(0,0)
SET QANDAT1=+Y
WARD1 SET DIC=44
SET DIC(0)="QEAMNZ"
SET DIC("A")="End with Ward/Clinic: Last// "
SET DIC("S")="S QA=$P(^(0),U,3) I QA=""W""!(QA=""C"")"
DO ^DIC
KILL DIC
+1 IF X=""
SET QANDATA2="~"
GOTO WARD2
+2 IF $DATA(DTOUT)!$DATA(DUOUT)
SET QANY=1
QUIT
+3 if $DATA(Y(0,0))
SET QANDATA2=Y(0,0)
SET QANDAT2=+Y
WARD2 IF (QANDATA2']QANDATA1)
IF (QANDATA2'=QANDATA1)
WRITE !!,$CHAR(7),"The 'Start with' values must fall before the 'End with' values."
KILL QANDATA1,QANDATA2
GOTO WARD
+1 DO WARD3
+2 QUIT
WARD3 ;STORING THE WARD LOCATION
+1 NEW QANCC,QANEE
+2 ;$S($G(QANDATA1)=" ":0,1:$E(QANDATA1,1,$L(QANDATA1)-1))
SET QANEE=$EXTRACT(QANDATA1,1,$LENGTH(QANDATA1)-1)
+3 SET QANCC=$SELECT($GET(QANDATA2)="~":"ZZ",1:QANDATA2_"Z")
+4 FOR
SET QANEE=$ORDER(^SC("B",QANEE))
if QANEE']""!(QANEE]QANCC)
QUIT
Begin DoDot:1
+5 SET QANDD=$ORDER(^SC("B",QANEE,0))
+6 SET ^TMP("QANRPT1",$JOB,"LOC",QANDD)=QANEE
End DoDot:1
+7 QUIT
INCD ;Grabbing the incident.
+1 SET QANY=0
WRITE !!,"Enter the beginning and ending incident for a patient."
+2 SET DIC=742.1
SET DIC(0)="QEAMNZ"
SET DIC("A")="Start with Incident: First// "
SET D="B^BUPPER"
DO MIX^DIC1
KILL D,DIC
+3 IF X=""
SET QANINFLG=1
QUIT
+4 IF $DATA(DTOUT)!$DATA(DUOUT)
SET QANY=1
QUIT
+5 if $DATA(Y(0,0))
SET QANDATA1=Y(0,0)
SET QANDAT1=+Y
INCD1 SET DIC=742.1
SET DIC(0)="QEAMNZ"
SET DIC("A")="End with Incident: Last// "
SET D="B^BUPPER"
DO MIX^DIC1
KILL D,DIC
+1 IF X=""
SET QANDATA2="~"
GOTO INCD2
+2 IF $DATA(DTOUT)!$DATA(DUOUT)
SET QANY=1
QUIT
+3 if $DATA(Y(0,0))
SET QANDATA2=Y(0,0)
SET QANDAT2=+Y
INCD2 IF (QANDATA2']QANDATA1)
IF (QANDATA2'=QANDATA1)
WRITE !!,$CHAR(7),"The 'Start with' values must fall before the 'End with' values."
KILL QANDATA1,QANDATA2
GOTO INCD
+1 DO INCD3
+2 QUIT
INCD3 ;STORING THE INCIDENT
+1 NEW QANCC,QANEE
+2 ;$S(QANDATA1=" ":"A",1:$E(QANDATA1,1,$L(QANDATA1)-1))
SET QANEE=$EXTRACT(QANDATA1,1,$LENGTH(QANDATA1)-1)
+3 SET QANCC=QANDATA2_"Z"
+4 FOR
SET QANEE=$ORDER(^QA(742.1,"B",QANEE))
if QANEE']""!(QANEE]QANCC)
QUIT
Begin DoDot:1
+5 SET QANDD=$ORDER(^QA(742.1,"B",QANEE,0))
SET ^TMP("QANRPT1",$JOB,"INC",QANDD)=QANEE
End DoDot:1
+6 QUIT
CHECK ;Check for the final Incident type
+1 WRITE !!?10,"INCIDENT: "_$SELECT(QANIRIN>0:$PIECE(^QA(742.1,QANIRIN,0),U),1:""),!?10,"SEVERITY LEVEL: "_$SELECT("16"'[QANIRIN:$PIECE(^QA(742,QANDFN,0),U,10),"16"[QANIRIN:"3",1:"")
+2 IF "16"[QANIRIN
IF (+$PIECE($GET(^QA(742,QANDFN,0)),U,10)'=3)
Begin DoDot:1
+3 KILL DA,DIE,DR
SET DA=QANDFN
SET DIE="^QA(742,"
SET DR=".1///"_3
DO ^DIE
+4 KILL DA,DIE,DR
End DoDot:1
+5 SET %=$SELECT(+$PIECE(^QA(742.4,QANIEN,0),U,17)=1:1,1:2)
CHK1 FOR
WRITE !!,"Is this the final incident type"
DO YN^DICN
if "-112"[%
QUIT
WRITE !!,"Enter ""N""o if you wish to enter a new Incident and Severity Level,",!,"""Y""es if the current Incident and Severity Level are correct."
+1 SET QANYN=%
+2 KILL DA,DR,DIE
SET DIE="^QA(742.4,"
SET DA=QANIEN
SET DR=".19///"_$SELECT(%=1:1,1:0)
DO ^DIE
KILL DA,DR,DIE
+3 QUIT
