source: FOIAVistA/trunk/r/INCIDENT_REPORTING-QAN/QANUTL4.m@ 1751

Last change on this file since 1751 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.1 KB
Line 
1QANUTL4 ;HISC/GJC-Utilities for report generation ;6/16/93 12:05
2 ;;2.0;Incident Reporting;**1,20,26**;08/07/1992
3QANLOC ;Finding Incident Locations.
4 S (QANFLG,QANY)=0
5 W !!,"Enter the beginning and ending Incident Locations."
6 R !,"Start with Incident Location: First// ",X:DTIME
7 I '$T!(X["^") S QANY=1 Q
8 I X="" S QANLCFLG=1 Q
9 S X=$E(X)_$TR($E(X,2,999),"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
10 S DIC=742.5,DIC(0)="EZ" D ^DIC K DIC
11 I +Y>0 S:$D(Y(0,0)) QANDATA1=Y(0,0),QANDAT1=+Y G QANLOC1
12 I $D(DTOUT)!$D(DUOUT) S QANY=1 Q
13 I $D(X),$D(Y),X'["?",+Y=-1 W $C(7)," ??"
14 G QANLOC
15QANLOC1 ;
16 R !,"End with Incident Location: Last// ",X:DTIME
17 I '$T!(X["^") S QANY=1 Q
18 I X="" S QANDATA2="~" D QANLOC3 Q
19 S X=$E(X)_$TR($E(X,2,999),"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz")
20 S DIC=742.5,DIC(0)="EZ" D ^DIC K DIC
21 I +Y>0 S:$D(Y(0,0)) QANDATA2=Y(0,0),QANDAT2=+Y G QANLOC2
22 I $D(DTOUT)!$D(DUOUT) S QANY=1 Q
23 I $D(X),$D(Y),X'["?",+Y=-1 W $C(7)," ??"
24 G QANLOC1
25QANLOC2 I (QANDATA2']QANDATA1),(QANDATA2'=QANDATA1) D
26 . W !!,$C(7),"The 'Start With' value must fall before the 'End With' value."
27 . K QANDATA1,QANDATA2
28 . S QANFLG=1 Q
29 I $G(QANFLG) G QANLOC
30QANLOC3 ;
31 N QANCC,QANEE
32 S QANEE=$E(QANDATA1,1,$L(QANDATA1)-1)
33 S QANCC=QANDATA2_"Z"
34 F S QANEE=$O(^QA(742.5,"B",QANEE)) Q:QANEE']""!(QANEE]QANCC) D
35 . S QANDD=$O(^QA(742.5,"B",QANEE,0)),^TMP("QANRPT1",$J,"LOC",QANDD)=QANEE
36 Q
37WARD ;Grabbing the patient's Ward Location
38 S (QANFLG,QANY)=0
39 W !!,"Enter the beginning and ending ward/clinic locations for a patient."
40 S DIC=44,DIC(0)="QEAMNZ",DIC("A")="Start with Ward/Clinic: First// "
41 S DIC("S")="S QA=$P(^(0),U,3) I QA=""W""!(QA=""C"")" D ^DIC K DIC
42 I X="" S QANLCFLG=1 Q
43 I $D(DTOUT)!$D(DUOUT) S QANY=1 Q
44 S:$D(Y(0,0)) QANDATA1=Y(0,0),QANDAT1=+Y
45WARD1 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
46 I X="" S QANDATA2="~" G WARD2
47 I $D(DTOUT)!$D(DUOUT) S QANY=1 Q
48 S:$D(Y(0,0)) QANDATA2=Y(0,0),QANDAT2=+Y
49WARD2 I (QANDATA2']QANDATA1),(QANDATA2'=QANDATA1) W !!,$C(7),"The 'Start with' values must fall before the 'End with' values." K QANDATA1,QANDATA2 G WARD
50 D WARD3
51 Q
52WARD3 ;STORING THE WARD LOCATION
53 N QANCC,QANEE
54 S QANEE=$E(QANDATA1,1,$L(QANDATA1)-1) ;$S($G(QANDATA1)=" ":0,1:$E(QANDATA1,1,$L(QANDATA1)-1))
55 S QANCC=$S($G(QANDATA2)="~":"ZZ",1:QANDATA2_"Z")
56 F S QANEE=$O(^SC("B",QANEE)) Q:QANEE']""!(QANEE]QANCC) D
57 . S QANDD=$O(^SC("B",QANEE,0))
58 . S ^TMP("QANRPT1",$J,"LOC",QANDD)=QANEE
59 Q
60INCD ;Grabbing the incident.
61 S QANY=0 W !!,"Enter the beginning and ending incident for a patient."
62 S DIC=742.1,DIC(0)="QEAMNZ",DIC("A")="Start with Incident: First// ",D="B^BUPPER" D MIX^DIC1 K D,DIC
63 I X="" S QANINFLG=1 Q
64 I $D(DTOUT)!$D(DUOUT) S QANY=1 Q
65 S:$D(Y(0,0)) QANDATA1=Y(0,0),QANDAT1=+Y
66INCD1 S DIC=742.1,DIC(0)="QEAMNZ",DIC("A")="End with Incident: Last// ",D="B^BUPPER" D MIX^DIC1 K D,DIC
67 I X="" S QANDATA2="~" G INCD2
68 I $D(DTOUT)!$D(DUOUT) S QANY=1 Q
69 S:$D(Y(0,0)) QANDATA2=Y(0,0),QANDAT2=+Y
70INCD2 I (QANDATA2']QANDATA1),(QANDATA2'=QANDATA1) W !!,$C(7),"The 'Start with' values must fall before the 'End with' values." K QANDATA1,QANDATA2 G INCD
71 D INCD3
72 Q
73INCD3 ;STORING THE INCIDENT
74 N QANCC,QANEE
75 S QANEE=$E(QANDATA1,1,$L(QANDATA1)-1) ;$S(QANDATA1=" ":"A",1:$E(QANDATA1,1,$L(QANDATA1)-1))
76 S QANCC=QANDATA2_"Z"
77 F S QANEE=$O(^QA(742.1,"B",QANEE)) Q:QANEE']""!(QANEE]QANCC) D
78 . S QANDD=$O(^QA(742.1,"B",QANEE,0)),^TMP("QANRPT1",$J,"INC",QANDD)=QANEE
79 Q
80CHECK ;Check for the final Incident type
81 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:"")
82 I "16"[QANIRIN,(+$P($G(^QA(742,QANDFN,0)),U,10)'=3) D
83 . K DA,DIE,DR S DA=QANDFN,DIE="^QA(742,",DR=".1///"_3 D ^DIE
84 . K DA,DIE,DR
85 S %=$S(+$P(^QA(742.4,QANIEN,0),U,17)=1:1,1:2)
86CHK1 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."
87 S QANYN=%
88 K DA,DR,DIE S DIE="^QA(742.4,",DA=QANIEN,DR=".19///"_$S(%=1:1,1:0) D ^DIE K DA,DR,DIE
89 Q
Note: See TracBrowser for help on using the repository browser.