QAOSPSY0 ;HISC/DAD-SYSTEM / EQUIPMENT PROBLEMS ;6/11/93 15:59
;;3.0;Occurrence Screen;;09/14/1993
D ^QAQDATE G:QAQQUIT EXIT
K %ZIS S %ZIS="QM" D ^%ZIS G:POP EXIT I $D(IO("Q")) S ZTDESC="System/equipment problems report",ZTRTN="ENTSK^QAOSPSY0",ZTSAVE("QAOS*")="",ZTSAVE("QAQ*")="" D ^%ZTLOAD G EXIT
ENTSK ;
K ^TMP($J,"QAOSPSY"),UNDL S $P(UNDL,"-",80)="-" S QAOSQUIT=0,PAGE=1,Y=DT X ^DD("DD") S TODAY=$P(Y,"@")
F QAOSDT=QAQNBEG-.0000001:0 S QAOSDT=$O(^QA(741,"C",QAOSDT)) Q:(QAOSDT'>0)!(QAOSDT>QAQNEND) F QAOSD0=0:0 S QAOSD0=$O(^QA(741,"C",QAOSDT,QAOSD0)) Q:QAOSD0'>0 D LOOP1
U IO D HEAD I '$D(^TMP($J,"QAOSPSY")) W !!,"NO DATA FOUND FOR THIS REPORT" G EXIT
S SERV="" F SRV=0:0 S SERV=$O(^TMP($J,"QAOSPSY",SERV)) Q:SERV=""!QAOSQUIT D SUBHEAD S PAT="" F PT=0:0 S PAT=$O(^TMP($J,"QAOSPSY",SERV,PAT)) Q:PAT=""!QAOSQUIT F SCRN=0:0 S SCRN=$O(^TMP($J,"QAOSPSY",SERV,PAT,SCRN)) Q:SCRN'>0!QAOSQUIT D PRT1
EXIT ;
W ! D ^%ZISC
K %ZIS,CONFIRM,LOC,PAGE,PAT,PATIENT,PT,POP,QAOSD0,QAOSDT,QAOSQUIT,QAOSZERO,SCREEN,SCRN,SERV,SERVICE,SRV,SSN,STATUS,TODAY,UNDL,X,Y,ZTDESC,ZTRTN,ZTSAVE,%DT,D,I,Y,Z,QA,QAOSD1,^TMP($J,"QAOSPSY")
D K^QAQDATE S:$D(ZTQUEUED) ZTREQ="@"
Q
LOOP1 ;
S QAOSZERO=^QA(741,QAOSD0,0),SCRN=+$G(^("SCRN")),STATUS=$P(QAOSZERO,"^",11) Q:STATUS=2 S STATUS=$S(+STATUS=0:" OPEN",1:"CLOSED")
K CONFIRM F QA=1:1:4 S CONFIRM(QA)=0
F QAOSD1=0:0 S QAOSD1=$O(^QA(741,QAOSD0,"CMTE",QAOSD1)) Q:QAOSD1'>0 D
. S CONFIRM=+$P($G(^QA(741,QAOSD0,"CMTE",QAOSD1,0)),"^",5)
. Q:CONFIRM=4 S CONFIRM(CONFIRM)=1
. Q
S CONFIRM=$S(CONFIRM(3)!(CONFIRM(1)&CONFIRM(2)):"SYSTEM & EQUIP",CONFIRM(1):"EQUIPMENT",CONFIRM(2):"SYSTEM",1:"") Q:CONFIRM=""
S LOC=$G(^QA(741.1,SCRN,0)),SCREEN=$P(LOC,"^",2),SCRN=$S(LOC]"":+LOC,1:SCRN)
S SERVICE=$P(QAOSZERO,"^",6),SERVICE=$S(SERVICE'>0:"~UNKNOWN",$D(^DIC(49,SERVICE,0))#2:$P(^(0),"^"),1:"~UNKNOWN")
S LOC=$G(^DPT(+QAOSZERO,0)),PATIENT=$S(LOC]"":$P(LOC,"^"),1:+QAOSZERO),SSN=$P(LOC,"^",9)
S ^TMP($J,"QAOSPSY",SERVICE,PATIENT,SCRN,QAOSDT)=SSN_"^"_STATUS_"^"_CONFIRM_"^"_SCREEN
Q
PRT1 ;
F QAOSDT=0:0 S QAOSDT=$O(^TMP($J,"QAOSPSY",SERV,PAT,SCRN,QAOSDT)) Q:QAOSDT'>0!QAOSQUIT D PRT2
Q
PRT2 ;
S LOC=^TMP($J,"QAOSPSY",SERV,PAT,SCRN,QAOSDT),SSN=+LOC,STATUS=$P(LOC,"^",2),CONFIRM=$P(LOC,"^",3),SCREEN=$P(LOC,"^",4),Y=QAOSDT\1 X ^DD("DD")
W !!,PAT,?32,SSN,?43,Y,?56,STATUS,?64,CONFIRM,!?1,SCRN,?8,$E(SCREEN,1,72)
I $Y>(IOSL-6) D:$E(IOST)="C" PAUSE Q:QAOSQUIT D HEAD,SUBHEAD:($O(^TMP($J,"QAOSPSY",SERV,PAT))]"")!($O(^TMP($J,"QAOSPSY",SERV,PAT,SCRN))]"")!($O(^TMP($J,"QAOSPSY",SERV,PAT,SCRN,QAOSDT))]"")
Q
HEAD ;
W:(PAGE>1)!($E(IOST)="C") @IOF
W !!?26,"SYSTEM / EQUIPMENT PROBLEMS",?68,TODAY,!?QAQTART,QAQ2HED,?68,"PAGE: ",PAGE S PAGE=PAGE+1 D EN6^QAQAUTL
W !,"PATIENT / SCREEN",?32,"SSN",?43,"DATE",?56,"STATUS",?64,"CONFIRMED ISSUE",!,UNDL
Q
SUBHEAD ;
W !!?3,"SERVICE: ",$S(SERV["~":$P(SERV,"~",2),1:SERV)
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[HQAOSPSY0 2966 printed Dec 13, 2024@02:22:04 Page 2
QAOSPSY0 ;HISC/DAD-SYSTEM / EQUIPMENT PROBLEMS ;6/11/93 15:59
+1 ;;3.0;Occurrence Screen;;09/14/1993
+2 DO ^QAQDATE
if QAQQUIT
GOTO EXIT
+3 KILL %ZIS
SET %ZIS="QM"
DO ^%ZIS
if POP
GOTO EXIT
IF $DATA(IO("Q"))
SET ZTDESC="System/equipment problems report"
SET ZTRTN="ENTSK^QAOSPSY0"
SET ZTSAVE("QAOS*")=""
SET ZTSAVE("QAQ*")=""
DO ^%ZTLOAD
GOTO EXIT
ENTSK ;
+1 KILL ^TMP($JOB,"QAOSPSY"),UNDL
SET $PIECE(UNDL,"-",80)="-"
SET QAOSQUIT=0
SET PAGE=1
SET Y=DT
XECUTE ^DD("DD")
SET TODAY=$PIECE(Y,"@")
+2 FOR QAOSDT=QAQNBEG-.0000001:0
SET QAOSDT=$ORDER(^QA(741,"C",QAOSDT))
if (QAOSDT'>0)!(QAOSDT>QAQNEND)
QUIT
FOR QAOSD0=0:0
SET QAOSD0=$ORDER(^QA(741,"C",QAOSDT,QAOSD0))
if QAOSD0'>0
QUIT
DO LOOP1
+3 USE IO
DO HEAD
IF '$DATA(^TMP($JOB,"QAOSPSY"))
WRITE !!,"NO DATA FOUND FOR THIS REPORT"
GOTO EXIT
+4 SET SERV=""
FOR SRV=0:0
SET SERV=$ORDER(^TMP($JOB,"QAOSPSY",SERV))
if SERV=""!QAOSQUIT
QUIT
DO SUBHEAD
SET PAT=""
FOR PT=0:0
SET PAT=$ORDER(^TMP($JOB,"QAOSPSY",SERV,PAT))
if PAT=""!QAOSQUIT
QUIT
FOR SCRN=0:0
SET SCRN=$ORDER(^TMP($JOB,"QAOSPSY",SERV,PAT,SCRN))
if SCRN'>0!QAOSQUIT
QUIT
DO PRT1
EXIT ;
+1 WRITE !
DO ^%ZISC
+2 KILL %ZIS,CONFIRM,LOC,PAGE,PAT,PATIENT,PT,POP,QAOSD0,QAOSDT,QAOSQUIT,QAOSZERO,SCREEN,SCRN,SERV,SERVICE,SRV,SSN,STATUS,TODAY,UNDL,X,Y,ZTDESC,ZTRTN,ZTSAVE,%DT,D,I,Y,Z,QA,QAOSD1,^TMP($JOB,"QAOSPSY")
+3 DO K^QAQDATE
if $DATA(ZTQUEUED)
SET ZTREQ="@"
+4 QUIT
LOOP1 ;
+1 SET QAOSZERO=^QA(741,QAOSD0,0)
SET SCRN=+$GET(^("SCRN"))
SET STATUS=$PIECE(QAOSZERO,"^",11)
if STATUS=2
QUIT
SET STATUS=$SELECT(+STATUS=0:" OPEN",1:"CLOSED")
+2 KILL CONFIRM
FOR QA=1:1:4
SET CONFIRM(QA)=0
+3 FOR QAOSD1=0:0
SET QAOSD1=$ORDER(^QA(741,QAOSD0,"CMTE",QAOSD1))
if QAOSD1'>0
QUIT
Begin DoDot:1
+4 SET CONFIRM=+$PIECE($GET(^QA(741,QAOSD0,"CMTE",QAOSD1,0)),"^",5)
+5 if CONFIRM=4
QUIT
SET CONFIRM(CONFIRM)=1
+6 QUIT
End DoDot:1
+7 SET CONFIRM=$SELECT(CONFIRM(3)!(CONFIRM(1)&CONFIRM(2)):"SYSTEM & EQUIP",CONFIRM(1):"EQUIPMENT",CONFIRM(2):"SYSTEM",1:"")
if CONFIRM=""
QUIT
+8 SET LOC=$GET(^QA(741.1,SCRN,0))
SET SCREEN=$PIECE(LOC,"^",2)
SET SCRN=$SELECT(LOC]"":+LOC,1:SCRN)
+9 SET SERVICE=$PIECE(QAOSZERO,"^",6)
SET SERVICE=$SELECT(SERVICE'>0:"~UNKNOWN",$DATA(^DIC(49,SERVICE,0))#2:$PIECE(^(0),"^"),1:"~UNKNOWN")
+10 SET LOC=$GET(^DPT(+QAOSZERO,0))
SET PATIENT=$SELECT(LOC]"":$PIECE(LOC,"^"),1:+QAOSZERO)
SET SSN=$PIECE(LOC,"^",9)
+11 SET ^TMP($JOB,"QAOSPSY",SERVICE,PATIENT,SCRN,QAOSDT)=SSN_"^"_STATUS_"^"_CONFIRM_"^"_SCREEN
+12 QUIT
PRT1 ;
+1 FOR QAOSDT=0:0
SET QAOSDT=$ORDER(^TMP($JOB,"QAOSPSY",SERV,PAT,SCRN,QAOSDT))
if QAOSDT'>0!QAOSQUIT
QUIT
DO PRT2
+2 QUIT
PRT2 ;
+1 SET LOC=^TMP($JOB,"QAOSPSY",SERV,PAT,SCRN,QAOSDT)
SET SSN=+LOC
SET STATUS=$PIECE(LOC,"^",2)
SET CONFIRM=$PIECE(LOC,"^",3)
SET SCREEN=$PIECE(LOC,"^",4)
SET Y=QAOSDT\1
XECUTE ^DD("DD")
+2 WRITE !!,PAT,?32,SSN,?43,Y,?56,STATUS,?64,CONFIRM,!?1,SCRN,?8,$EXTRACT(SCREEN,1,72)
+3 IF $Y>(IOSL-6)
if $EXTRACT(IOST)="C"
DO PAUSE
if QAOSQUIT
QUIT
DO HEAD
if ($ORDER(^TMP($JOB,"QAOSPSY",SERV,PAT))]"")!($ORDER(^TMP($JOB,"QAOSPSY",SERV,PAT,SCRN))]"")!($ORDER(^TMP($JOB,"QAOSPSY",SERV,PAT,SCRN,QAOSDT))]"")
DO SUBHEAD
+4 QUIT
HEAD ;
+1 if (PAGE>1)!($EXTRACT(IOST)="C")
WRITE @IOF
+2 WRITE !!?26,"SYSTEM / EQUIPMENT PROBLEMS",?68,TODAY,!?QAQTART,QAQ2HED,?68,"PAGE: ",PAGE
SET PAGE=PAGE+1
DO EN6^QAQAUTL
+3 WRITE !,"PATIENT / SCREEN",?32,"SSN",?43,"DATE",?56,"STATUS",?64,"CONFIRMED ISSUE",!,UNDL
+4 QUIT
SUBHEAD ;
+1 WRITE !!?3,"SERVICE: ",$SELECT(SERV["~":$PIECE(SERV,"~",2),1:SERV)
+2 QUIT
PAUSE ;
+1 KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
SET QAOSQUIT=$SELECT(Y'>0:1,1:0)
+2 QUIT
