source: FOIAVistA/trunk/r/INCIDENT_REPORTING-QAN/QANBENE1.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 4.2 KB
Line 
1QANBENE1 ;HISC/GJC-Special incidents invol. a beneficiary ;3/3/92
2 ;;2.0;Incident Reporting;**1,8,11,18,26,28**;08/07/1992
3 ;
4EN1 ;Format of the print for our Beneficiary Report.
5 S QANWHICH=$S(QANFLG("WARD")="D":"Domiciliary",QANFLG("WARD")="NH":"NHCU",QANFLG("WARD")="I":"Inpatient",QANFLG("WARD")="O":"Outpatient",1:"total")
6 Q:QANQUIT
7 I '$D(^TMP("QANBEN",$J,"BEN")) D PRINT^QANBENE3 Q
8 Q:QANQUIT
9 S QANAA=""
10 F S QANAA=$O(^TMP("QANBEN",$J,"BEN",QANAA)) Q:QANAA']"" D
11 . S QANBB=""
12 . F S QANBB=$O(^TMP("QANBEN",$J,"BEN",QANAA,QANBB)) Q:QANBB']"" D
13 . . S QANLP(1)=0
14 . . F S QANLP(1)=$O(^TMP("QANBEN",$J,"BEN",QANAA,QANBB,QANLP(1))) Q:QANLP(1)'>0 D INC
15 I '$D(^TMP("QANBEN",$J,"BEN")) W !!,"There exist zero (0) "_QANWHICH_" incidents for this date range."
16 D EN1^QANBENE2 ;Prints out the data.
17 Q
18INC ;Checks for appropriate incident data.
19 K QANLBL S QAN7424=$G(^QA(742.4,QANLP(1),0)) Q:QAN7424']""
20 S QANINPT=$P(QAN7424,U,2),QANINVST=+$P(QAN7424,U,11)
21 I $D(^QA(742.1,"BUPPER","PATIENT ABUSE",QANINPT)) D PROVE Q
22 I $D(^QA(742.1,"BUPPER","DEATH",QANINPT)) D DEATH Q
23 I $D(^QA(742.1,"BUPPER","FALL",QANINPT)) S QANLBL="FALLS"
24 I $D(^QA(742.1,"BUPPER","INFORMED CONSENT-FAIL. TO OBTAIN",QANINPT)) S QANLBL="INFORMED"
25 I $D(^QA(742.1,"BUPPER","INFORMED CONSENT, FAIL. TO OBTAIN",QANINPT)) S QANLBL="INFORMED"
26 I $D(^QA(742.1,"BUPPER","HOMICIDE",QANINPT)) S QANLBL="HOMICIDE"
27 I $D(^QA(742.1,"BUPPER","MEDICATION ERROR",QANINPT)) S QANLBL="MED ERR"
28 I $D(^QA(742.1,"BUPPER","MISSING PATIENT",QANINPT)) S QANLBL="MISSING PAT"
29 I $D(^QA(742.1,"BUPPER","ASSAULT-PATIENT TO PATIENT",QANINPT)) S QANLBL="ASSAULT PAT/PAT"
30 I $D(^QA(742.1,"BUPPER","ASSAULT, PATIENT TO PATIENT",QANINPT)) S QANLBL="ASSAULT PAT/PAT"
31 I $D(^QA(742.1,"BUPPER","ASSAULT-PATIENT/STAFF",QANINPT)) S QANLBL="ASSAULT PAT/STAFF"
32 I $D(^QA(742.1,"BUPPER","ASSAULT, PATIENT/STAFF",QANINPT)) S QANLBL="ASSAULT PAT/STAFF"
33 I $D(^QA(742.1,"BUPPER","INJURY NOT OTHERWISE LISTED",QANINPT)) S QANLBL="OTHER"
34 I $D(^QA(742.1,"BUPPER","FIRE-PATIENT INVOLVED IN",QANINPT)) S QANLBL="FIRE"
35 I $D(^QA(742.1,"BUPPER","FIRE, PATIENT INVOLVED IN",QANINPT)) S QANLBL="FIRE"
36 I $D(^QA(742.1,"BUPPER","SEXUAL ASSAULT",QANINPT)) S QANLBL="SEX"
37 I $D(^QA(742.1,"BUPPER","SUICIDE ATTEMPT",QANINPT)) S QANLBL="SUI ATT"
38 I $D(^QA(742.1,"BUPPER","SUICIDE",QANINPT)) S QANLBL="SUICIDE"
39 I $D(^QA(742.1,"BUPPER","TRANSFUSION ERROR",QANINPT)) S QANLBL="TRANS ERR"
40 Q:$G(QANLBL)']"" ;Not a valid label
41 F QANLP(2)=0:0 S QANLP(2)=$O(^TMP("QANBEN",$J,"BEN",QANAA,QANBB,QANLP(1),QANLP(2))) Q:QANLP(2)'>0 D
42 . S QANSLEV=$P(^QA(742,QANLP(2),0),U,10) Q:$G(QANSLEV)']""
43 . I $G(QANLBL)]"" D TALLY^QANBENE0
44 I '$D(^TMP("QANBEN",$J,"BEN")) W !!,"There exist zero (0) incidents within this data range." Q
45 Q
46DEATH ;Tracking Deaths.
47 F QANLP(2)=0:0 S QANLP(2)=$O(^TMP("QANBEN",$J,"BEN",QANAA,QANBB,QANLP(1),QANLP(2))) Q:QANLP(2)'>0 D
48 . S QANSLEV=$P(^QA(742,QANLP(2),0),U,10) Q:'$G(QANSLEV)
49 . D DEATH1
50 . Q:$G(QANDTH)']""
51 . D:$G(QANLBL)]"" TALLY^QANBENE0
52 Q
53DEATH1 ;Tracking Deaths.
54 S QANDTH=$P(QAN7424,U,14) Q:QANDTH']""
55 Q:$D(^QA(742.14,"BUPPER","OTHER",QANDTH))
56 Q:$D(^QA(742.14,"BUPPER","WITHIN 24 HOURS OF ADMISSION (EX. DOA'S AND TERMINALS)",QANDTH))
57 I $D(^QA(742.14,"BUPPER","CONJUNCTION WITH A PROCEDURE",QANDTH)) S QANLBL="DEATH-CON"
58 I $D(^QA(742.14,"BUPPER","DURING INDUCTION OF ANES.",QANDTH)) S QANLBL="DEATH-ANESTH"
59 I $D(^QA(742.14,"BUPPER","FAILURE TO DIAGNOSE OR TREAT",QANDTH)) S QANLBL="DEATH-FAIL"
60 I $D(^QA(742.14,"BUPPER","ON MEDICAL CENTER GROUNDS",QANDTH)) S QANLBL="DEATH-MED CEN"
61 I $D(^QA(742.14,"BUPPER","OPERATING ROOM",QANDTH)) S QANLBL="DEATH-OR"
62 I $D(^QA(742.14,"BUPPER","RECOVERY ROOM",QANDTH)) S QANLBL="DEATH-RR"
63 I $D(^QA(742.14,"BUPPER","CASES ACCEPTED BY M.E.",QANDTH)) S QANLBL="DEATH-M.E."
64 I $D(^QA(742.14,"BUPPER","EQUIPMENT MALFUNCTION",QANDTH)) S QANLBL="DEATH-EQ"
65 I $D(^QA(742.14,"BUPPER","WITHIN 48 HOURS OF SURGERY",QANDTH)) S QANLBL="DEATH-48"
66 Q
67PROVE ;Sets Patient Abuse Array.
68 S QANAB=+$P(QAN7424,U,16),QANLBL=$S(QANAB=1:"PATIENT ABUSE/PROVEN",1:"PATIENT ABUSE/ALLEGED")
69 F QANLP(2)=0:0 S QANLP(2)=$O(^TMP("QANBEN",$J,"BEN",QANAA,QANBB,QANLP(1),QANLP(2))) Q:QANLP(2)'>0 D
70 . S QANSLEV=$P(^QA(742,QANLP(2),0),U,10)
71 . Q:$G(QANLBL)']""!('$G(QANSLEV))
72 . D TALLY^QANBENE0
73 Q
Note: See TracBrowser for help on using the repository browser.