| 1 | QAOSPWT0 ;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
|
|---|
| 8 | DEV ;
|
|---|
| 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
|
|---|
| 14 | ENTSK ;
|
|---|
| 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
|
|---|
| 46 | EXIT ;
|
|---|
| 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
|
|---|
| 52 | HEAD ;
|
|---|
| 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
|
|---|
| 61 | PAUSE ;
|
|---|
| 62 | K DIR S DIR(0)="E" D ^DIR K DIR S QAOSQUIT=$S(Y'>0:1,1:0)
|
|---|
| 63 | Q
|
|---|
