VistA-WorldVistAEHR/r/INCIDENT_REPORTING-QAN/QANUTL4.m

90 lines
4.1 KiB
Mathematica

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