QAOSSFR1 ;HISC/DAD-OCCURRENCE SCREEN / MONITORING SYSTEM AUTO ENROLL SPECIAL FUNCTIONS ROUTINE ;11/8/93 09:54
;;3.0;Occurrence Screen;**4**;09/14/1993
;
PRINT ; QUEUE PRINTING OF REPORTS
S QAOSDFLT=$P(QAOS740,"^",5)
I $P(QAOS740,"^",9) D
. F QAOSDIVN=0:0 S QAOSDIVN=$O(^QA(740,1,"OS2",QAOSDIVN)) Q:QAOSDIVN'>0 D
.. S ZTIO=$P(^QA(740,1,"OS2",QAOSDIVN,0),"^",2)
.. S ZTIO=$S(ZTIO]"":ZTIO,1:QAOSDFLT)
.. D QPRINT(ZTIO,QAOSDIVN)
.. K ^TMP("QAO",$J,"RPT",QAOSDIVN)
.. K ^TMP("QAO",$J,"WKS",QAOSDIVN)
.. Q
. I $D(^TMP("QAO",$J,"WKS"))!$D(^TMP("QAO",$J,"WKS")) D
.. D QPRINT(QAOSDFLT,"*")
.. Q
. Q
E D QPRINT(QAOSDFLT,"*")
Q
;
QPRINT(ZTIO,DIVISION) ; OUTPUT DEVICE , DIVISION (* = ALL)
Q:ZTIO="" S ZTRTN="ENTSK^QAOSSFR1",ZTDTH=$H
S (ZTSAVE("QAMTODAY"),ZTSAVE("QAOSSCRN"))="",ZTSAVE("QAOSDIVN")=DIVISION
I DIVISION="*" D
. S ZTSAVE("^TMP(""QAO"",$J,""RPT"",")=""
. S ZTSAVE("^TMP(""QAO"",$J,""WKS"",")=""
. Q
E D
. S ZTSAVE("^TMP(""QAO"",$J,""RPT"","_DIVISION_",")=""
. S ZTSAVE("^TMP(""QAO"",$J,""WKS"","_DIVISION_",")=""
. Q
S ZTDESC="Occurrence Screen auto enroll output"
D ^%ZTLOAD
Q
;
ENTSK ; TASKED ENTRY POINT FOR PRINT
U IO
K QAOSUNDL S $P(QAOSUNDL,"-",81)="",QAOSPAGE=1,QAOCOUNT=0
S %DT="",X="T" D ^%DT X ^DD("DD") S QAOTODAY=$P(Y,"@",1)
S QAOSSCRN(0)=$P($G(^QA(741.1,QAOSSCRN,0)),"^",2)
S Y=QAMTODAY\1 X ^DD("DD") S QAOSOCDT=Y
I $O(^TMP("QAO",$J,"RPT",""))="" D G DONE
. D HEAD
. W !,"No patients found meeting this screen."
. Q
S QAOSDVN=""
F S QAOSDVN=$O(^TMP("QAO",$J,"RPT",QAOSDVN)) Q:QAOSDVN="" D
. S QAOSDVN(0)=$P($G(^DG(40.8,+QAOSDVN,0)),"^")
. D HEAD S QAOSPAT=""
. F S QAOSPAT=$O(^TMP("QAO",$J,"RPT",QAOSDVN,QAOSPAT)) Q:QAOSPAT="" D
.. F QAOSD0=0:0 S QAOSD0=$O(^TMP("QAO",$J,"RPT",QAOSDVN,QAOSPAT,QAOSD0)) Q:QAOSD0'>0 D
... D:$Y>(IOSL-6) HEAD S X=^TMP("QAO",$J,"RPT",QAOSDVN,QAOSPAT,QAOSD0)
... W !!,QAOSPAT,?34,$P(X,"^")
... W ?49,$S($D(^SC(+$P(X,"^",2),0))#2:$P(^(0),"^"),1:$P(X,"^",2))
... W !?3,$P(X,"^",3) S Y=$P(X,"^",4) X ^DD("DD") W ?37,Y
... S QAOCOUNT=QAOCOUNT+1
... Q
.. Q
. Q
DONE ;
W !!,"Number of occurrences: ",QAOCOUNT,!,@IOF
I $O(^TMP("QAO",$J,"WKS",""))]"",$P($G(^QA(740,1,"OS")),"^",4) D
. S QAOSDVN="",(QAOSDATA,QAOSHOW)=1,QAOSQUIT=0
. F S QAOSDVN=$O(^TMP("QAO",$J,"WKS",QAOSDVN)) Q:QAOSDVN="" D
.. S QAOSPAT=""
.. F S QAOSPAT=$O(^TMP("QAO",$J,"WKS",QAOSDVN,QAOSPAT)) Q:QAOSPAT="" D
... F QAOSD0=0:0 S QAOSD0=$O(^TMP("QAO",$J,"WKS",QAOSDVN,QAOSPAT,QAOSD0)) Q:QAOSD0'>0 D ^QAOSPCL0,^QAOSPCL1
... Q
.. Q
. Q
S IONOFF=1 D ^%ZISC
K %DT,IONOFF,QAMTODAY,QAOCOUNT,QAOSD0,QAOSDATA,QAOSOCDT,QAOSPAGE,QAOSPAT
K QAOSQUIT,QAOSSCRN,QAOSUNDL,QAOTODAY,X,Y,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
K ^TMP("QAO",$J)
S:$D(ZTQUEUED) ZTREQ="@"
Q
HEAD ;
W:(QAOSPAGE>1)!($E(IOST)="C") @IOF
W !!?20,"AUTO ENROLLED OCCURRENCE SCREEN PATIENTS",?65,QAOTODAY,!?26,"OCCURRENCE DATE: ",QAOSOCDT,?65,"PAGE: ",QAOSPAGE
S X=$S($G(QAOSDVN(0))]"":QAOSDVN(0),"*"'[$G(QAOSDIVN):$P($G(^DG(40.8,+$G(QAOSDIVN),0)),"^"),1:"")
I X]"" S X="DIVISION: "_X W !?80-$L(X)/2,X
S QAOSPAGE=QAOSPAGE+1 D EN6^QAQAUTL
W !," (* Denotes that this occurrence has already been entered into the system)"
W !!,"Patient Name",?34,"SSN",?49,"Ward/Clinic",!?3,"Admitting Diagnosis",?37,"Previous Movement",!,QAOSUNDL
W !!?5,"Screen: ",QAOSSCRN," ",QAOSSCRN(0),!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAOSSFR1 3407 printed Oct 16, 2024@18:22:47 Page 2
QAOSSFR1 ;HISC/DAD-OCCURRENCE SCREEN / MONITORING SYSTEM AUTO ENROLL SPECIAL FUNCTIONS ROUTINE ;11/8/93 09:54
+1 ;;3.0;Occurrence Screen;**4**;09/14/1993
+2 ;
PRINT ; QUEUE PRINTING OF REPORTS
+1 SET QAOSDFLT=$PIECE(QAOS740,"^",5)
+2 IF $PIECE(QAOS740,"^",9)
Begin DoDot:1
+3 FOR QAOSDIVN=0:0
SET QAOSDIVN=$ORDER(^QA(740,1,"OS2",QAOSDIVN))
if QAOSDIVN'>0
QUIT
Begin DoDot:2
+4 SET ZTIO=$PIECE(^QA(740,1,"OS2",QAOSDIVN,0),"^",2)
+5 SET ZTIO=$SELECT(ZTIO]"":ZTIO,1:QAOSDFLT)
+6 DO QPRINT(ZTIO,QAOSDIVN)
+7 KILL ^TMP("QAO",$JOB,"RPT",QAOSDIVN)
+8 KILL ^TMP("QAO",$JOB,"WKS",QAOSDIVN)
+9 QUIT
End DoDot:2
+10 IF $DATA(^TMP("QAO",$JOB,"WKS"))!$DATA(^TMP("QAO",$JOB,"WKS"))
Begin DoDot:2
+11 DO QPRINT(QAOSDFLT,"*")
+12 QUIT
End DoDot:2
+13 QUIT
End DoDot:1
+14 IF '$TEST
DO QPRINT(QAOSDFLT,"*")
+15 QUIT
+16 ;
QPRINT(ZTIO,DIVISION) ; OUTPUT DEVICE , DIVISION (* = ALL)
+1 if ZTIO=""
QUIT
SET ZTRTN="ENTSK^QAOSSFR1"
SET ZTDTH=$HOROLOG
+2 SET (ZTSAVE("QAMTODAY"),ZTSAVE("QAOSSCRN"))=""
SET ZTSAVE("QAOSDIVN")=DIVISION
+3 IF DIVISION="*"
Begin DoDot:1
+4 SET ZTSAVE("^TMP(""QAO"",$J,""RPT"",")=""
+5 SET ZTSAVE("^TMP(""QAO"",$J,""WKS"",")=""
+6 QUIT
End DoDot:1
+7 IF '$TEST
Begin DoDot:1
+8 SET ZTSAVE("^TMP(""QAO"",$J,""RPT"","_DIVISION_",")=""
+9 SET ZTSAVE("^TMP(""QAO"",$J,""WKS"","_DIVISION_",")=""
+10 QUIT
End DoDot:1
+11 SET ZTDESC="Occurrence Screen auto enroll output"
+12 DO ^%ZTLOAD
+13 QUIT
+14 ;
ENTSK ; TASKED ENTRY POINT FOR PRINT
+1 USE IO
+2 KILL QAOSUNDL
SET $PIECE(QAOSUNDL,"-",81)=""
SET QAOSPAGE=1
SET QAOCOUNT=0
+3 SET %DT=""
SET X="T"
DO ^%DT
XECUTE ^DD("DD")
SET QAOTODAY=$PIECE(Y,"@",1)
+4 SET QAOSSCRN(0)=$PIECE($GET(^QA(741.1,QAOSSCRN,0)),"^",2)
+5 SET Y=QAMTODAY\1
XECUTE ^DD("DD")
SET QAOSOCDT=Y
+6 IF $ORDER(^TMP("QAO",$JOB,"RPT",""))=""
Begin DoDot:1
+7 DO HEAD
+8 WRITE !,"No patients found meeting this screen."
+9 QUIT
End DoDot:1
GOTO DONE
+10 SET QAOSDVN=""
+11 FOR
SET QAOSDVN=$ORDER(^TMP("QAO",$JOB,"RPT",QAOSDVN))
if QAOSDVN=""
QUIT
Begin DoDot:1
+12 SET QAOSDVN(0)=$PIECE($GET(^DG(40.8,+QAOSDVN,0)),"^")
+13 DO HEAD
SET QAOSPAT=""
+14 FOR
SET QAOSPAT=$ORDER(^TMP("QAO",$JOB,"RPT",QAOSDVN,QAOSPAT))
if QAOSPAT=""
QUIT
Begin DoDot:2
+15 FOR QAOSD0=0:0
SET QAOSD0=$ORDER(^TMP("QAO",$JOB,"RPT",QAOSDVN,QAOSPAT,QAOSD0))
if QAOSD0'>0
QUIT
Begin DoDot:3
+16 if $Y>(IOSL-6)
DO HEAD
SET X=^TMP("QAO",$JOB,"RPT",QAOSDVN,QAOSPAT,QAOSD0)
+17 WRITE !!,QAOSPAT,?34,$PIECE(X,"^")
+18 WRITE ?49,$SELECT($DATA(^SC(+$PIECE(X,"^",2),0))#2:$PIECE(^(0),"^"),1:$PIECE(X,"^",2))
+19 WRITE !?3,$PIECE(X,"^",3)
SET Y=$PIECE(X,"^",4)
XECUTE ^DD("DD")
WRITE ?37,Y
+20 SET QAOCOUNT=QAOCOUNT+1
+21 QUIT
End DoDot:3
+22 QUIT
End DoDot:2
+23 QUIT
End DoDot:1
DONE ;
+1 WRITE !!,"Number of occurrences: ",QAOCOUNT,!,@IOF
+2 IF $ORDER(^TMP("QAO",$JOB,"WKS",""))]""
IF $PIECE($GET(^QA(740,1,"OS")),"^",4)
Begin DoDot:1
+3 SET QAOSDVN=""
SET (QAOSDATA,QAOSHOW)=1
SET QAOSQUIT=0
+4 FOR
SET QAOSDVN=$ORDER(^TMP("QAO",$JOB,"WKS",QAOSDVN))
if QAOSDVN=""
QUIT
Begin DoDot:2
+5 SET QAOSPAT=""
+6 FOR
SET QAOSPAT=$ORDER(^TMP("QAO",$JOB,"WKS",QAOSDVN,QAOSPAT))
if QAOSPAT=""
QUIT
Begin DoDot:3
+7 FOR QAOSD0=0:0
SET QAOSD0=$ORDER(^TMP("QAO",$JOB,"WKS",QAOSDVN,QAOSPAT,QAOSD0))
if QAOSD0'>0
QUIT
DO ^QAOSPCL0
DO ^QAOSPCL1
+8 QUIT
End DoDot:3
+9 QUIT
End DoDot:2
+10 QUIT
End DoDot:1
+11 SET IONOFF=1
DO ^%ZISC
+12 KILL %DT,IONOFF,QAMTODAY,QAOCOUNT,QAOSD0,QAOSDATA,QAOSOCDT,QAOSPAGE,QAOSPAT
+13 KILL QAOSQUIT,QAOSSCRN,QAOSUNDL,QAOTODAY,X,Y,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
+14 KILL ^TMP("QAO",$JOB)
+15 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+16 QUIT
HEAD ;
+1 if (QAOSPAGE>1)!($EXTRACT(IOST)="C")
WRITE @IOF
+2 WRITE !!?20,"AUTO ENROLLED OCCURRENCE SCREEN PATIENTS",?65,QAOTODAY,!?26,"OCCURRENCE DATE: ",QAOSOCDT,?65,"PAGE: ",QAOSPAGE
+3 SET X=$SELECT($GET(QAOSDVN(0))]"":QAOSDVN(0),"*"'[$GET(QAOSDIVN):$PIECE($GET(^DG(40.8,+$GET(QAOSDIVN),0)),"^"),1:"")
+4 IF X]""
SET X="DIVISION: "_X
WRITE !?80-$LENGTH(X)/2,X
+5 SET QAOSPAGE=QAOSPAGE+1
DO EN6^QAQAUTL
+6 WRITE !," (* Denotes that this occurrence has already been entered into the system)"
+7 WRITE !!,"Patient Name",?34,"SSN",?49,"Ward/Clinic",!?3,"Admitting Diagnosis",?37,"Previous Movement",!,QAOSUNDL
+8 WRITE !!?5,"Screen: ",QAOSSCRN," ",QAOSSCRN(0),!
+9 QUIT
