source: FOIAVistA/trunk/r/OCCURRENCE_SCREEN-QAO/QAOSPSM1.m@ 1801

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