source: FOIAVistA/trunk/r/INCIDENT_REPORTING-QAN/QANOPEN.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: 3.5 KB
Line 
1QANOPEN ;GJC/HISC-Open Incident Case Report ;6/15/92
2 ;;2.0;Incident Reporting;**26**;08/07/1992
3 S QANHD(0)="Open Incidents and the Associated Patient(s)"
4 S QANHD(1)="""c"" denotes a Closed Patient Record"
5 S QANHD(2)="""d"" denotes a Deleted Patient Record"
6 S QANHD(3)="No Open Cases found!"
7 S $P(QANLN,"+",$S(IOM=132:133,1:81))="",(QANPG,QANXIT)=0
8 S Y=DT X ^DD("DD") S QANTDY=Y
9 D DIV^QANRPT1 I $G(QANPOP) G KILL
10 F QANAA=1:2:3 D
11 . S QANIEN=0
12 . F S QANIEN=$O(^QA(742.4,"ACS",QANAA,QANIEN)) Q:QANAA'>0!(QANIEN'>0) D
13 . . D INCD
14TASK ;Call to ^%ZTLOAD
15 K IOP,%ZIS S %ZIS("A")="Print on device: ",%ZIS="MQ" W ! D ^%ZIS W !!
16 G:POP KILL
17 I $D(IO("Q")) S ZTRTN="START^QANOPEN",ZTDESC="Open Incident/Patient report." D ZLOOP,^%ZTLOAD W !,$S($D(ZTSK):"Request Queued!",1:"Request Cancelled!"),! G EXIT
18START ;
19 U IO W @IOF
20 I '$D(^TMP("QAN",$J)) D HDH W !!!!!?(IOM-$L(QANHD(3))\2),QANHD(3) G EXIT
21 S QANCC=""
22 F S QANCC=$O(^TMP("QAN",$J,"DIV",QANCC)) Q:QANCC']"" D
23 . I QANCC>0 S Y=QANCC I Y]"" S C=$P(^DD(742.4,52,0),U,2) D Y^DIQ S QANDIVN=Y
24 . I QANCC=0 S QANDIVN="Unknown"
25 . S QANHD(4)="Report for Division: "_QANDIVN
26 . W @IOF D HDR
27 . S QAN0=0
28 . F S QAN0=$O(^TMP("QAN",$J,"DIV",QANCC,QAN0)) Q:QAN0'>0 D
29 . . S QAN1=0
30 . . F S QAN1=$O(^TMP("QAN",$J,QAN0,QAN1)) Q:QAN1'>0!(QANXIT) D OUT1
31EXIT ;Close device
32 W ! D ^%ZISC,HOME^%ZIS
33KILL ;Kill and quit
34 K %ZIS,C,D,DIC,DIR,POP,QA,QAN0,QAN1,QANCASE,QANDATE,QANDFN,QANHD,QANIEN
35 K QANINCD,QANLCS,QANLN,QANPAT,QANPG,QANPRS,QANPT,QANTDY,QANXIT,QANZER0
36 K DTOUT,DIRUT,DIROUT,DUOUT,QANZERO,QAQ,X,Y,ZTDESC,ZTRTN,ZTSAVE,ZTSK
37 K ^TMP("QAN",$J)
38 Q
39HDH ;End of Screen interface
40 I $E(IOST)="C" K DIR S DIR(0)="E" D ^DIR S:+Y=0 QANXIT=1 Q:QANXIT
41 W @IOF D HDR
42 Q
43HDR ;Standard header
44 S QANPG=QANPG+1
45 W !,?63,"Date: ",?69,QANTDY,!?63,"Page: ",?69,QANPG
46 W !?(IOM-$L(QANHD(0))\2),QANHD(0)
47 W !?(IOM-$L(QANHD(1))\2),QANHD(1)
48 W !?(IOM-$L(QANHD(2))\2),QANHD(2)
49 I $G(QANDVFLG)=1,($G(QANHD(4))]"") W !?(IOM-$L(QANHD(4))\2),QANHD(4)
50 F QAQ=1:1:2 W !,QANLN
51 Q
52INCD ;Incident data
53 S QANZERO=$G(^QA(742.4,QANIEN,0)) Q:QANZERO']""
54 S QANDIV=$P(QANZERO,U,22)
55 I $G(QAN1DIV)]"" Q:QAN1DIV'=QANDIV
56 I '$G(QANDVFLG) S QANDIV=0
57 I $G(QANDVFLG)=1 D DIV
58 S ^TMP("QAN",$J,"DIV",QANDIV,QANIEN)=""
59 S QANCASE=$P(QANZERO,U),QANINCD=$P(QANZERO,U,2),QANDATE=$P(QANZERO,U,3)
60 S Y=QANINCD I Y]"" S C=$P(^DD(742.4,.02,0),U,2) D Y^DIQ S QANINCD=Y
61 S Y=QANDATE I Y]"" S C=$P(^DD(742.4,.03,0),U,2) D Y^DIQ S QANDATE=Y
62 S ^TMP("QAN",$J,QANIEN,"CASE")=$S(QANCASE]"":QANCASE,1:"N/A")
63 S ^TMP("QAN",$J,QANIEN,"INCD")=$S(QANINCD]"":QANINCD,1:"N/A")
64 S ^TMP("QAN",$J,QANIEN,"DATE")=$S(QANDATE]"":QANDATE,1:"N/A")
65 F QANDFN=0:0 S QANDFN=$O(^QA(742,"BCS",QANIEN,QANDFN)) Q:QANDFN'>0 D PAT
66 Q
67OUT1 ;Output data/results
68 I $Y>(IOSL-6) D HDH Q:QANXIT
69 W !!,"Case Number: ",$G(^TMP("QAN",$J,QAN0,"CASE")),?30,"Incident: ",$G(^TMP("QAN",$J,QAN0,"INCD"))
70 W !,"Date: ",$G(^TMP("QAN",$J,QAN0,"DATE")),?30,"Patient: ",$G(^TMP("QAN",$J,QAN0,QAN1,"PAT"))
71 Q
72PAT ;Patient information
73 S QANZER0=$G(^QA(742,QANDFN,0)) Q:QANZER0']""
74 S QANPRS=+$P(QANZER0,U,12),QANPT=+$P(QANZER0,U)
75 I $G(^DPT(QANPT,0))]"" S QANPAT=$P(^DPT(QANPT,0),U)_$S(QANPRS<0:" (d)",QANPRS=0:" (c)",1:"")
76 I $G(^DPT(QANPT,0))']"" S QANPAT="N/A"
77 S ^TMP("QAN",$J,QANIEN,QANDFN,"PAT")=QANPAT
78 Q
79ZLOOP ;Ztsave variable for ^%ZTLOAD
80 F QA="QA*","^TMP(""QAN"",$J," S ZTSAVE(QA)=""
81 Q
82DIV ;
83 S (QANBB,QANOK)=0
84 F S QANBB=$O(^QA(740,1,"QAN2",QANBB)) Q:QANBB'>0!($G(QANOK)) D
85 . I QANDIV=^QA(740,1,"QAN2",QANBB,0) S QANOK=1
86 I $G(QANOK)'=1 S QANDIV=0
87 S QANOK=0
88 Q
Note: See TracBrowser for help on using the repository browser.