source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RASTRPT2.m

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

initial load of FOIAVistA 6/30/08 version

File size: 4.6 KB
Line 
1RASTRPT2 ;HISC/SS-Status Tracking Statistics Report ;4/28/00 10:00
2 ;;5.0;Radiology/Nuclear Medicine;**20,24**;Mar 16, 1998
3 ;Last Modifications by SS on Aug 3,2000 for patch P24
4 ;Select Division, if exists
5 ;Requires RACCESS "DIV" elements. Prompts user to select division(s).
6 ;Creates ^TMP($J,"RA D-TYPE",Division name,Division IEN)="" which
7 ;contains all divisions selected.
8SELREQ() ;P20 by SS Select requesting location prompt
9 N RAINP,RAUTIL,RADIC,RA11A,RAQQHLP
10 N RA ;push previous to stack
11 S RAQQHLP=""
12 S RAUTIL="RA REQ-LOC"
13 K ^TMP($J,RAUTIL)
14ASK2 W !,!,"Select all requesting locations? Y/N: " R RAINP:DTIME I '$T W $C(7)," Timed out...." Q -2
15 Q:RAINP="^" "-1^NON"
16 S RAQQHLP="Enter YES to obtain a report for all requesting locations.^Enter NO to select one or more requesting location(s)."
17 S RAINP=$$YESNO(RAINP,RAQQHLP)
18 I RAINP="0" G ASK2
19 I RAINP="Y" Q "0^ALL"
20 I RAINP="N" D
21 .S RADIC("A")="Select requesting location: "
22 .S RADIC="^SC(",RADIC(0)="QEAMZ",X="A",RADIC("B")=""
23 .D EN1^RASELCT(.RADIC,RAUTIL) K %W,%Y1,DIC,X,Y
24 .Q
25 N RA20A,RA20B,RA20C,RA20D S (RA20A,RA20B,RA20C)=0
26 F S RA20A=$O(^TMP($J,RAUTIL,RA20A)) Q:RA20A="" S RA20C=RA20A,RA20B=RA20B+1
27 G:RA20B=0 ASK2
28 I RA20B=1 Q "1^"_RA20C_"^"_$O(^TMP($J,RAUTIL,RA20C,0))
29 Q RA20B_"^MULTI"
30 ;
31SELPROC(RAIMGTP) ;P20 Select procedure prompt
32 N RAINP,RAUTIL,RADIC,RA11A,RAQQHLP
33 N RA ;push previous to stack
34ASK W !,!,"Select all procedures? Y/N: " R RAINP:DTIME I '$T W $C(7)," Timed out...." Q -2
35 Q:RAINP="^" -1
36 S RAQQHLP="Enter YES to select all procedures^or NO to select a single procedure."
37 S RAINP=$$YESNO(RAINP,RAQQHLP)
38 I RAINP="0" G ASK
39 I RAINP="Y" Q 0
40 I RAINP="N" S DIC="^RAMIS(71,",DIC(0)="QAEMZI" D ^DIC S RA11A=Y K %W,%Y1,DIC,X,Y
41 Q RA11A
42 ;
43SETTMP ;P20 by SS update data in ^TMP for RASTAT in new format
44 N X,Y,RARQLOC,RA11,RA11A S RA11=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)) Q:RA11=""
45 S RA11A=$P(RA11,"^",22) I RA11A="" S RARQLOC=$P(RA11,"^",9)
46 S RARQLOC=$S(RA11A="":"Unknown",1:$E($P(^SC(RA11A,0),"^",1),1,200))
47 S $P(RACURREC("L"),"^",2)=RARQLOC
48 ;set PROC
49 I '$D(^TMP($J,"RAST",RAIMAGE,RADV,RARQLOC,"PROC",RAFR,RATO,RAPRC)) S ^(RAPRC)=Y1_"^^"_Y1_"^^1^"_Y1
50 E S:+Y1>+$P(^(RAPRC),"^",1) $P(^(RAPRC),"^",1)=Y1 S:+Y1<+$P(^(RAPRC),"^",3) $P(^(RAPRC),"^",3)=Y1 S $P(^(RAPRC),"^",6)=+$P(^(RAPRC),"^",6)+Y1,$P(^(RAPRC),"^",5)=+$P(^(RAPRC),"^",5)+1
51 S X=+$P(^(RAPRC),"^",1) I X'<0 D MINUTS^RAUTL1 S $P(^(RAPRC),"^",2)=Y
52 S X=+$P(^(RAPRC),"^",3) I X'<0 D MINUTS^RAUTL1 S $P(^(RAPRC),"^",4)=Y
53 ;Set SUM
54 I '$D(^TMP($J,"RAST",RAIMAGE,RADV,RARQLOC,"SUM",RAFR,RATO)) S ^(RATO)=Y1_"^^"_Y1_"^^1^"_Y1
55 E S:+Y1>+$P(^(RATO),"^",1) $P(^(RATO),"^",1)=Y1 S:+Y1<+$P(^(RATO),"^",3) $P(^(RATO),"^",3)=Y1 S $P(^(RATO),"^",6)=+$P(^(RATO),"^",6)+Y1,$P(^(RATO),"^",5)=+$P(^(RATO),"^",5)+1
56 S X=+$P(^(RATO),"^",1) I X'<0 D MINUTS^RAUTL1 S $P(^(RATO),"^",2)=Y
57 S X=+$P(^(RATO),"^",3) I X'<0 D MINUTS^RAUTL1 S $P(^(RATO),"^",4)=Y
58 ;Set COMPLETE
59 I '$D(^TMP($J,"RAST",RAIMAGE,RADV,RARQLOC,"COMPLETE")) S ^("COMPLETE")=Y1_"^^"_Y1_"^^1^"_Y1
60 E S:+Y1>+$P(^("COMPLETE"),"^",1) $P(^("COMPLETE"),"^",1)=Y1 S:+Y1<+$P(^("COMPLETE"),"^",3) $P(^("COMPLETE"),"^",3)=Y1 S $P(^("COMPLETE"),"^",6)=+$P(^("COMPLETE"),"^",6)+Y1,$P(^("COMPLETE"),"^",5)=+$P(^("COMPLETE"),"^",5)+1
61 S X=+$P(^("COMPLETE"),"^",1) I X'<0 D MINUTS^RAUTL1 S $P(^("COMPLETE"),"^",2)=Y
62 S X=+$P(^("COMPLETE"),"^",3) I X'<0 D MINUTS^RAUTL1 S $P(^("COMPLETE"),"^",4)=Y
63 Q
64 ;
65YESNO(RAYN,RAQQMRK) ;
66 N RA20,RA20A S RA20=""
67 S RAYN=$$UP^XLFSTR(RAYN)
68 I RAYN="Y"!(RAYN="YE")!(RAYN="YES") Q "Y"
69 I RAYN="N"!(RAYN="NO") Q "N"
70 I RAYN="?" W !,"Answer with either: YES or NO" Q 0
71 I RAYN="??" F RA20A=1:1:5 S RA20=$P(RAQQMRK,"^",RA20A) Q:RA20="" W !,RA20
72 Q "0"
73ISLOCOK(RA20A,RA20J) ;if it isn't selected location
74 N RA20C,RA20D,RA20FL
75 S (RA20C,RA20FL)=0
76 F S RA20C=$O(^TMP(RA20J,"RA REQ-LOC",RA20C)) Q:RA20C="" D
77 .S RA20D=$O(^TMP(RA20J,"RA REQ-LOC",RA20C,0))
78 .S:RA20D=RA20A RA20FL=1 Q
79 .Q
80 Q RA20FL
81 ;
82 ;Generic Yes/No prompt
83 ;Arguments: text of question,retval for Yes, for No, for ^, treat as "N" or "Y" if empty, help text for ??
84ASKYN(RAQUEST,RARETYES,RARETNO,RARETUPA,RARETEMP,RAHLP2QM) ;P24
85ASKAGAN W !,!,RAQUEST R RAINP:DTIME I '$T W $C(7)," Timed out...." Q RARETUPA
86 Q:RAINP="^" RARETUPA
87 S:RAINP="" RAINP=RARETEMP
88 S RAINP=$$YESNO(RAINP,RAHLP2QM)
89 I RAINP="0" G ASKAGAN
90 Q:RAINP="N" RARETNO
91 Q RARETYES
92ASKDTRPT() ;P24
93 N RAYNQST
94 S RAYNQST="Do you wish to print detailed reports? No// "
95 N RAQQHLP
96 S RAQQHLP="Enter YES to obtain detailed reports 'Procedure Detail by Requesting locations'^and 'Division Summary Requesting Location Details '.^Enter NO to skip the reports."
97 Q $$ASKYN(RAYNQST,1,0,-1,"N",RAQQHLP)
Note: See TracBrowser for help on using the repository browser.