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