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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAOSPRD1 1938 printed Nov 22, 2024@17:31:48 Page 2
QAOSPRD1 ;HISC/DAD-INTER-REVIEWER RELIABILITY ASSESSMENT REPORT ;10/7/92 13:34
+1 ;;3.0;Occurrence Screen;;09/14/1993
+2 SET Y=DT
XECUTE ^DD("DD")
SET QAOTODAY=Y
+3 FOR QAOSTYP=2:1:$LENGTH(QAOSTYPE,"^")-1
SET QAOSTYPE(0)=$PIECE(QAOSTYPE,"^",QAOSTYP)
DO LOOP1
+4 QUIT
LOOP1 ;
+1 SET QAOSCNUM=$GET(^TMP($JOB,"QAOSPRD0",QAOSTYPE(0),"CLIN"))
+2 SET QAOSPNUM=$GET(^TMP($JOB,"QAOSPRD0",QAOSTYPE(0),"PEER"))
+3 SET QAOSTYPE("T")=$SELECT(QAOSTYPE(0)="N":"NATIONAL",QAOSTYPE(0)="L":"LOCAL",QAOSTYPE(0)="1":"INACTIVE",1:"???")
+4 WRITE !!
DO CENTER("Inter-Reviewer Reliability Assessment Worksheets")
+5 WRITE ?68,QAOTODAY
+6 DO CENTER("(Blank worksheets "_$SELECT('QAOBLANK:"not ",1:"")_"included)")
+7 DO CENTER("for CLINICAL and PEER reviewers for the "_QAOSTYPE("T")_" screens")
+8 DO CENTER(QAQ2HED)
+9 WRITE !!!?21,"Total",?31,"Requested",?45,"Selected",?58,"Per-centage (=Sel/Tot)"
+10 WRITE !?21,"-----",?31,"---------",?45,"--------",?58,"-----------"
+11 WRITE !!,"Clinical Reviews"
+12 WRITE ?22,$JUSTIFY($PIECE(QAOSCNUM,"^"),4,0),?34,$JUSTIFY(QAOSNUM,4,0),?47,$JUSTIFY($PIECE(QAOSCNUM,"^",2),4,0)
+13 WRITE ?60,$SELECT(+QAOSCNUM:$JUSTIFY($PIECE(QAOSCNUM,"^",2)/QAOSCNUM*100,6,2),1:" ???")
+14 WRITE !!,"Peer Reviews"
+15 WRITE ?22,$JUSTIFY($PIECE(QAOSPNUM,"^"),4,0),?34,$JUSTIFY(QAOSNUM,4,0),?47,$JUSTIFY($PIECE(QAOSPNUM,"^",2),4,0)
+16 WRITE ?60,$SELECT(+QAOSPNUM:$JUSTIFY($PIECE(QAOSPNUM,"^",2)/QAOSPNUM*100,6,2),1:" ???")
+17 WRITE @IOF
+18 FOR QAOSREVR="CLIN","PEER"
FOR QAOSSEQ=0:0
SET QAOSSEQ=$ORDER(^TMP($JOB,"QAOSPRD0",QAOSTYPE(0),QAOSREVR,QAOSSEQ))
if QAOSSEQ'>0
QUIT
Begin DoDot:1
+19 SET QAOSD0=$GET(^TMP($JOB,"QAOSPRD0",QAOSTYPE(0),QAOSREVR,QAOSSEQ))
+20 if $PIECE(QAOSD0,"^",2)'="*"
QUIT
SET QAOSD0=+QAOSD0
NEW QAOSTYPE,QAOSNUM,QAOSSEQ
+21 SET QAOSTYPE=$SELECT(QAOSREVR="CLIN":"1,",QAOSREVR="PEER":"2,",1:0)
+22 if QAOSTYPE'>0
QUIT
SET QAOSHOW=1
+23 IF QAOSREVR="CLIN"
Begin DoDot:2
+24 NEW QAOSSEQ,QAOSREVR
+25 SET QAOSDATA=2
DO ^QAOSPCL0
DO ^QAOSPCL1
+26 SET QAOSDATA=1
if QAOBLANK
DO ^QAOSPCL0
DO ^QAOSPCL1
+27 QUIT
End DoDot:2
+28 IF QAOSREVR="PEER"
Begin DoDot:2
+29 NEW QAOSSEQ,QAOSREVR
+30 SET QAOSDATA=2
DO ^QAOSPPR0
+31 SET QAOSDATA=1
if QAOBLANK
DO ^QAOSPPR0
+32 QUIT
End DoDot:2
+33 QUIT
End DoDot:1
+34 QUIT
CENTER(X) ; *** Center the string in X
+1 WRITE !?80-$LENGTH(X)/2,X
+2 QUIT