Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: QAOSPRD1

QAOSPRD1.m

Go to the documentation of this file.
QAOSPRD1 ;HISC/DAD-INTER-REVIEWER RELIABILITY ASSESSMENT REPORT ;10/7/92  13:34
 ;;3.0;Occurrence Screen;;09/14/1993
 S Y=DT X ^DD("DD") S QAOTODAY=Y
 F QAOSTYP=2:1:$L(QAOSTYPE,"^")-1 S QAOSTYPE(0)=$P(QAOSTYPE,"^",QAOSTYP) D LOOP1
 Q
LOOP1 ;
 S QAOSCNUM=$G(^TMP($J,"QAOSPRD0",QAOSTYPE(0),"CLIN"))
 S QAOSPNUM=$G(^TMP($J,"QAOSPRD0",QAOSTYPE(0),"PEER"))
 S QAOSTYPE("T")=$S(QAOSTYPE(0)="N":"NATIONAL",QAOSTYPE(0)="L":"LOCAL",QAOSTYPE(0)="1":"INACTIVE",1:"???")
 W !! D CENTER("Inter-Reviewer Reliability Assessment Worksheets")
 W ?68,QAOTODAY
 D CENTER("(Blank worksheets "_$S('QAOBLANK:"not ",1:"")_"included)")
 D CENTER("for CLINICAL and PEER reviewers for the "_QAOSTYPE("T")_" screens")
 D CENTER(QAQ2HED)
 W !!!?21,"Total",?31,"Requested",?45,"Selected",?58,"Per-centage (=Sel/Tot)"
 W !?21,"-----",?31,"---------",?45,"--------",?58,"-----------"
 W !!,"Clinical Reviews"
 W ?22,$J($P(QAOSCNUM,"^"),4,0),?34,$J(QAOSNUM,4,0),?47,$J($P(QAOSCNUM,"^",2),4,0)
 W ?60,$S(+QAOSCNUM:$J($P(QAOSCNUM,"^",2)/QAOSCNUM*100,6,2),1:"  ???")
 W !!,"Peer     Reviews"
 W ?22,$J($P(QAOSPNUM,"^"),4,0),?34,$J(QAOSNUM,4,0),?47,$J($P(QAOSPNUM,"^",2),4,0)
 W ?60,$S(+QAOSPNUM:$J($P(QAOSPNUM,"^",2)/QAOSPNUM*100,6,2),1:"  ???")
 W @IOF
 F QAOSREVR="CLIN","PEER" F QAOSSEQ=0:0 S QAOSSEQ=$O(^TMP($J,"QAOSPRD0",QAOSTYPE(0),QAOSREVR,QAOSSEQ)) Q:QAOSSEQ'>0  D
 . S QAOSD0=$G(^TMP($J,"QAOSPRD0",QAOSTYPE(0),QAOSREVR,QAOSSEQ))
 . Q:$P(QAOSD0,"^",2)'="*"  S QAOSD0=+QAOSD0 N QAOSTYPE,QAOSNUM,QAOSSEQ
 . S QAOSTYPE=$S(QAOSREVR="CLIN":"1,",QAOSREVR="PEER":"2,",1:0)
 . Q:QAOSTYPE'>0  S QAOSHOW=1
 . I QAOSREVR="CLIN" D
 .. N QAOSSEQ,QAOSREVR
 .. S QAOSDATA=2 D ^QAOSPCL0,^QAOSPCL1
 .. S QAOSDATA=1 D:QAOBLANK ^QAOSPCL0,^QAOSPCL1
 .. Q
 . I QAOSREVR="PEER" D
 .. N QAOSSEQ,QAOSREVR
 .. S QAOSDATA=2 D ^QAOSPPR0
 .. S QAOSDATA=1 D:QAOBLANK ^QAOSPPR0
 .. Q
 . Q
 Q
CENTER(X) ; *** Center the string in X
 W !?80-$L(X)/2,X
 Q