QAOSPRD0 ;HISC/DAD-INTER-REVIEWER RELIABILITY ASSESSMENT REPORT ;4/30/93 09:25
;;3.0;Occurrence Screen;;09/14/1993
;
; ^TMP($J , "QAOSPRD0" , ["N","L","1"] , ["CLIN","PEER"]) =
; Total_records ^ Records_selected
;
; ^TMP($J , "QAOSPRD0" , ["N","L","1"] , ["CLIN","PEER"] , SEQUENCE#) =
; IEN_in_file_#741 ^ $S(Selected:"*",1:"")
;
EN ; *** Select the date range
W !!,"Select the date range that the occurrences will be chosen from."
D ^QAQDATE G:QAQQUIT EXIT
; *** Select the screens to include
K DIR S DIR(0)="LO^1:3^K:X[""."" X",DIR("A")="Select screens to include"
S DIR("?",1)="Choose from:",DIR("?",2)=" 1 National screens"
S DIR("?",3)=" 2 Local screens",DIR("?",4)=" 3 Inactive screens"
S DIR("?")="Choose any combination of the above, e.g., 1, 1-3, etc."
S DIR("B")=1 D ^DIR G:$D(DIRUT) EXIT S QAOSTYPE="^"_$TR(Y,"123,","NL1^")
; *** Select the total number of records to capture
K DIR S DIR(0)="NOA^1:999:0"
S DIR("A")="Select number of occurrences to capture: ",DIR("B")=30
S DIR("?",1)="Enter the number of occurrences to be printed out"
S DIR("?")="for the inter-reviewer reliability assessment study."
W ! D ^DIR G:$D(DIRUT) EXIT S QAOSNUM=Y
BLANK ; *** Print blank worksheet
W !!,"Include blank worksheets" S %=2 D YN^DICN G:%=-1 EXIT
S QAOBLANK=$S(%=1:1,1:0) I '% D G BLANK
. W !!,"Answer Y(es) to print blank worksheets in addition to the"
. W !,"worksheets that are printed with data from the previous"
. W !,"reviews. Answer N(o) to skip printing of blank worksheets."
. Q
DEV ; *** Select output device, force queueing
K %ZIS S %ZIS="QM",%ZIS("B")="",IOP="Q" W !! D ^%ZIS G:POP EXIT
I $D(IO("Q")) D G EXIT
. K IO("Q")
. S ZTRTN="ENTSK^QAOSPRD0"
. S ZTSAVE("QAQ*")="",ZTSAVE("QAO*")=""
. S ZTDESC="Inter-reviewer reliability assessment report"
. D ^%ZTLOAD
. Q
E D G DEV
. D ^%ZISC
. W !?5,"This is a very long and time consuming"
. W !?5,"report, it must be queued to print.",*7
. Q
ENTSK ; *** Tasked entry point
K ^TMP($J,"QAOSPRD0")
S QAOSCLIN=+$O(^QA(741.2,"C",1,0)),QAOSPEER=+$O(^QA(741.2,"C",2,0))
S QAOSEXCP=+$O(^QA(741.6,"B",3,0)),QAOSDATE=QAQNBEG-.0000001
; *** Select all records that meet the user's specifications
F S QAOSDATE=$O(^QA(741,"C",QAOSDATE)) Q:(QAOSDATE'>0)!(QAOSDATE>(QAQNEND+.9999999)) F QAOSD0=0:0 S QAOSD0=$O(^QA(741,"C",QAOSDATE,QAOSD0)) Q:QAOSD0'>0 D
. S QAOSZERO=$G(^QA(741,QAOSD0,0)) Q:QAOSZERO=""!($P(QAOSZERO,"^",11)=2)
. S QAOSSCRN=$G(^QA(741,QAOSD0,"SCRN")) Q:QAOSSCRN=""
. S QAOSTYPE(0)=$P($G(^QA(741.1,+QAOSSCRN,0)),"^",4)
. Q:QAOSTYPE'[("^"_QAOSTYPE(0)_"^")
. S QAOSCD1=+$O(^QA(741,QAOSD0,"REVR","B",QAOSCLIN,0))
. Q:$P($G(^QA(741,QAOSD0,"REVR",QAOSCD1,0)),"^",5)=QAOSEXCP
. S QAOSPD1=+$O(^QA(741,QAOSD0,"REVR","B",QAOSPEER,0))
. D SET("CLIN"):QAOSCD1,SET("PEER"):QAOSPD1
. Q
; *** Randomly select the the specified number of records
F QAOSTYP=2:1:$L(QAOSTYPE,"^")-1 F QAOSREVR="CLIN","PEER" D
. S QAOSTYPE(0)=$P(QAOSTYPE,"^",QAOSTYP)
. S QAOSTOT=+$G(^TMP($J,"QAOSPRD0",QAOSTYPE(0),QAOSREVR)) Q:QAOSTOT'>0
. F QAOSSEQ=$S(QAOSTOT>QAOSNUM:QAOSNUM,1:QAOSTOT):-1:1 D
.. F S QAOSRAND=$S(QAOSTOT>QAOSNUM:$R(QAOSTOT)+1,1:QAOSSEQ),X=$G(^TMP($J,"QAOSPRD0",QAOSTYPE(0),QAOSREVR,QAOSRAND)) I X,$P(X,"^",2)="" D Q
... S $P(^TMP($J,"QAOSPRD0",QAOSTYPE(0),QAOSREVR,QAOSRAND),"^",2)="*"
... S X=1+$P($G(^TMP($J,"QAOSPRD0",QAOSTYPE(0),QAOSREVR)),"^",2)
... S $P(^TMP($J,"QAOSPRD0",QAOSTYPE(0),QAOSREVR),"^",2)=X
... Q
.. Q
. Q
PRINT ;
U IO D ^QAOSPRD1
EXIT ;
D ^%ZISC
K %,%ZIS,DIR,DIRUT,IOP,POP,QAOBLANK,QAOSCD1,QAOSCLIN,QAOSCNUM,QAOSD0
K QAOSDATA,QAOSDATE,QAOSEXCP,QAOSHOW,QAOSNUM,QAOSPD1,QAOSPEER,QAOSPNUM
K QAOSRAND,QAOSREVR,QAOSSCRN,QAOSSEQ,QAOSTOT,QAOSTYP,QAOSTYPE,QAOSZERO
K QAOTODAY,X,Y,ZTDESC,ZTRTN,ZTSAVE,^TMP($J,"QAOSPRD0")
D K^QAQDATE S:$D(ZTQUEUED) ZTREQ="@"
Q
SET(REVIEWER) ; *** Accumulate and count reviews
N X S X=1+$G(^TMP($J,"QAOSPRD0",QAOSTYPE(0),REVIEWER))
S ^TMP($J,"QAOSPRD0",QAOSTYPE(0),REVIEWER)=X
S ^TMP($J,"QAOSPRD0",QAOSTYPE(0),REVIEWER,X)=QAOSD0
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAOSPRD0 4116 printed Nov 22, 2024@17:31:47 Page 2
QAOSPRD0 ;HISC/DAD-INTER-REVIEWER RELIABILITY ASSESSMENT REPORT ;4/30/93 09:25
+1 ;;3.0;Occurrence Screen;;09/14/1993
+2 ;
+3 ; ^TMP($J , "QAOSPRD0" , ["N","L","1"] , ["CLIN","PEER"]) =
+4 ; Total_records ^ Records_selected
+5 ;
+6 ; ^TMP($J , "QAOSPRD0" , ["N","L","1"] , ["CLIN","PEER"] , SEQUENCE#) =
+7 ; IEN_in_file_#741 ^ $S(Selected:"*",1:"")
+8 ;
EN ; *** Select the date range
+1 WRITE !!,"Select the date range that the occurrences will be chosen from."
+2 DO ^QAQDATE
if QAQQUIT
GOTO EXIT
+3 ; *** Select the screens to include
+4 KILL DIR
SET DIR(0)="LO^1:3^K:X[""."" X"
SET DIR("A")="Select screens to include"
+5 SET DIR("?",1)="Choose from:"
SET DIR("?",2)=" 1 National screens"
+6 SET DIR("?",3)=" 2 Local screens"
SET DIR("?",4)=" 3 Inactive screens"
+7 SET DIR("?")="Choose any combination of the above, e.g., 1, 1-3, etc."
+8 SET DIR("B")=1
DO ^DIR
if $DATA(DIRUT)
GOTO EXIT
SET QAOSTYPE="^"_$TRANSLATE(Y,"123,","NL1^")
+9 ; *** Select the total number of records to capture
+10 KILL DIR
SET DIR(0)="NOA^1:999:0"
+11 SET DIR("A")="Select number of occurrences to capture: "
SET DIR("B")=30
+12 SET DIR("?",1)="Enter the number of occurrences to be printed out"
+13 SET DIR("?")="for the inter-reviewer reliability assessment study."
+14 WRITE !
DO ^DIR
if $DATA(DIRUT)
GOTO EXIT
SET QAOSNUM=Y
BLANK ; *** Print blank worksheet
+1 WRITE !!,"Include blank worksheets"
SET %=2
DO YN^DICN
if %=-1
GOTO EXIT
+2 SET QAOBLANK=$SELECT(%=1:1,1:0)
IF '%
Begin DoDot:1
+3 WRITE !!,"Answer Y(es) to print blank worksheets in addition to the"
+4 WRITE !,"worksheets that are printed with data from the previous"
+5 WRITE !,"reviews. Answer N(o) to skip printing of blank worksheets."
+6 QUIT
End DoDot:1
GOTO BLANK
DEV ; *** Select output device, force queueing
+1 KILL %ZIS
SET %ZIS="QM"
SET %ZIS("B")=""
SET IOP="Q"
WRITE !!
DO ^%ZIS
if POP
GOTO EXIT
+2 IF $DATA(IO("Q"))
Begin DoDot:1
+3 KILL IO("Q")
+4 SET ZTRTN="ENTSK^QAOSPRD0"
+5 SET ZTSAVE("QAQ*")=""
SET ZTSAVE("QAO*")=""
+6 SET ZTDESC="Inter-reviewer reliability assessment report"
+7 DO ^%ZTLOAD
+8 QUIT
End DoDot:1
GOTO EXIT
+9 IF '$TEST
Begin DoDot:1
+10 DO ^%ZISC
+11 WRITE !?5,"This is a very long and time consuming"
+12 WRITE !?5,"report, it must be queued to print.",*7
+13 QUIT
End DoDot:1
GOTO DEV
ENTSK ; *** Tasked entry point
+1 KILL ^TMP($JOB,"QAOSPRD0")
+2 SET QAOSCLIN=+$ORDER(^QA(741.2,"C",1,0))
SET QAOSPEER=+$ORDER(^QA(741.2,"C",2,0))
+3 SET QAOSEXCP=+$ORDER(^QA(741.6,"B",3,0))
SET QAOSDATE=QAQNBEG-.0000001
+4 ; *** Select all records that meet the user's specifications
+5 FOR
SET QAOSDATE=$ORDER(^QA(741,"C",QAOSDATE))
if (QAOSDATE'>0)!(QAOSDATE>(QAQNEND+.9999999))
QUIT
FOR QAOSD0=0:0
SET QAOSD0=$ORDER(^QA(741,"C",QAOSDATE,QAOSD0))
if QAOSD0'>0
QUIT
Begin DoDot:1
+6 SET QAOSZERO=$GET(^QA(741,QAOSD0,0))
if QAOSZERO=""!($PIECE(QAOSZERO,"^",11)=2)
QUIT
+7 SET QAOSSCRN=$GET(^QA(741,QAOSD0,"SCRN"))
if QAOSSCRN=""
QUIT
+8 SET QAOSTYPE(0)=$PIECE($GET(^QA(741.1,+QAOSSCRN,0)),"^",4)
+9 if QAOSTYPE'[("^"_QAOSTYPE(0)_"^")
QUIT
+10 SET QAOSCD1=+$ORDER(^QA(741,QAOSD0,"REVR","B",QAOSCLIN,0))
+11 if $PIECE($GET(^QA(741,QAOSD0,"REVR",QAOSCD1,0)),"^",5)=QAOSEXCP
QUIT
+12 SET QAOSPD1=+$ORDER(^QA(741,QAOSD0,"REVR","B",QAOSPEER,0))
+13 if QAOSCD1
DO SET("CLIN")
if QAOSPD1
DO SET("PEER")
+14 QUIT
End DoDot:1
+15 ; *** Randomly select the the specified number of records
+16 FOR QAOSTYP=2:1:$LENGTH(QAOSTYPE,"^")-1
FOR QAOSREVR="CLIN","PEER"
Begin DoDot:1
+17 SET QAOSTYPE(0)=$PIECE(QAOSTYPE,"^",QAOSTYP)
+18 SET QAOSTOT=+$GET(^TMP($JOB,"QAOSPRD0",QAOSTYPE(0),QAOSREVR))
if QAOSTOT'>0
QUIT
+19 FOR QAOSSEQ=$SELECT(QAOSTOT>QAOSNUM:QAOSNUM,1:QAOSTOT):-1:1
Begin DoDot:2
+20 FOR
SET QAOSRAND=$SELECT(QAOSTOT>QAOSNUM:$RANDOM(QAOSTOT)+1,1:QAOSSEQ)
SET X=$GET(^TMP($JOB,"QAOSPRD0",QAOSTYPE(0),QAOSREVR,QAOSRAND))
IF X
IF $PIECE(X,"^",2)=""
Begin DoDot:3
+21 SET $PIECE(^TMP($JOB,"QAOSPRD0",QAOSTYPE(0),QAOSREVR,QAOSRAND),"^",2)="*"
+22 SET X=1+$PIECE($GET(^TMP($JOB,"QAOSPRD0",QAOSTYPE(0),QAOSREVR)),"^",2)
+23 SET $PIECE(^TMP($JOB,"QAOSPRD0",QAOSTYPE(0),QAOSREVR),"^",2)=X
+24 QUIT
End DoDot:3
QUIT
+25 QUIT
End DoDot:2
+26 QUIT
End DoDot:1
PRINT ;
+1 USE IO
DO ^QAOSPRD1
EXIT ;
+1 DO ^%ZISC
+2 KILL %,%ZIS,DIR,DIRUT,IOP,POP,QAOBLANK,QAOSCD1,QAOSCLIN,QAOSCNUM,QAOSD0
+3 KILL QAOSDATA,QAOSDATE,QAOSEXCP,QAOSHOW,QAOSNUM,QAOSPD1,QAOSPEER,QAOSPNUM
+4 KILL QAOSRAND,QAOSREVR,QAOSSCRN,QAOSSEQ,QAOSTOT,QAOSTYP,QAOSTYPE,QAOSZERO
+5 KILL QAOTODAY,X,Y,ZTDESC,ZTRTN,ZTSAVE,^TMP($JOB,"QAOSPRD0")
+6 DO K^QAQDATE
if $DATA(ZTQUEUED)
SET ZTREQ="@"
+7 QUIT
SET(REVIEWER) ; *** Accumulate and count reviews
+1 NEW X
SET X=1+$GET(^TMP($JOB,"QAOSPRD0",QAOSTYPE(0),REVIEWER))
+2 SET ^TMP($JOB,"QAOSPRD0",QAOSTYPE(0),REVIEWER)=X
+3 SET ^TMP($JOB,"QAOSPRD0",QAOSTYPE(0),REVIEWER,X)=QAOSD0
+4 QUIT
