QAOSPTR1 ;HISC/DAD-REVIEW LEVEL TRACKING REPORT ;2/12/93  15:28
 ;;3.0;Occurrence Screen;;09/14/1993
 S QAOSQUIT=0,PAGE=1,Y=DT X ^DD("DD") S TODAY=$P(Y,"@"),HEAD2="AS OF "_TODAY K UNDL S $P(UNDL,"-",80)="-"
 I '$D(^TMP($J,"QAOSPTR")) D HEAD W !!,"NO DATA FOUND FOR THIS REPORT" G EXIT
 S SERV="" F SRV=0:0 S SERV=$O(^TMP($J,"QAOSPTR",SERV)) Q:SERV=""!QAOSQUIT  D PAUSE:($E(IOST)="C")&(PAGE>1) Q:QAOSQUIT  D HEAD,SHEAD F SCRN=0:0 S SCRN=$O(^TMP($J,"QAOSPTR",SERV,SCRN)) Q:SCRN'>0!QAOSQUIT  D LOOP1
EXIT ;
 Q
LOOP1 ;
 S PAT="" F PT=0:0 S PAT=$O(^TMP($J,"QAOSPTR",SERV,SCRN,PAT)) Q:PAT=""!QAOSQUIT  F DATE=0:0 S DATE=$O(^TMP($J,"QAOSPTR",SERV,SCRN,PAT,DATE)) Q:DATE'>0!QAOSQUIT  D LOOP2
 Q
LOOP2 ;
 S SSN=^TMP($J,"QAOSPTR",SERV,SCRN,PAT,DATE),Y=DATE X ^DD("DD") S QAOSDT=$P(Y,"@")
 I $Y>(IOSL-6) D:$E(IOST)="C" PAUSE Q:QAOSQUIT  D HEAD,SHEAD
 W !!,PAT,?35,SSN,?49,QAOSDT,?65,SCRN
 F LEVEL=QAOSCLIN,QAOSPEER,QAOSCMTE,QAOSMGMT Q:QAOSQUIT  I $D(^TMP($J,"QAOSPTR",SERV,SCRN,PAT,DATE,LEVEL)) F COUNT=0:0 S COUNT=$O(^TMP($J,"QAOSPTR",SERV,SCRN,PAT,DATE,LEVEL,COUNT)) Q:COUNT'>0!QAOSQUIT  D LOOP3
 Q
LOOP3 ;
 S X=^TMP($J,"QAOSPTR",SERV,SCRN,PAT,DATE,LEVEL,COUNT),LOC=$P(^QA(741.2,LEVEL,0),"^"),LOC=LOC_$E("       ",1,11-$L(LOC)) W !?2,LOC,"#",$J(COUNT,2,0),": ",$E(X,1,60)
 I $Y>(IOSL-6) D:$E(IOST)="C" PAUSE Q:QAOSQUIT  D HEAD,SHEAD W !!,PAT,?35,SSN,?49,QAOSDT,?65,SCRN
 Q
HEAD ;
 W:(PAGE>1)!($E(IOST)="C") @IOF
 S X="REVIEW LEVEL TRACKING "_HEAD2
 W !!?80-$L(X)/2,X,?68,TODAY,!?QAQTART,QAQ2HED,?68,"PAGE: ",PAGE S PAGE=PAGE+1 D EN6^QAQAUTL
 W !,"PATIENT",?35,"SSN",?49,"OCCURRENCE",?65,"SCREEN",!,"  PREVIOUS REVIEWS",?49,"DATE",!,UNDL
 Q
SHEAD ;
 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