QAOSPWT0 ;HISC/DAD-PATIENTS AWAITING CLINICAL REVIEW ;4/30/93 09:41
;;3.0;Occurrence Screen;;09/14/1993
K DIR S DIR(0)="SOM^C:Current Ward/Clinic;O:Occurrence Ward/Clinic"
S DIR("A")="Sort report by",DIR("B")="Current Ward/Clinic"
S DIR("?",1)="",DIR("?")=" Enter the desired sorting method."
W ! D ^DIR G:$D(DIRUT) EXIT S QAOSSORT=Y
D ^QAQDATE G:QAQQUIT EXIT
DEV ;
K ^TMP($J,"QAOSPWT"),IOP,%ZIS S %ZIS="QM" D ^%ZIS G:POP EXIT
I $D(IO("Q")) D G EXIT
. S ZTRTN="ENTSK^QAOSPWT0",ZTDESC="Patients awaiting clinical review"
. S ZTSAVE("QAQ*")="",ZTSAVE("QAOSSORT")="" D ^%ZTLOAD
. Q
ENTSK ;
S QAOSCLIN=$O(^QA(741.2,"C",1,0))
F QAOSD0=0:0 S QAOSD0=$O(^QA(741,"AD",0,QAOSD0)) Q:QAOSD0'>0 I '$D(^QA(741,QAOSD0,"REVR","B",QAOSCLIN)) D
. S LOC=$G(^QA(741,QAOSD0,0)),SCRN=$G(^("SCRN")) Q:LOC=""!(SCRN="")
. S NAME=+LOC,SSN=""
. S:$D(^DPT(NAME,0))#2 NAME=$P(^(0),"^"),SSN=$P(^(0),"^",9)
. S DATE=$P(LOC,"^",3)
. S CURWARD=$S($D(^DPT(+LOC,.1))#2:^(.1),1:"~UNKNOWN")
. S OCCWARD=+$P(LOC,"^",5),OCCWARD=$P($G(^SC(OCCWARD,0)),"^")
. S:OCCWARD="" OCCWARD="~UNKNOWN"
. S SCRNTXT=""
. Q:(DATE<QAQNBEG)!(DATE>QAQNEND)
. S:$D(^QA(741.1,SCRN,0))#2 SCRN=+^(0),SCRNTXT=$P(^(0),"^",2)
. I QAOSSORT="C" S WRD=CURWARD,X=SCRNTXT_"^"_SSN_"^"_OCCWARD
. E S WRD=OCCWARD,X=SCRNTXT_"^"_SSN_"^"_CURWARD
. S ^TMP($J,"QAOSPWT",WRD,SCRN,DATE,NAME)=X
. Q
S QAOSQUIT=0,PAGE=1,Y=DT X ^DD("DD") S TODAY=Y
K UNDL S $P(UNDL,"-",80)="-"
U IO D HEAD
I '$D(^TMP($J,"QAOSPWT")) W !!,"NO PATIENTS FOUND AWAITING CLINICAL REVIEW" G EXIT
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
. S NAME=""
. F NAM=0:0 S NAME=$O(^TMP($J,"QAOSPWT",WARD,SCRN,DATE,NAME)) Q:NAME=""!QAOSQUIT D
.. S LOC=^TMP($J,"QAOSPWT",WARD,SCRN,DATE,NAME)
.. S SCRNTXT=$P(LOC,"^"),SSN=$P(LOC,"^",2),Y=DATE X ^DD("DD") S Y=$P(Y,"@")
.. S X=$P(LOC,"^",3),WARD(0)=$S(X["~":$P(X,"~",2),1:X)
.. W !!,NAME,?33,SSN,?45,Y,?59,$S(WARD["~":$P(WARD,"~",2),1:WARD)
.. W !?1,SCRN,?8,$E(SCRNTXT,1,50),?59,WARD(0)
.. I $Y>(IOSL-4) D:$E(IOST)="C" PAUSE D:'QAOSQUIT HEAD
.. Q
. Q
EXIT ;
W ! D ^%ZISC K %ZIS,DATE,LOC,NAM,NAME,PAGE,POP,QAOSCLIN,QAOSD0,QAOSQUIT
K SCRN,SCRNTXT,SSN,TODAY,UNDL,WARD,WRD,X,Y,ZTDESC,ZTRTN,ZTSAVE,QAOSSORT
K D,I,Y,Z,OCCWARD,CURWARD,DIR,DIRUT,DTOUT,DUOUT,^TMP($J,"QAOSPWT")
D K^QAQDATE S:$D(ZTQUEUED) ZTREQ="@"
Q
HEAD ;
W:(PAGE>1)!($E(IOST)="C") @IOF
W !!?23,"PATIENTS AWAITING CLINICAL REVIEW",?68,TODAY
W !?QAQTART,QAQ2HED,?68,"PAGE: ",PAGE S PAGE=PAGE+1
D EN6^QAQAUTL
W !,"PATIENT / SCREEN",?33,"SSN",?45,"DATE"
W ?59,$S(QAOSSORT="C":"CURR/OCCUR",1:"OCCUR/CURR")," WARD/CLIN"
W !,UNDL
Q
PAUSE ;
K DIR S DIR(0)="E" D ^DIR K DIR S QAOSQUIT=$S(Y'>0:1,1:0)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAOSPWT0 2887 printed Oct 16, 2024@18:22:45 Page 2
QAOSPWT0 ;HISC/DAD-PATIENTS AWAITING CLINICAL REVIEW ;4/30/93 09:41
+1 ;;3.0;Occurrence Screen;;09/14/1993
+2 KILL DIR
SET DIR(0)="SOM^C:Current Ward/Clinic;O:Occurrence Ward/Clinic"
+3 SET DIR("A")="Sort report by"
SET DIR("B")="Current Ward/Clinic"
+4 SET DIR("?",1)=""
SET DIR("?")=" Enter the desired sorting method."
+5 WRITE !
DO ^DIR
if $DATA(DIRUT)
GOTO EXIT
SET QAOSSORT=Y
+6 DO ^QAQDATE
if QAQQUIT
GOTO EXIT
DEV ;
+1 KILL ^TMP($JOB,"QAOSPWT"),IOP,%ZIS
SET %ZIS="QM"
DO ^%ZIS
if POP
GOTO EXIT
+2 IF $DATA(IO("Q"))
Begin DoDot:1
+3 SET ZTRTN="ENTSK^QAOSPWT0"
SET ZTDESC="Patients awaiting clinical review"
+4 SET ZTSAVE("QAQ*")=""
SET ZTSAVE("QAOSSORT")=""
DO ^%ZTLOAD
+5 QUIT
End DoDot:1
GOTO EXIT
ENTSK ;
+1 SET QAOSCLIN=$ORDER(^QA(741.2,"C",1,0))
+2 FOR QAOSD0=0:0
SET QAOSD0=$ORDER(^QA(741,"AD",0,QAOSD0))
if QAOSD0'>0
QUIT
IF '$DATA(^QA(741,QAOSD0,"REVR","B",QAOSCLIN))
Begin DoDot:1
+3 SET LOC=$GET(^QA(741,QAOSD0,0))
SET SCRN=$GET(^("SCRN"))
if LOC=""!(SCRN="")
QUIT
+4 SET NAME=+LOC
SET SSN=""
+5 if $DATA(^DPT(NAME,0))#2
SET NAME=$PIECE(^(0),"^")
SET SSN=$PIECE(^(0),"^",9)
+6 SET DATE=$PIECE(LOC,"^",3)
+7 SET CURWARD=$SELECT($DATA(^DPT(+LOC,.1))#2:^(.1),1:"~UNKNOWN")
+8 SET OCCWARD=+$PIECE(LOC,"^",5)
SET OCCWARD=$PIECE($GET(^SC(OCCWARD,0)),"^")
+9 if OCCWARD=""
SET OCCWARD="~UNKNOWN"
+10 SET SCRNTXT=""
+11 if (DATE<QAQNBEG)!(DATE>QAQNEND)
QUIT
+12 if $DATA(^QA(741.1,SCRN,0))#2
SET SCRN=+^(0)
SET SCRNTXT=$PIECE(^(0),"^",2)
+13 IF QAOSSORT="C"
SET WRD=CURWARD
SET X=SCRNTXT_"^"_SSN_"^"_OCCWARD
+14 IF '$TEST
SET WRD=OCCWARD
SET X=SCRNTXT_"^"_SSN_"^"_CURWARD
+15 SET ^TMP($JOB,"QAOSPWT",WRD,SCRN,DATE,NAME)=X
+16 QUIT
End DoDot:1
+17 SET QAOSQUIT=0
SET PAGE=1
SET Y=DT
XECUTE ^DD("DD")
SET TODAY=Y
+18 KILL UNDL
SET $PIECE(UNDL,"-",80)="-"
+19 USE IO
DO HEAD
+20 IF '$DATA(^TMP($JOB,"QAOSPWT"))
WRITE !!,"NO PATIENTS FOUND AWAITING CLINICAL REVIEW"
GOTO EXIT
+21 SET WARD=""
FOR
SET WARD=$ORDER(^TMP($JOB,"QAOSPWT",WARD))
if WARD=""!QAOSQUIT
QUIT
FOR SCRN=0:0
SET SCRN=$ORDER(^TMP($JOB,"QAOSPWT",WARD,SCRN))
if SCRN'>0!QAOSQUIT
QUIT
FOR DATE=0:0
SET DATE=$ORDER(^TMP($JOB,"QAOSPWT",WARD,SCRN,DATE))
if DATE'>0!QAOSQUIT
QUIT
Begin DoDot:1
+22 SET NAME=""
+23 FOR NAM=0:0
SET NAME=$ORDER(^TMP($JOB,"QAOSPWT",WARD,SCRN,DATE,NAME))
if NAME=""!QAOSQUIT
QUIT
Begin DoDot:2
+24 SET LOC=^TMP($JOB,"QAOSPWT",WARD,SCRN,DATE,NAME)
+25 SET SCRNTXT=$PIECE(LOC,"^")
SET SSN=$PIECE(LOC,"^",2)
SET Y=DATE
XECUTE ^DD("DD")
SET Y=$PIECE(Y,"@")
+26 SET X=$PIECE(LOC,"^",3)
SET WARD(0)=$SELECT(X["~":$PIECE(X,"~",2),1:X)
+27 WRITE !!,NAME,?33,SSN,?45,Y,?59,$SELECT(WARD["~":$PIECE(WARD,"~",2),1:WARD)
+28 WRITE !?1,SCRN,?8,$EXTRACT(SCRNTXT,1,50),?59,WARD(0)
+29 IF $Y>(IOSL-4)
if $EXTRACT(IOST)="C"
DO PAUSE
if 'QAOSQUIT
DO HEAD
+30 QUIT
End DoDot:2
+31 QUIT
End DoDot:1
EXIT ;
+1 WRITE !
DO ^%ZISC
KILL %ZIS,DATE,LOC,NAM,NAME,PAGE,POP,QAOSCLIN,QAOSD0,QAOSQUIT
+2 KILL SCRN,SCRNTXT,SSN,TODAY,UNDL,WARD,WRD,X,Y,ZTDESC,ZTRTN,ZTSAVE,QAOSSORT
+3 KILL D,I,Y,Z,OCCWARD,CURWARD,DIR,DIRUT,DTOUT,DUOUT,^TMP($JOB,"QAOSPWT")
+4 DO K^QAQDATE
if $DATA(ZTQUEUED)
SET ZTREQ="@"
+5 QUIT
HEAD ;
+1 if (PAGE>1)!($EXTRACT(IOST)="C")
WRITE @IOF
+2 WRITE !!?23,"PATIENTS AWAITING CLINICAL REVIEW",?68,TODAY
+3 WRITE !?QAQTART,QAQ2HED,?68,"PAGE: ",PAGE
SET PAGE=PAGE+1
+4 DO EN6^QAQAUTL
+5 WRITE !,"PATIENT / SCREEN",?33,"SSN",?45,"DATE"
+6 WRITE ?59,$SELECT(QAOSSORT="C":"CURR/OCCUR",1:"OCCUR/CURR")," WARD/CLIN"
+7 WRITE !,UNDL
+8 QUIT
PAUSE ;
+1 KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
SET QAOSQUIT=$SELECT(Y'>0:1,1:0)
+2 QUIT
