- 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 Mar 13, 2025@21:26:45 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
