source: FOIAVistA/trunk/r/OCCURRENCE_SCREEN-QAO/QAOSPWT0.m@ 1166

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

initial load of FOIAVistA 6/30/08 version

File size: 2.8 KB
Line 
1QAOSPWT0 ;HISC/DAD-PATIENTS AWAITING CLINICAL REVIEW ;4/30/93 09:41
2 ;;3.0;Occurrence Screen;;09/14/1993
3 K DIR S DIR(0)="SOM^C:Current Ward/Clinic;O:Occurrence Ward/Clinic"
4 S DIR("A")="Sort report by",DIR("B")="Current Ward/Clinic"
5 S DIR("?",1)="",DIR("?")=" Enter the desired sorting method."
6 W ! D ^DIR G:$D(DIRUT) EXIT S QAOSSORT=Y
7 D ^QAQDATE G:QAQQUIT EXIT
8DEV ;
9 K ^TMP($J,"QAOSPWT"),IOP,%ZIS S %ZIS="QM" D ^%ZIS G:POP EXIT
10 I $D(IO("Q")) D G EXIT
11 . S ZTRTN="ENTSK^QAOSPWT0",ZTDESC="Patients awaiting clinical review"
12 . S ZTSAVE("QAQ*")="",ZTSAVE("QAOSSORT")="" D ^%ZTLOAD
13 . Q
14ENTSK ;
15 S QAOSCLIN=$O(^QA(741.2,"C",1,0))
16 F QAOSD0=0:0 S QAOSD0=$O(^QA(741,"AD",0,QAOSD0)) Q:QAOSD0'>0 I '$D(^QA(741,QAOSD0,"REVR","B",QAOSCLIN)) D
17 . S LOC=$G(^QA(741,QAOSD0,0)),SCRN=$G(^("SCRN")) Q:LOC=""!(SCRN="")
18 . S NAME=+LOC,SSN=""
19 . S:$D(^DPT(NAME,0))#2 NAME=$P(^(0),"^"),SSN=$P(^(0),"^",9)
20 . S DATE=$P(LOC,"^",3)
21 . S CURWARD=$S($D(^DPT(+LOC,.1))#2:^(.1),1:"~UNKNOWN")
22 . S OCCWARD=+$P(LOC,"^",5),OCCWARD=$P($G(^SC(OCCWARD,0)),"^")
23 . S:OCCWARD="" OCCWARD="~UNKNOWN"
24 . S SCRNTXT=""
25 . Q:(DATE<QAQNBEG)!(DATE>QAQNEND)
26 . S:$D(^QA(741.1,SCRN,0))#2 SCRN=+^(0),SCRNTXT=$P(^(0),"^",2)
27 . I QAOSSORT="C" S WRD=CURWARD,X=SCRNTXT_"^"_SSN_"^"_OCCWARD
28 . E S WRD=OCCWARD,X=SCRNTXT_"^"_SSN_"^"_CURWARD
29 . S ^TMP($J,"QAOSPWT",WRD,SCRN,DATE,NAME)=X
30 . Q
31 S QAOSQUIT=0,PAGE=1,Y=DT X ^DD("DD") S TODAY=Y
32 K UNDL S $P(UNDL,"-",80)="-"
33 U IO D HEAD
34 I '$D(^TMP($J,"QAOSPWT")) W !!,"NO PATIENTS FOUND AWAITING CLINICAL REVIEW" G EXIT
35 S WARD="" F S WARD=$O(^TMP($J,"QAOSPWT",WARD)) Q:WARD=""!QAOSQUIT F SCRN=0:0 S SCRN=$O(^TMP($J,"QAOSPWT",WARD,SCRN)) Q:SCRN'>0!QAOSQUIT F DATE=0:0 S DATE=$O(^TMP($J,"QAOSPWT",WARD,SCRN,DATE)) Q:DATE'>0!QAOSQUIT D
36 . S NAME=""
37 . F NAM=0:0 S NAME=$O(^TMP($J,"QAOSPWT",WARD,SCRN,DATE,NAME)) Q:NAME=""!QAOSQUIT D
38 .. S LOC=^TMP($J,"QAOSPWT",WARD,SCRN,DATE,NAME)
39 .. S SCRNTXT=$P(LOC,"^"),SSN=$P(LOC,"^",2),Y=DATE X ^DD("DD") S Y=$P(Y,"@")
40 .. S X=$P(LOC,"^",3),WARD(0)=$S(X["~":$P(X,"~",2),1:X)
41 .. W !!,NAME,?33,SSN,?45,Y,?59,$S(WARD["~":$P(WARD,"~",2),1:WARD)
42 .. W !?1,SCRN,?8,$E(SCRNTXT,1,50),?59,WARD(0)
43 .. I $Y>(IOSL-4) D:$E(IOST)="C" PAUSE D:'QAOSQUIT HEAD
44 .. Q
45 . Q
46EXIT ;
47 W ! D ^%ZISC K %ZIS,DATE,LOC,NAM,NAME,PAGE,POP,QAOSCLIN,QAOSD0,QAOSQUIT
48 K SCRN,SCRNTXT,SSN,TODAY,UNDL,WARD,WRD,X,Y,ZTDESC,ZTRTN,ZTSAVE,QAOSSORT
49 K D,I,Y,Z,OCCWARD,CURWARD,DIR,DIRUT,DTOUT,DUOUT,^TMP($J,"QAOSPWT")
50 D K^QAQDATE S:$D(ZTQUEUED) ZTREQ="@"
51 Q
52HEAD ;
53 W:(PAGE>1)!($E(IOST)="C") @IOF
54 W !!?23,"PATIENTS AWAITING CLINICAL REVIEW",?68,TODAY
55 W !?QAQTART,QAQ2HED,?68,"PAGE: ",PAGE S PAGE=PAGE+1
56 D EN6^QAQAUTL
57 W !,"PATIENT / SCREEN",?33,"SSN",?45,"DATE"
58 W ?59,$S(QAOSSORT="C":"CURR/OCCUR",1:"OCCUR/CURR")," WARD/CLIN"
59 W !,UNDL
60 Q
61PAUSE ;
62 K DIR S DIR(0)="E" D ^DIR K DIR S QAOSQUIT=$S(Y'>0:1,1:0)
63 Q
Note: See TracBrowser for help on using the repository browser.