QAOSPRD1.m

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 ---QAOSPRD1   1938     printed  Mar 13, 2025@21:26:46                                                                                                                                                                                                    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