source: WorldVistAEHR/trunk/r/INCIDENT_REPORTING-QAN/QANBENE0.m@ 1006

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

initial load of WorldVistAEHR

File size: 5.9 KB
Line 
1QANBENE0 ;HISC/GJC-SPECIAL INCIDENTS INVOL. A BENEFICIARY ;4/13/93 08:24
2 ;;2.0;Incident Reporting;**18,26,28,29**;08/07/1992
3 ;
4EN1 ;/*** Catagorize incidents ***/
5 K DIR S DIR(0)="FAO^1:1^K:""ACDINO""'[X X",DIR("A")="Select Ward type (A/C/D/I/N/O): "
6 S DIR("?",1)="Enter ""A"" to generate separate reports for Domiciliaries, NHCU'S, "
7 S DIR("?",2)="Inpatients and Outpatients."
8 S DIR("?",3)="Enter ""C"" to generate a report of combined data for Domiciliaries, NHCU'S, "
9 S DIR("?",4)="Inpatients and Outpatients."
10 S DIR("?",5)="Enter ""D"" for Domiciliary, ""I"" for Inpatients other than Domiciliary or "
11 S DIR("?")="NHCU, ""N"" for NHCU units, or ""O"" for Outpatients."
12 D ^DIR K DIR
13 I $D(DIRUT) D KILL Q
14 S QANFLG("WARD")=Y
15TASK ;Call to %ZTLOAD
16 S Y=DT X ^DD("DD") S TODAY=Y
17 K IOP,%ZIS S %ZIS("A")="Print on device: ",%ZIS="MQ" W ! D ^%ZIS W !!
18 G:POP KILL
19 I $D(IO("Q")) S ZTRTN="START^QANBENE0",ZTDESC="Generate Special Incident Reports For A Beneficiary." D QLOOP,^%ZTLOAD W !,$S($D(ZTSK):"Request Queued!",1:"Request Cancelled!"),! G EXIT
20START ;IO requests
21 U IO
22 I QANFLG("WARD")="A" S QANFLG("WARD A")="D^I^N^O"
23 I $D(QANFLG("WARD A")),(QANFLG("WARD A")="D^I^N^O") F QAN=1:1:$L(QANFLG("WARD A"),"^") Q:QANQUIT S QANFLG("WARD")=$P(QANFLG("WARD A"),"^",QAN) Q:QANFLG("WARD")']"" D
24 . W @IOF
25 . S PAGE=0
26 . K ^TMP("QANBEN",$J),QANCOUNT
27 . D GO D:'QANQUIT HDH^QANBENE3 Q:QANQUIT
28 G:QANQUIT EXIT
29 I '$D(QANFLG("WARD A")) D GO
30 I $D(^TMP("QANBEN",$J,"NOBEN")) D PRNOBEN
31EXIT ;
32 W ! D ^%ZISC,HOME^%ZIS
33KILL ;Kill and quit.
34 K %ZIS,D,DIC,DIRUT,I,PAGE,POP
35 K QAN,QAN742,QAN7424,QANAA,QANAB,QANBB,QANBENE,QANCC,QANCONT
36 K QANCOUNT,QANDATE,QAN1DIV,QANDIV,QANDTH,QANDV,QANDVFLG
37 K QANFLG,QANHEAD,QANHLOC,QANINPT,QANLBL,QANLP,QANLWLT
38 K QANPTTY,QANQUIT,QANSLEV,QANSTAT,QANTAB,QANUPLT,QANWARD
39 K QANINVST,QANSITE,QANSWCH,QANWHICH
40 K QAQNBEG,QAQNEND
41 K TODAY,X,Y,ZTDESC,ZTRTN,ZTSAVE,ZTSK
42 D K^QAQDATE
43 K ^TMP("QANBEN",$J)
44 Q
45GO ;Set up variables.
46 S QANOWARD=0
47 S QANLP=QANLWLT
48 F S QANLP=$O(^QA(742.4,"BDT",QANLP)) Q:QANLP'>0!(QANLP>QANUPLT) D
49 . S QANLP(1)=0
50 . F S QANLP(1)=$O(^QA(742.4,"BDT",QANLP,QANLP(1))) Q:QANLP(1)'>0 D
51 . . I $G(^QA(742.4,QANLP(1),0))]"" D LGIC I QANQUIT S QANQUIT=0 Q
52 . . S QANLP(2)=0
53 . . F S QANLP(2)=$O(^QA(742,"BCS",QANLP(1),QANLP(2))) Q:QANLP(2)'>0 D
54 . . . I $G(^QA(742,QANLP(2),0)) D LGIC1
55 . . . I QANQUIT S QANQUIT=0 Q
56 . . . S ^TMP("QANBEN",$J,"BEN",QANDIV,QANWARD,QANLP(1),QANLP(2))=""
57 S QANHEAD(3)=$S(QANFLG("WARD")="I":"INPATIENTS",QANFLG("WARD")="D":"DOMICILIARY",QANFLG("WARD")="N":"NHCU",QANFLG("WARD")="O":"OUTPATIENTS",1:"ALL INCIDENTS REGARDLESS OF LOCATION")
58 I $G(QANDVFLG)'=1 D HDR
59 D EN1^QANBENE1
60 Q
61LGIC ;Set up valid incidents
62 S QAN7424=^QA(742.4,QANLP(1),0),QAN("INC")=$P(QAN7424,U,2)
63 I QAN("INC")'<200 S QANQUIT=1 Q ;Quit if NOT a National incident.
64 D VALID^QANBENE I 'QANSWCH S QANQUIT=1 Q ;Quit if NOT a valid incident
65 S QANSTAT=+$P(QAN7424,U,8),QANBENE=+$P(QAN7424,U,17)
66 I 'QANBENE!(QANFLG("IR STAT")'[QANSTAT) S QANQUIT=1 Q
67 S QANDIV=$P(QAN7424,U,22)
68 I $G(QANDIV)']"" S QANDIV=0
69 I $G(QAN1DIV)]"" I QAN1DIV'=QANDIV S QANQUIT=1 Q
70 I '$D(^QA(740,1,"QAN2","B",QANDIV)) S QANDIV=0
71 I $G(QANDVFLG)'=1 S QANDIV=0
72 Q
73HDR ;Header generator.
74 S PAGE=PAGE+1 W @IOF,!?69,TODAY,!?69,"Page: ",PAGE,!!
75 W ?(IOM-$L(QANHEAD(0))\2),QANHEAD(0),!,?(IOM-$L(QANHEAD(1))\2),QANHEAD(1),!
76 W !?(IOM-$L(QANHEAD(2))\2),QANHEAD(2),!
77 W !?(IOM-$L(QANHEAD(3))\2),QANHEAD(3)
78 I $G(QANDVFLG)=1,($G(QANHEAD(4))]"") W !?(IOM-$L(QANHEAD(4))\2),QANHEAD(4)
79 W !!?QANTAB(5),"Total",?QANTAB(6),"Resulted in"
80 W !?QANTAB(2),"Incident",?QANTAB(4),"Severity",?QANTAB(5),"Number",?QANTAB(6),"Investigation",!?QANTAB(2),"--------",?QANTAB(4),"--------",?QANTAB(5),"------",?QANTAB(6),"-------------"
81 I QANCONT,$D(QANLBL) W !!?QANTAB(2),QANLBL_" (cont)"
82 Q
83LGIC1 ;Sorting wards into categories.
84 Q:$D(^QA(742,"BPRS",-1,QANLP(2))) ;Quit if a deleted patient
85 S QAN742=^QA(742,QANLP(2),0)
86 S QANPTTY=+$P(QAN742,U,5),QANWARD=+$P(QAN742,U,6),QANSLEV=+$P(QAN742,U,10)
87 I $G(QANWARD)'>0 D
88 . S QANINUM=$P(QAN7424,U) ;Incident number
89 . S QANWHY="No ward entered for Incident." ;why excluded from report
90 . D NOBEN
91 . S QANQUIT=1 Q
92 I '$D(^SC(QANWARD)) D
93 . S QANINUM=$P(QAN7424,U) ;Incident number
94 . S QANWHY="Ward has no valid Hospital Location." ;why excluded
95 . D NOBEN
96 . S QANQUIT=1 Q
97 D WARD
98 Q
99QLOOP ;Save variables for %ZTLOAD.
100 F I="^TMP(""QANBEN"",$J,","PAGE","TODAY","QAN*","QAQ*" S ZTSAVE(I)=""
101 Q
102WARD ;determine if record should be included in report
103 S QANWARD=$G(^SC(QANWARD,42)) D
104 . I $G(QANWARD)']"" S QANWARD="O" Q
105 . I $G(QANWARD) S QANWARD=$P(^DIC(42,QANWARD,0),U,3)
106 . I $G(QANWARD)]"" S QANWARD=$S($G(QANWARD)="D":"D",$G(QANWARD)="NH":"N",1:"I") Q
107 . I $G(QANWARD)']"" S QANWARD="O"
108 S QANXXX=$S(QANFLG("WARD")="C":1,QANFLG("WARD")="A":1,QANFLG("WARD")=QANWARD:1,$G(QANFLG("WARD A")):1,1:0)
109 I QANXXX<1 S QANQUIT=1 Q
110 Q
111TALLY ;create and increment globals for report
112 S QANCOUNT("SLEV",QANAA,QANLBL,QANSLEV)=$G(QANCOUNT("SLEV",QANAA,QANLBL,QANSLEV))+1
113 I $G(QANINVST)>1 S QANCOUNT("INV",QANAA,QANLBL,QANSLEV)=$G(QANCOUNT("INV",QANAA,QANLBL,QANSLEV))+1
114 Q
115NOBEN ;process those records without valid ward information for exception
116 ;report
117 S QANOWARD=QANOWARD+1
118 S ^TMP("QANBEN",$J,"NOBEN",QANOWARD)=QANINUM_"^"_QANWHY
119 Q
120PRNOBEN ;print list of records excluded from report
121 I '$D(^TMP("QANBEN",$J,"NOBEN")) Q
122 D HDH2
123 W !!!?25,"EXCEPTION REPORT"
124 W !?10,"The following records were excluded from this report."
125 W !?10,"_____________________________________________________"
126 W !!?5,"Incident Number",?35,"Reason for Exclusion"
127 W !?5,"---------------",?35,"--------------------"
128 S QANE=0
129 F S QANE=$O(^TMP("QANBEN",$J,"NOBEN",QANE)) Q:QANE'>0 D
130 . S QANLINE=^TMP("QANBEN",$J,"NOBEN",QANE)
131 . D:$Y>(IOSL-4) HDH^QANBENE2 Q:QANQUIT
132 . W !?6,$P(QANLINE,U),?32,$P(QANLINE,U,2)
133 W !!!?25,"End of Report."
134 Q
135HDH2 ;header for exception report
136 W @IOF
137 W !?(IOM-$L(QANHEAD(0))\2),QANHEAD(0)
138 W !?(IOM-$L(QANHEAD(1))\2),QANHEAD(1)
139 W !!?(IOM-$L(QANHEAD(2))\2),QANHEAD(2)
140 Q
Note: See TracBrowser for help on using the repository browser.