33 lines
1.7 KiB
Mathematica
33 lines
1.7 KiB
Mathematica
|
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
|