source: WorldVistAEHR/trunk/r/OCCURRENCE_SCREEN-QAO/QAOSSFR1.m@ 1211

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

initial load of WorldVistAEHR

File size: 3.2 KB
Line 
1QAOSSFR1 ;HISC/DAD-OCCURRENCE SCREEN / MONITORING SYSTEM AUTO ENROLL SPECIAL FUNCTIONS ROUTINE ;11/8/93 09:54
2 ;;3.0;Occurrence Screen;**4**;09/14/1993
3 ;
4PRINT ; QUEUE PRINTING OF REPORTS
5 S QAOSDFLT=$P(QAOS740,"^",5)
6 I $P(QAOS740,"^",9) D
7 . F QAOSDIVN=0:0 S QAOSDIVN=$O(^QA(740,1,"OS2",QAOSDIVN)) Q:QAOSDIVN'>0 D
8 .. S ZTIO=$P(^QA(740,1,"OS2",QAOSDIVN,0),"^",2)
9 .. S ZTIO=$S(ZTIO]"":ZTIO,1:QAOSDFLT)
10 .. D QPRINT(ZTIO,QAOSDIVN)
11 .. K ^TMP("QAO",$J,"RPT",QAOSDIVN)
12 .. K ^TMP("QAO",$J,"WKS",QAOSDIVN)
13 .. Q
14 . I $D(^TMP("QAO",$J,"WKS"))!$D(^TMP("QAO",$J,"WKS")) D
15 .. D QPRINT(QAOSDFLT,"*")
16 .. Q
17 . Q
18 E D QPRINT(QAOSDFLT,"*")
19 Q
20 ;
21QPRINT(ZTIO,DIVISION) ; OUTPUT DEVICE , DIVISION (* = ALL)
22 Q:ZTIO="" S ZTRTN="ENTSK^QAOSSFR1",ZTDTH=$H
23 S (ZTSAVE("QAMTODAY"),ZTSAVE("QAOSSCRN"))="",ZTSAVE("QAOSDIVN")=DIVISION
24 I DIVISION="*" D
25 . S ZTSAVE("^TMP(""QAO"",$J,""RPT"",")=""
26 . S ZTSAVE("^TMP(""QAO"",$J,""WKS"",")=""
27 . Q
28 E D
29 . S ZTSAVE("^TMP(""QAO"",$J,""RPT"","_DIVISION_",")=""
30 . S ZTSAVE("^TMP(""QAO"",$J,""WKS"","_DIVISION_",")=""
31 . Q
32 S ZTDESC="Occurrence Screen auto enroll output"
33 D ^%ZTLOAD
34 Q
35 ;
36ENTSK ; TASKED ENTRY POINT FOR PRINT
37 U IO
38 K QAOSUNDL S $P(QAOSUNDL,"-",81)="",QAOSPAGE=1,QAOCOUNT=0
39 S %DT="",X="T" D ^%DT X ^DD("DD") S QAOTODAY=$P(Y,"@",1)
40 S QAOSSCRN(0)=$P($G(^QA(741.1,QAOSSCRN,0)),"^",2)
41 S Y=QAMTODAY\1 X ^DD("DD") S QAOSOCDT=Y
42 I $O(^TMP("QAO",$J,"RPT",""))="" D G DONE
43 . D HEAD
44 . W !,"No patients found meeting this screen."
45 . Q
46 S QAOSDVN=""
47 F S QAOSDVN=$O(^TMP("QAO",$J,"RPT",QAOSDVN)) Q:QAOSDVN="" D
48 . S QAOSDVN(0)=$P($G(^DG(40.8,+QAOSDVN,0)),"^")
49 . D HEAD S QAOSPAT=""
50 . F S QAOSPAT=$O(^TMP("QAO",$J,"RPT",QAOSDVN,QAOSPAT)) Q:QAOSPAT="" D
51 .. F QAOSD0=0:0 S QAOSD0=$O(^TMP("QAO",$J,"RPT",QAOSDVN,QAOSPAT,QAOSD0)) Q:QAOSD0'>0 D
52 ... D:$Y>(IOSL-6) HEAD S X=^TMP("QAO",$J,"RPT",QAOSDVN,QAOSPAT,QAOSD0)
53 ... W !!,QAOSPAT,?34,$P(X,"^")
54 ... W ?49,$S($D(^SC(+$P(X,"^",2),0))#2:$P(^(0),"^"),1:$P(X,"^",2))
55 ... W !?3,$P(X,"^",3) S Y=$P(X,"^",4) X ^DD("DD") W ?37,Y
56 ... S QAOCOUNT=QAOCOUNT+1
57 ... Q
58 .. Q
59 . Q
60DONE ;
61 W !!,"Number of occurrences: ",QAOCOUNT,!,@IOF
62 I $O(^TMP("QAO",$J,"WKS",""))]"",$P($G(^QA(740,1,"OS")),"^",4) D
63 . S QAOSDVN="",(QAOSDATA,QAOSHOW)=1,QAOSQUIT=0
64 . F S QAOSDVN=$O(^TMP("QAO",$J,"WKS",QAOSDVN)) Q:QAOSDVN="" D
65 .. S QAOSPAT=""
66 .. F S QAOSPAT=$O(^TMP("QAO",$J,"WKS",QAOSDVN,QAOSPAT)) Q:QAOSPAT="" D
67 ... F QAOSD0=0:0 S QAOSD0=$O(^TMP("QAO",$J,"WKS",QAOSDVN,QAOSPAT,QAOSD0)) Q:QAOSD0'>0 D ^QAOSPCL0,^QAOSPCL1
68 ... Q
69 .. Q
70 . Q
71 S IONOFF=1 D ^%ZISC
72 K %DT,IONOFF,QAMTODAY,QAOCOUNT,QAOSD0,QAOSDATA,QAOSOCDT,QAOSPAGE,QAOSPAT
73 K QAOSQUIT,QAOSSCRN,QAOSUNDL,QAOTODAY,X,Y,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
74 K ^TMP("QAO",$J)
75 S:$D(ZTQUEUED) ZTREQ="@"
76 Q
77HEAD ;
78 W:(QAOSPAGE>1)!($E(IOST)="C") @IOF
79 W !!?20,"AUTO ENROLLED OCCURRENCE SCREEN PATIENTS",?65,QAOTODAY,!?26,"OCCURRENCE DATE: ",QAOSOCDT,?65,"PAGE: ",QAOSPAGE
80 S X=$S($G(QAOSDVN(0))]"":QAOSDVN(0),"*"'[$G(QAOSDIVN):$P($G(^DG(40.8,+$G(QAOSDIVN),0)),"^"),1:"")
81 I X]"" S X="DIVISION: "_X W !?80-$L(X)/2,X
82 S QAOSPAGE=QAOSPAGE+1 D EN6^QAQAUTL
83 W !," (* Denotes that this occurrence has already been entered into the system)"
84 W !!,"Patient Name",?34,"SSN",?49,"Ward/Clinic",!?3,"Admitting Diagnosis",?37,"Previous Movement",!,QAOSUNDL
85 W !!?5,"Screen: ",QAOSSCRN," ",QAOSSCRN(0),!
86 Q
Note: See TracBrowser for help on using the repository browser.