source: FOIAVistA/tag/r/OCCURRENCE_SCREEN-QAO/QAOSPTR1.m@ 628

Last change on this file since 628 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version

File size: 1.7 KB
Line 
1QAOSPTR1 ;HISC/DAD-REVIEW LEVEL TRACKING REPORT ;2/12/93 15:28
2 ;;3.0;Occurrence Screen;;09/14/1993
3 S QAOSQUIT=0,PAGE=1,Y=DT X ^DD("DD") S TODAY=$P(Y,"@"),HEAD2="AS OF "_TODAY K UNDL S $P(UNDL,"-",80)="-"
4 I '$D(^TMP($J,"QAOSPTR")) D HEAD W !!,"NO DATA FOUND FOR THIS REPORT" G EXIT
5 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
6EXIT ;
7 Q
8LOOP1 ;
9 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
10 Q
11LOOP2 ;
12 S SSN=^TMP($J,"QAOSPTR",SERV,SCRN,PAT,DATE),Y=DATE X ^DD("DD") S QAOSDT=$P(Y,"@")
13 I $Y>(IOSL-6) D:$E(IOST)="C" PAUSE Q:QAOSQUIT D HEAD,SHEAD
14 W !!,PAT,?35,SSN,?49,QAOSDT,?65,SCRN
15 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
16 Q
17LOOP3 ;
18 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)
19 I $Y>(IOSL-6) D:$E(IOST)="C" PAUSE Q:QAOSQUIT D HEAD,SHEAD W !!,PAT,?35,SSN,?49,QAOSDT,?65,SCRN
20 Q
21HEAD ;
22 W:(PAGE>1)!($E(IOST)="C") @IOF
23 S X="REVIEW LEVEL TRACKING "_HEAD2
24 W !!?80-$L(X)/2,X,?68,TODAY,!?QAQTART,QAQ2HED,?68,"PAGE: ",PAGE S PAGE=PAGE+1 D EN6^QAQAUTL
25 W !,"PATIENT",?35,"SSN",?49,"OCCURRENCE",?65,"SCREEN",!," PREVIOUS REVIEWS",?49,"DATE",!,UNDL
26 Q
27SHEAD ;
28 W !!?3,"SERVICE: ",$S(SERV["~":$P(SERV,"~",2),1:SERV)
29 Q
30PAUSE ;
31 K DIR S DIR(0)="E" D ^DIR K DIR S QAOSQUIT=$S(Y'>0:1,1:0)
32 Q
Note: See TracBrowser for help on using the repository browser.