QAOSPSM1 ;HISC/DAD-SUMMARY OF OCCURRENCE SCREENING - PART I ;11/20/92 15:39 ;;3.0;Occurrence Screen;;09/14/1993 K UNDL S $P(UNDL,"_",81)="",QAOSQUIT=0,QAOSSITE=+$G(^QA(740,1,0)),QAOSSITE=$P($G(^DIC(4,QAOSSITE,0)),"^") F QAOSLST=2:1 S QAOSLST(0)=$P(QAOSLIST,"^",QAOSLST) Q:QAOSLST(0)=""!QAOSQUIT D LOOP0 Q LOOP0 ; Q:$O(^UTILITY($J,"QAOSPSM",QAOSLST(0),0))'>0 S QAOSPAGE=1 D HDR F QAOSSEQ=0:0 S QAOSSEQ=$O(^UTILITY($J,"QAOSPSM",QAOSLST(0),QAOSSEQ)) Q:QAOSSEQ'>0!QAOSQUIT D LOOP1 Q LOOP1 ; S QAOSTEMP=^UTILITY($J,"QAOSPSM",QAOSLST(0),QAOSSEQ),X=$P(QAOSTEMP,"^") W !!,$J(QAOSSEQ,2)," (",X,")" S TAB=15 F QA=2:1:9 S X=+$P(QAOSTEMP,"^",QA) W ?TAB,$S(QAOBLANK'>0:$J(X,4),1:" ____") S TAB=TAB+8 I $Y>(IOSL-6),$O(^UTILITY($J,"QAOSPSM",QAOSLST(0),QAOSSEQ)) D PAUSE:$E(IOST)="C",HDR:'QAOSQUIT Q I $O(^UTILITY($J,"QAOSPSM",QAOSLST(0),QAOSSEQ))'>0 W !!,"COMMENTS:" D:$E(IOST)="C" PAUSE Q HDR ; W:(QAOSPAGE>1)!($E(IOST)="C") @IOF S QAOSPAGE=QAOSPAGE+1 S X="SUMMARY OF OCCURRENCE SCREENING - SEMI-ANNUAL REPORT - PART I"_$S(QAOSLST(0)="L":" (LOCAL SCREENS)",QAOSLST(0)="1":" (INACTIVE SCREENS)",1:""),TAB=80-$L(X)/2 W !!?TAB,X,!?TAB,$TR($J("",$L(X))," ","-") W !!,"MEDICAL CENTER: ",$S(QAOBLANK:$E(UNDL,1,64),1:QAOSSITE) W !!,"PERSON PREPARING REPORT: ",$E(UNDL,1,55) W !!,"TITLE & CORRESPONDENCE SYMBOL OF THE ABOVE: ",$E(UNDL,1,36) W !!,"FTS TELEPHONE: ",$E(UNDL,1,27)," TELEFAX: ",$E(UNDL,1,28) W !!,"REPORTING PERIOD: ",$S(QAOBLANK:$E(UNDL,1,62),1:QAQ2HED),! W !,"|CRITERION|--# OF OCCURRENCES---|--OUTCOME OF PEER REVIEW---|-# OF OCCURRENCES-|" W !,"| SCREEN | REVIEWED REFERRED |LEVEL LEVEL LEVEL PENDING| REFERRED FOR |" W !,"| | CLINICALLY TO PEER | 1 2 3 | SYSTEM EQUIPMENT|" W !,"|=========|=====================|===========================|==================|" Q PAUSE ; K DIR S DIR(0)="E" D ^DIR S QAOSQUIT=$S(Y'>0:1,1:0) Q