source: FOIAVistA/trunk/r/OCCURRENCE_SCREEN-QAO/QAOSPRD0.m@ 1397

Last change on this file since 1397 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.9 KB
Line 
1QAOSPRD0 ;HISC/DAD-INTER-REVIEWER RELIABILITY ASSESSMENT REPORT ;4/30/93 09:25
2 ;;3.0;Occurrence Screen;;09/14/1993
3 ;
4 ; ^TMP($J , "QAOSPRD0" , ["N","L","1"] , ["CLIN","PEER"]) =
5 ; Total_records ^ Records_selected
6 ;
7 ; ^TMP($J , "QAOSPRD0" , ["N","L","1"] , ["CLIN","PEER"] , SEQUENCE#) =
8 ; IEN_in_file_#741 ^ $S(Selected:"*",1:"")
9 ;
10EN ; *** Select the date range
11 W !!,"Select the date range that the occurrences will be chosen from."
12 D ^QAQDATE G:QAQQUIT EXIT
13 ; *** Select the screens to include
14 K DIR S DIR(0)="LO^1:3^K:X[""."" X",DIR("A")="Select screens to include"
15 S DIR("?",1)="Choose from:",DIR("?",2)=" 1 National screens"
16 S DIR("?",3)=" 2 Local screens",DIR("?",4)=" 3 Inactive screens"
17 S DIR("?")="Choose any combination of the above, e.g., 1, 1-3, etc."
18 S DIR("B")=1 D ^DIR G:$D(DIRUT) EXIT S QAOSTYPE="^"_$TR(Y,"123,","NL1^")
19 ; *** Select the total number of records to capture
20 K DIR S DIR(0)="NOA^1:999:0"
21 S DIR("A")="Select number of occurrences to capture: ",DIR("B")=30
22 S DIR("?",1)="Enter the number of occurrences to be printed out"
23 S DIR("?")="for the inter-reviewer reliability assessment study."
24 W ! D ^DIR G:$D(DIRUT) EXIT S QAOSNUM=Y
25BLANK ; *** Print blank worksheet
26 W !!,"Include blank worksheets" S %=2 D YN^DICN G:%=-1 EXIT
27 S QAOBLANK=$S(%=1:1,1:0) I '% D G BLANK
28 . W !!,"Answer Y(es) to print blank worksheets in addition to the"
29 . W !,"worksheets that are printed with data from the previous"
30 . W !,"reviews. Answer N(o) to skip printing of blank worksheets."
31 . Q
32DEV ; *** Select output device, force queueing
33 K %ZIS S %ZIS="QM",%ZIS("B")="",IOP="Q" W !! D ^%ZIS G:POP EXIT
34 I $D(IO("Q")) D G EXIT
35 . K IO("Q")
36 . S ZTRTN="ENTSK^QAOSPRD0"
37 . S ZTSAVE("QAQ*")="",ZTSAVE("QAO*")=""
38 . S ZTDESC="Inter-reviewer reliability assessment report"
39 . D ^%ZTLOAD
40 . Q
41 E D G DEV
42 . D ^%ZISC
43 . W !?5,"This is a very long and time consuming"
44 . W !?5,"report, it must be queued to print.",*7
45 . Q
46ENTSK ; *** Tasked entry point
47 K ^TMP($J,"QAOSPRD0")
48 S QAOSCLIN=+$O(^QA(741.2,"C",1,0)),QAOSPEER=+$O(^QA(741.2,"C",2,0))
49 S QAOSEXCP=+$O(^QA(741.6,"B",3,0)),QAOSDATE=QAQNBEG-.0000001
50 ; *** Select all records that meet the user's specifications
51 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
52 . S QAOSZERO=$G(^QA(741,QAOSD0,0)) Q:QAOSZERO=""!($P(QAOSZERO,"^",11)=2)
53 . S QAOSSCRN=$G(^QA(741,QAOSD0,"SCRN")) Q:QAOSSCRN=""
54 . S QAOSTYPE(0)=$P($G(^QA(741.1,+QAOSSCRN,0)),"^",4)
55 . Q:QAOSTYPE'[("^"_QAOSTYPE(0)_"^")
56 . S QAOSCD1=+$O(^QA(741,QAOSD0,"REVR","B",QAOSCLIN,0))
57 . Q:$P($G(^QA(741,QAOSD0,"REVR",QAOSCD1,0)),"^",5)=QAOSEXCP
58 . S QAOSPD1=+$O(^QA(741,QAOSD0,"REVR","B",QAOSPEER,0))
59 . D SET("CLIN"):QAOSCD1,SET("PEER"):QAOSPD1
60 . Q
61 ; *** Randomly select the the specified number of records
62 F QAOSTYP=2:1:$L(QAOSTYPE,"^")-1 F QAOSREVR="CLIN","PEER" D
63 . S QAOSTYPE(0)=$P(QAOSTYPE,"^",QAOSTYP)
64 . S QAOSTOT=+$G(^TMP($J,"QAOSPRD0",QAOSTYPE(0),QAOSREVR)) Q:QAOSTOT'>0
65 . F QAOSSEQ=$S(QAOSTOT>QAOSNUM:QAOSNUM,1:QAOSTOT):-1:1 D
66 .. 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
67 ... S $P(^TMP($J,"QAOSPRD0",QAOSTYPE(0),QAOSREVR,QAOSRAND),"^",2)="*"
68 ... S X=1+$P($G(^TMP($J,"QAOSPRD0",QAOSTYPE(0),QAOSREVR)),"^",2)
69 ... S $P(^TMP($J,"QAOSPRD0",QAOSTYPE(0),QAOSREVR),"^",2)=X
70 ... Q
71 .. Q
72 . Q
73PRINT ;
74 U IO D ^QAOSPRD1
75EXIT ;
76 D ^%ZISC
77 K %,%ZIS,DIR,DIRUT,IOP,POP,QAOBLANK,QAOSCD1,QAOSCLIN,QAOSCNUM,QAOSD0
78 K QAOSDATA,QAOSDATE,QAOSEXCP,QAOSHOW,QAOSNUM,QAOSPD1,QAOSPEER,QAOSPNUM
79 K QAOSRAND,QAOSREVR,QAOSSCRN,QAOSSEQ,QAOSTOT,QAOSTYP,QAOSTYPE,QAOSZERO
80 K QAOTODAY,X,Y,ZTDESC,ZTRTN,ZTSAVE,^TMP($J,"QAOSPRD0")
81 D K^QAQDATE S:$D(ZTQUEUED) ZTREQ="@"
82 Q
83SET(REVIEWER) ; *** Accumulate and count reviews
84 N X S X=1+$G(^TMP($J,"QAOSPRD0",QAOSTYPE(0),REVIEWER))
85 S ^TMP($J,"QAOSPRD0",QAOSTYPE(0),REVIEWER)=X
86 S ^TMP($J,"QAOSPRD0",QAOSTYPE(0),REVIEWER,X)=QAOSD0
87 Q
Note: See TracBrowser for help on using the repository browser.