source: FOIAVistA/trunk/r/INCIDENT_REPORTING-QAN/QANUTL6.m@ 812

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

initial load of FOIAVistA 6/30/08 version

File size: 2.8 KB
Line 
1QANUTL6 ;HISC/GJC-DATA INQUIRY FOR PATIENT/INCIDENT ;2/3/92
2 ;;2.0;Incident Reporting;**12**;08/07/1992
3 ;
4 K DIC,DO,DINUM,DLAYGO,^UTILITY("DIQ1",$J)
5 S QANTAB=$S(IOM=132:133,1:81),$P(QANLINE,"*",QANTAB)=""
6 S DIC="^QA(742,",DIC(0)="QEAMZ",DIC("A")="Select Patient: ",D="B^BS5"
7 S DIC("W")="D DICW^QANUTL6" D MIX^DIC1 K DIC,DO,DINUM,DLAYGO
8 I +Y'>0 D KILL Q
9 S QANDFN=+Y,QAN742=$G(^QA(742,QANDFN,0))
10 S QANIEN=$P(QAN742,U,3),QAN7424=$G(^QA(742.4,QANIEN,0))
11 S QANHEAD(0)="PATIENT/INCIDENT DATA INQUIRY REPORT"
12 S Y=$P(QAN742,U),C=$P(^DD(742,.01,0),U,2) D:Y]"" Y^DIQ S QANPAT=Y
13 S Y=$P(QAN7424,U,2),C=$P(^DD(742.4,.02,0),U,2) D:Y]"" Y^DIQ S QANINCD=Y
14 S Y=$P(QAN7424,U,3) D D^DIQ S QANDATE=Y
15 S QANHEAD(1)="For Patient: "_QANPAT
16 S QANHEAD(2)="Incident: "_QANINCD_" On Date: "_QANDATE
17 ;Patient data
18 S DIC="^QA(742,",DR=".01:.11;.13;.14",DA=QANDFN,DIQ(0)="E" D EN^DIQ1
19 I $D(^QA(742,QANDFN,1,0)) D RSERV
20 I $D(^QA(742,QANDFN,2,0)) D IRDIAG
21 ;Incident data
22 S DIC="^QA(742.4,",DR=".02:.15;.17:.22",DA=QANIEN,DIQ(0)="E" D EN^DIQ1
23 I $D(^QA(742.4,QANIEN,2,0)) D MEDCNTR
24 K DIC,DA,DR,DIQ
25TASK ;Call to %ZTLOAD.
26 S Y=DT X ^DD("DD") S TODAY=Y,(PAGE,QANQUIT)=0
27 K IOP,%ZIS S %ZIS("A")="Print on device: ",%ZIS="MQ" W ! D ^%ZIS W !!
28 G:POP KILL
29 I $D(IO("Q")) S ZTRTN="START^QANUTL6",ZTDESC="Patient/Incident Data Inquiry Report." D QLOOP,^%ZTLOAD W !,$S($D(ZTSK):"Request Queued!",1:"Request Cancelled!"),! G EXIT
30START ;IO requests
31 U IO D HDR,EN1^QANUTL7
32EXIT ;
33 W ! D ^%ZISC,HOME^%ZIS
34KILL ;Kill and quit.
35 K %ZIS,C,D,DA,DIC,DIQ,DR,IW,PAGE,POP,QAN742,QAN7424,QANDATE,QANDFN
36 K QANHEAD,QANIEN,QANINCD,QANLINE,QANPAT,QANTAB,TODAY,X,Y,ZTDESC,ZTRTN
37 K QANX,QANY,QANZ,QANDD,QANQUIT,QANUTIL,ZTSK,%W,D0,DIQ2,QANCASE,QANW
38 K QAHDNM,QAHDSSN,QAHOLD,^UTILITY("DIQ1",$J)
39 Q
40DICW ;Data display on lookups.
41 S QANIEN=$P(^QA(742,+Y,0),U,3),QAN7424=$G(^QA(742.4,QANIEN,0))
42 N Y S Y=$P(QAN7424,U,3) D D^DIQ S QANDATE=Y,Y=$P(QAN7424,U,2)
43 S C=$P(^DD(742.4,.02,0),U,2) D:Y]"" Y^DIQ S QANINCD=Y
44 S QANCASE=$P(QAN7424,U)
45 W " "_QANINCD_" "_QANDATE_" "_QANCASE
46 Q
47HDR ;Header
48 S PAGE=PAGE+1 W @IOF,!?69,TODAY,!?69,"Page: ",PAGE,!!
49 W ?(IOM-$L(QANHEAD(0))\2),QANHEAD(0),!,?(IOM-$L(QANHEAD(1))\2),QANHEAD(1),!
50 W !?(IOM-$L(QANHEAD(2))\2),QANHEAD(2),!!
51 F IW=1:1:2 W QANLINE,!
52 Q
53IRDIAG ;Data for Incident Related Diagnosis
54 F DA=0:0 S DIC="^QA(742,"_QANDFN_",2,",DR=.01,DA(1)=QANDFN,DIQ(0)="E",DA=$O(^QA(742,QANDFN,2,DA)) Q:DA'>0 D EN^DIQ1
55 Q
56MEDCNTR ;Data for Medical Center Action
57 F DA=0:0 S DIC="^QA(742.4,"_QANIEN_",2,",DR=.01,DA(1)=QANIEN,DIQ(0)="E",DA=$O(^QA(742.4,QANIEN,2,DA)) Q:DA'>0 D EN^DIQ1
58 Q
59RSERV ;Data for Responsible Service
60 F DA=0:0 S DIC="^QA(742,"_QANDFN_",1,",DR=.01,DA(1)=QANDFN,DIQ(0)="E",DA=$O(^QA(742,QANDFN,1,DA)) Q:DA'>0 D EN^DIQ1
61 Q
62QLOOP ;Save variables.
63 F IW="^UTILITY(""DIQ1"",$J,","PAGE","TODAY","QAN*" S ZTSAVE(IW)=""
64 Q
Note: See TracBrowser for help on using the repository browser.