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