source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RARTVER1.m@ 1446

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

initial load of FOIAVistA 6/30/08 version
File size: 6.7 KB
Line 
1RARTVER1 ;HISC/FPT AISC/MJK,RMO-On-Line Verify List/Select Reports ;11/19/97 13:49
2 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
3HDR K RAOUT,RARSEL S RACNT=0 W !!,?5,"Case",!,?5,"No.",?12,"Procedure",?34,"Ex Date",?44,"Name",?66,"Pt ID" W:$D(RASTATFG) ?74,"ST",?78,"PV"
4 W !,?5,"-----",?12,"---------",?34,"--------",?44,"-----------------",?66,"-----" W:$D(RASTATFG) ?74,"---",?78,"--"
5 N RAPRTSET,RAMEMARR
6 ;
7RPTLP F RARTDT=0:0 S RARTDT=$O(^TMP($J,"RA","DT",RARTDT)) Q:'RARTDT!($D(RARSEL)) D GETRPT
8 ;
9Q K I,RACN,RACNT,RADASH,RADUP,^TMP($J,"RA","DT"),RAFST,RALST,RAI,RANME,RAPAR,RAPRC,RARTDT,RARPT,RARSEL,RASEL,RASSN
10 Q
11 ;
12GETRPT F RARPT=0:0 S RARPT=$O(^TMP($J,"RA","DT",RARTDT,RARPT)) Q:'RARPT!($D(RARSEL)) D RASET^RARTVER2 S:'Y RARSEL=0 Q:'Y S RASSN=$$SSN^RAUTL(RADFN,1) D WRT
13 Q
14 ;
15WRT ; used when user chooses SELECTED category
16 ; the "xref" nodes store all cases ready to be selected by user
17 D EN2^RAUTL20(.RAMEMARR)
18 S RACNT=RACNT+1 W !,RACNT,?4,$S(RAPRTSET:"+",1:""),?5,RACN,?12,$E(RAPRC,1,20),?34,$E(RADTE,4,5),"-",$E(RADTE,6,7),"-",$E(RADTE,2,3),?44,$E(RANME,1,20),?66,RASSN
19 I $D(RASTATFG),$P($G(^RARPT(RARPT,0)),U,5)]"" W ?74,"("_$E($P($G(^RARPT(RARPT,0)),U,5),1)_")"
20 I $D(RASTATFG) W ?78,$S($P($G(^RARPT(RARPT,0)),U,12)]"":"Y",1:"N")
21 ;rarpt^rpt status at start of selection^/long CN^Pat.ien^Proc.ien
22 S ^TMP($J,"RA","XREF",RACNT)=RARPT_"^"_$P($G(^RARPT(+RARPT,0)),U,5)_"^/"_$P(^TMP($J,"RA","DT",RARTDT,RARPT),"/",2) D ASK:'(RACNT#15)!(RACNT=RATOT)
23 Q
24 ;
25ASK K RADUP,RARPTX S (RAERR,RAI,RANUM)=0 W !,"Type '^' to STOP, or",!,"CHOOSE FROM 1-",RACNT,": " R X:DTIME S:'$T X="^" S:X["^" RAOUT="",RARSEL=0 Q:X["^"!(X="")
26 I X["?" W !!?3,"Please enter a single number, individual numbers separated by commas,",!?3,"a range of numbers separated by a dash, or numbers separated by a",!?3,"combination of commas and dashes.",! G ASK
27PARSE S RAI=RAI+1,RAPAR=$P(X,",",RAI) Q:RAPAR="" I RAPAR?.N1"-".N S RADASH="" F RASEL=$P(RAPAR,"-"):1:$P(RAPAR,"-",2) D CHK Q:RAERR
28 I '$D(RADASH) S RASEL=RAPAR D CHK
29 K RADASH G ASK:RAERR,PARSE
30 ;
31CHK I $D(RADASH),+$P(RAPAR,"-",2)<+$P(RAPAR,"-") S RAERR=1 Q
32 I RASEL'?.N W !?3,*7,"Item ",RASEL," is not a valid selection.",! S RAERR=1 Q
33 I '$D(^TMP($J,"RA","XREF",RASEL)) W !?3,*7,"Item ",RASEL," is not a valid selection.",! S RAERR=1 Q
34 I $D(RADUP(RASEL)) W !?3,*7,"Item ",RASEL," was already selected.",! S RAERR=1 Q
35 S RANUM=RANUM+1,RADUP(RASEL)="",RARPTX(RANUM)=$S(^TMP($J,"RA","XREF",RASEL):^TMP($J,"RA","XREF",RASEL),1:0),RARSEL=RANUM
36 Q
37PV ; keep pre-verified reports (status ='draft' or 'released/not verified')
38 S RARTDT=0
39 F S RARTDT=$O(^TMP($J,"RA","DT",RARTDT)) Q:RARTDT="" S RARPT=0 F S RARPT=$O(^TMP($J,"RA","DT",RARTDT,RARPT)) Q:RARPT'>0 D
40 .S X=$G(^RARPT(RARPT,0))
41 .I $P(X,U,12)]"","DR"[$E($P(X,U,5)) Q
42 .K ^TMP($J,"RA","DT",RARTDT,RARPT) S RATOT=RATOT-1
43 I RATOT'>0 W !!,"Sorry, there are no Pre-Verified reports to review."
44 Q
45DPDRNV ; keep reports with a status of 'draft', 'problem draft' or 'released/
46 ; not verified"
47 S RARTDT=0
48 F S RARTDT=$O(^TMP($J,"RA","DT",RARTDT)) Q:RARTDT="" S RARPT=0 F S RARPT=$O(^TMP($J,"RA","DT",RARTDT,RARPT)) Q:RARPT'>0 I $P($G(^RARPT(RARPT,0)),U,5)'=RASTATUS K ^TMP($J,"RA","DT",RARTDT,RARPT) S RATOT=RATOT-1
49 I RATOT'>0 W !!,"Sorry, there are no "_$S(RASTATUS="R":"RELEASED/NOT VERIFIED",RASTATUS="PD":"PROBLEM DRAFT",1:"DRAFT")_" reports to review."
50 K RASTATUS
51 Q
52SELRPT ; select reports to verify
53 K DIR,DIROUT,DIRUT,DTOUT,DUOUT
54 W !!!!!,"Select one of the following:",!
55 S DIR("A",1)=" 1 PRE-VERIFIED (STATUS=DRAFT or RELEASED/NOT VERIFIED) ("_RATOTAL(1)_")"
56 S DIR("A",2)=" 2 RELEASED/NOT VERIFIED ("_RATOTAL(2)_")"
57 S DIR("A",3)=" 3 DRAFT ("_RATOTAL(3)_")"
58 S DIR("A",4)=" 4 PROBLEM DRAFT ("_RATOTAL(4)_")"
59 S DIR("A",5)=" 5 ALL ("_RATOT_")"
60 S DIR("A",6)=" 6 SELECTED ("_RATOT_")"
61 S DIR("A",7)=" 7 STAT (STATUS MAY BE ANY OF ABOVE) ("_RATOTAL(7)_")"
62 S DIR("A",8)=" "
63 S DIR(0)="SAO^1:PRE-VERIFIED (STATUS=DRAFT or RELEASED/NOT VERIFIED);2:RELEASED/NOT VERIFIED;3:DRAFT;4:PROBLEM DRAFT;5:ALL;6:SELECTED;7:STAT"
64 S DIR("A")="Category of Reports to Verify: "
65 D ^DIR
66 I $D(DIRUT) S Y=0
67 K DIR,DIROUT,DIRUT,DTOUT,DUOUT,RATOTAL
68 Q
69ONERPT ; message when there is only one report to choose from
70 S RARTDT=$O(^TMP($J,"RA","DT",0)) Q:RARTDT=""
71 S RARPT=$O(^TMP($J,"RA","DT",RARTDT,0)) Q:RARPT'>0
72 S RARPT0=$G(^RARPT(RARPT,0)),RASTATUS=$P(RARPT0,U,5)
73 S RASTATUS=$S(RASTATUS="V":"VERIFIED",RASTATUS="R":"RELEASED/NOT VERIFIED",RASTATUS="PD":"PROBLEM DRAFT",RASTATUS="D":"DRAFT",1:"<none>")
74 S RAPREV=$S($P(RARPT0,U,12)]"":", PRE-VERIFIED",1:"")
75 W !,"There is only one report ("_RASTATUS_RAPREV_") to choose from."
76 K DIR,RAPREV,RARPT0,RASTATUS
77 S DIR(0)="Y",DIR("A")="Do you wish to review this one report"
78 S DIR("B")="YES" D ^DIR
79 I Y=0!($D(DIRUT)) K ^TMP($J,"RA")
80 K DIR,DIRUT,DIROUT,DTOUT,DUOUT
81 Q
82RLTV ; reports left to view
83 S RARLTV=1,RARLTV(1)=0
84 F S RARLTV(1)=$O(^TMP($J,"RA","DT",RARLTV(1))) Q:RARLTV(1)'>0 S RARLTV(2)=0 F S RARLTV(2)=$O(^TMP($J,"RA","DT",RARLTV(1),RARLTV(2))) Q:RARLTV(2)'>0 S:$P(^TMP($J,"RA","DT",RARLTV(1),RARLTV(2)),"^")'="V" RARLTV=RARLTV+1
85 Q
86RLTV1 ; add'l reports left to be viewed
87 S RARLTV=1,RARLTV(1)=0
88 F S RARLTV(1)=$O(^TMP($J,"RA","DT",RARLTV(1))) Q:RARLTV(1)'>0 S RARLTV(2)=0 F S RARLTV(2)=$O(^TMP($J,"RA","DT",RARLTV(1),RARLTV(2))) Q:RARLTV(2)'>0 S:$P(^TMP($J,"RA","DT",RARLTV(1),RARLTV(2)),"^")'="V" RARLTV=RARLTV+1
89 Q
90TALLY ; tally report counts by category
91 K RATOTAL
92 F RAI=1:1:4,7 S RATOTAL(RAI)=0
93 S RARTDT=""
94 ; all cases within a print/exam set have the same ien to file #75.1
95 ; store stat flag 's' in 3rd '/' segment of ^tmp record
96 F S RARTDT=$O(^TMP($J,"RA","DT",RARTDT)) Q:RARTDT="" S RARPT=0 F S RARPT=$O(^TMP($J,"RA","DT",RARTDT,RARPT)) Q:'RARPT D
97 .S RARPT(0)=$G(^RARPT(RARPT,0))
98 .S RASTATUS=$P(RARPT(0),U,5) Q:RASTATUS="" ;rpt status
99 .S RAPREVER=$P(RARPT(0),U,12) ;pre-verf dt/tm
100 .I RASTATUS="D" S RATOTAL(3)=RATOTAL(3)+1
101 .I RASTATUS="PD" S RATOTAL(4)=RATOTAL(4)+1
102 .I RASTATUS="R" S RATOTAL(2)=RATOTAL(2)+1
103 .I RAPREVER]"","DR"[$E(RASTATUS) S RATOTAL(1)=RATOTAL(1)+1
104 .S Y=RARPT D RASET^RAUTL2 Q:'Y
105 .S Y=$P(Y,U,11) ;ptr to file #75.1
106 .Q:$P($G(^RAO(75.1,+Y,0)),U,6)'=1 ;urgency=1 means Stat
107 .S RATOTAL(7)=RATOTAL(7)+1,$P(^TMP($J,"RA","DT",RARTDT,RARPT),"/",3)="S"
108 .Q
109 K RAI,RAPREVER,RARPT(0),RASTATUS
110 Q
111STAT ;keep only rpts with order of stat
112 S RARTDT=0
113 F S RARTDT=$O(^TMP($J,"RA","DT",RARTDT)) Q:RARTDT="" S RARPT=0 F S RARPT=$O(^TMP($J,"RA","DT",RARTDT,RARPT)) Q:RARPT'>0 I $P(^(RARPT),"/",3)'="S" K ^(RARPT) S RATOT=RATOT-1
114 I RATOT'>0 W !!,"Sorry, there are no STAT ordered reports to review."
115 Q
Note: See TracBrowser for help on using the repository browser.