source: WorldVistAEHR/trunk/r/OCCURRENCE_SCREEN-QAO/QAOSPRD0.m@ 1599

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