source: WorldVistAEHR/trunk/r/INCIDENT_REPORTING-QAN/QANEWS.m@ 699

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

initial load of WorldVistAEHR

File size: 3.5 KB
Line 
1QANEWS ;HISC/GJC-EARLY WARNING SYSTEM ;6/18/91
2 ;;2.0;Incident Reporting;**14**;08/07/1992
3 ;
4EN1 ;Check date range.
5 D ^QAQDATE I QAQQUIT W !!,*7,"Invalid date range, no report will be produced." Q
6EN2 ;Check dates.
7 S (QANIN,QANOUT)=0
8 F QAN=0:0 S QAN=$O(^QA(742.4,QAN)) Q:QAN'>0 S QANZER0=$G(^QA(742.4,QAN,0)) I QANZER0]"" S QANDATE=$P(QANZER0,U,3) I QANDATE'<QAQNBEG,(QANDATE'>QAQNEND),(+$P(QANZER0,U,2)=1) S ^UTILITY($J,"QAN DATE",QAN)=""
9 S QAN1="" F QAN=0:0 S QAN=+$O(^UTILITY($J,"QAN DATE",QAN)) Q:QAN=0 S QAN1=+$O(^QA(742,"BCS",QAN,QAN1)) Q:QAN1=0 S QANZERO=$G(^QA(742,QAN1,0)) I QANZERO]"" D TAB
10 D BULL
11KILL D KILL^QAQDATE K C,QAN,QANNCDT,QANINC0,QANIPAT,QANZER0,QANZERO,Y,^UTILITY($J)
12 Q
13BULL ;
14 D KILL^XM S QANAFRM=+$S($D(^QA(740,1,"QAN"))#2:$P(^("QAN"),U,2),1:"")
15 S QANSIEN=+$P(^QA(740,1,0),U) W:QANSIEN'>0 !!,"Site not specified, chec the QA Site Parameter File." Q:QANSIEN'>0
16 S QANMIEN=+$S($D(^QA(740,1,"QAN"))#2:$P(^("QAN"),U),1:"") Q:QANAFRM'>0!(QANMIEN'>0)
17 S XMY(QANSERV_"@"_QANDOM)=""
18 S XMSUB=^DD("SITE")_" ("_^DD("SITE",1)_") QAN INCIDENT EVENT",XMDUZ=.5
19 I $D(^DIC(4,QANSIEN,0)) S X="Suicide^"_$P(^DIC(4,QANSIEN,0),U)_"^"_$S($D(^DIC(4,QANSIEN,99))#2:$P(^DIC(4,QANSIEN,99),U),1:""),QANMAIL(1)=$S(X]"":X,1:"")
20 S X=QAQNBEG_"^"_QAQNEND,QANMAIL(2)=$S(+X?1N.N:X,1:"")
21 S X=$S(QANIN>0:QANIN,1:0) S QANMAIL(3)=X
22 S X=$S(QANOUT>0:QANOUT,1:0) S QANMAIL(4)=X
23 S ^UTILITY($J,1)=QANMAIL(1)_"^"_QANMAIL(2)_"^"_QANMAIL(3)_"^"_QANMAIL(4)_"^"
24 S XMTEXT="^UTILITY($J," D ^XMD,KILL^XM K X,Y,XMB,QANMAIL,QANAFRM,QANMIEN,QANSIEN,QANSITE,XMHOLD,XMANS,XMDUZ,XMSUB,XMTEXT,XMY
25 Q
26TAB ;
27 S:$P(QANZERO,U,6)']"" QANOUT=QANOUT+1
28 S:$P(QANZERO,U,6)]"" QANIN=QANIN+1
29 Q
30HDR ;Header
31 I ($E(IOST,1)="C"),(PAGE) K DIR S DIR(0)="E" D ^DIR K DIR S:+Y=0 QAXIT=1
32 Q:QAXIT W:$Y @IOF S PAGE=PAGE+1
33 W !,"Date: ",TODAY,?$S(IOM=132:107,1:65),"Page: ",PAGE
34 W !!?(IOM-$L(HEAD(1))\2),HEAD(1),!?(IOM-$L(HEAD(0))\2),HEAD(0)
35 W !?(IOM-$L(HEAD(10))\2),HEAD(10)
36 W !!,HEAD(2),?10,HEAD(3),?45,HEAD(4),?60,HEAD(5),!
37 W $S(IOM=132:HEAD(7),1:HEAD(6)),!
38 Q
39CHECK ;Checks for inaccurate patient data; part of patch QAN*2*14.
40 S (PAGE,QAXIT)=0,Y=DT X ^DD("DD") S TODAY=Y
41 S HEAD(0)="For mismatched patients and patient identifiers."
42 S HEAD(1)="QA Incident Reporting Patient List"
43 S HEAD(10)="(Where 'number' is the internal entry number in file 742.)"
44 S HEAD(2)="Number",HEAD(3)="Patient",HEAD(4)="SSN",HEAD(5)="Patient ID"
45 S $P(HEAD(6),"_",81)="",$P(HEAD(7),"_",133)=""
46 W !?5,"This routine will check the accuracy of the patient data." H 5
47 K IOP,%ZIS S %ZIS("A")="Print on device: ",%ZIS="Q" W ! D ^%ZIS
48 I POP D TERM Q
49 I $D(IO("Q")) D G XIT
50 . S ZTRTN="STRT^QANEWS"
51 . S ZTDESC="Print for QAN mismatched patients and patient identifiers."
52 . S (ZTSAVE("HEAD("),ZTSAVE("PAGE"),ZTSAVE("QAXIT"),ZTSAVE("TODAY"))=""
53 . D ^%ZTLOAD W !,$S($D(ZTSK):"Request queued properly.",1:"Queue request failed.")
54STRT U IO D HDR
55 F QA=0:0 S QA=$O(^QA(742,QA)) Q:QA'>0!(QAXIT) D
56 . S QA742=$G(^QA(742,QA,0)) Q:QA742']""
57 . S QAINC=+$P(QA742,U,3) Q:'QAINC
58 . S QA7424=$G(^QA(742.4,QAINC,0)) Q:QA7424']""
59 . S CASE=$P(QA7424,U) Q:$E($P(CASE,"."),$L($P(CASE,".")),999)?1L
60 . S QADPT=$G(^DPT(+$P(QA742,U),0)) Q:QADPT']""
61 . S QAPAT=$P(QADPT,U),QASSN=$P(QADPT,U,9),QAPID=$P(QA742,U,2)
62 . S PID=$E($P(QAPAT,",",2))_$E($P(QAPAT," ",2))_$E($P(QAPAT,","))_$E(QASSN,6,9)
63 . I QAPID'=PID D
64 .. W !,QA,?10,QAPAT,?45,QASSN,?60,QAPID
65 . D:$Y>(IOSL-4) HDR Q:QAXIT
66XIT W ! D ^%ZISC,HOME^%ZIS
67TERM K CASE,HEAD,PAGE,PID,QA,QA742,QA7424,QADPT,QAINC,QAXIT,QAPAT,QAPID
68 K DIRUT,DTOUT,DUOUT,DIROUT,QASSN,TODAY,X,Y,ZTDESC,ZTRTN,ZTSAVE,ZTSK
69 Q
Note: See TracBrowser for help on using the repository browser.