source: WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAWFR1.m@ 861

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

initial load of WorldVistAEHR

File size: 3.8 KB
Line 
1RAWFR1 ;HISC/GJC-'Wasted Film Report' (1 of 4) ;4/15/96 07:22
2 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
3 ;
4 ; *** Variable List ***
5 ; ------------------ Validate Rad/Nuc Med User -------------------------
6 I '($D(RACCESS)\10) D SETVARS^RAPSET1(0) S RAPSTX=""
7 I '($D(RACCESS)\10) D ACCVIO^RAUTL19,KILL^RAWFR3 Q
8 ; ----------------------------------------------------------------------
9 K ^TMP($J,"RA WFR") S RATDAY=$$FMTE^XLFDT($$NOW^XLFDT,1)
10 S RADATE=$$FMTE^XLFDT($$NOW^XLFDT\1,1),RAXIT=0
11 K X,Y,Z S X="Radiology/Nuclear Med" W @IOF
12 S Y="*** Wasted Film Report ***",$P(Z,"-",($L(Y)+1))=""
13 W !?(IOM-$L(X)\2),X,!?(IOM-$L(Y)\2),Y,!?(IOM-$L(Z)\2),Z,!
14 K DIR,X,Y,Z
15 S DIR("A")="Do you wish to generate a summary report only"
16 S DIR("?",1)="Enter 'Y' to generate a general summary report by division."
17 S DIR("?")="Enter <CR> or 'No' to generate a detailed divisional report."
18 S DIR("B")="No",DIR(0)="Y" D ^DIR K DIR
19 I $D(DIRUT) D D KILL^RAWFR3 Q
20 . W !?5,$C(7),"The 'Summary Report' question must be answered to"
21 . W !?5,"continue on with the 'Wasted Film Report'."
22 . Q
23 S RASYN=+Y W !
24DIVITY ; Select division/imaging type
25 S X=$$DIVLOC^RAUTL7()
26 I X D KILL^RAWFR3 Q
27 I $D(RACCESS(DUZ,"DIV-IMG")) D
28 . D ZEROUT^RAWFR4
29 . Q
30 E D KILL^RAWFR3 Q
31 ; *** Start of Exam Status display ***
32 D DISPXAM^RAWFR4(6)
33 I RAXIT!('($D(RAWFR)\10)) D KILL^RAWFR3 Q
34 ; *** End of Exam Status display ***
35STRTDT ; *** Prompt for Starting Date ***
36 W ! K DIR S DIR(0)="DA^:"_DT_":PEA"
37 S DIR("A")="Enter the start date for the search: "
38 S DIR("?",1)="This is the date from which our search will begin."
39 S DIR("?",2)="Think of it in terms of 'FROM' and 'TO'. This date is our 'FROM'."
40 S DIR("?",3)="The starting date must not exceed: "_RADATE_"."
41 S DIR("?")="Dates associated with a time will not be accepted."
42 S DIR("B")=RADATE D ^DIR K DIR
43 I $D(DIRUT) D KILL^RAWFR3 Q
44 S RABGDTI=Y,RABGDTX=Y(0),RAMBGDT=RABGDTI-.0001
45 ;
46ENDDT ; *** Prompt for Ending Date ***
47 W ! K DIR S DIR(0)="DA^"_RABGDTI_":"_DT_":PEA"
48 S DIR("A")="Enter the ending date for the search: "
49 S DIR("?",1)="This is the date in which our search will end."
50 S DIR("?",2)="Think of it in terms of 'FROM' and 'TO'. This date is our 'TO'."
51 S DIR("?",3)="The ending date must not exceed: "_RADATE_"."
52 S DIR("?",4)="The ending date must not precede: "_RABGDTX_"."
53 S DIR("?")="Dates associated with a time will not be accepted."
54 S DIR("B")=RABGDTX D ^DIR K DIR
55 I $D(DIRUT) D KILL^RAWFR3 Q
56 S RAENDTI=Y,RAENDTX=Y(0),RAMENDT=RAENDTI+.9999
57 S ZTSAVE("RA*")="",ZTSAVE("^TMP($J,""RA D-TYPE"",")=""
58 S ZTSAVE("^TMP($J,""RA I-TYPE"",")="",ZTSAVE("^TMP($J,""RA WFR"",")=""
59 S ZTRTN="START^RAWFR1"
60 S ZTDESC="Rad/Nuc Med Wasted Film report"
61 W ! D ZIS^RAUTL
62 I POP D KILL^RAWFR3 Q
63 I +$G(RAPOP) D KILL^RAWFR3 Q ;'RAPOP' set to '1' if task is created
64START ; Start the sort/print process
65 U IO S $P(RALINE,"-",$S(IOM=132:133,1:81))=""
66 S:$D(ZTQUEUED) ZTREQ="@"
67 S RAHEAD=">>>>> Wasted Film Report <<<<<"
68 F RADT=RAMBGDT:0:RAMENDT S RADT=$O(^RADPT("AR",RADT)) Q:RADT'>0!(RADT>RAMENDT)!(RAXIT) D
69 . S RADFN=0 F S RADFN=$O(^RADPT("AR",RADT,RADFN)) Q:RADFN'>0!(RAXIT) D
70 .. S RADTI=0 F S RADTI=$O(^RADPT("AR",RADT,RADFN,RADTI)) Q:RADTI'>0!(RAXIT) D
71 ... I $G(^RADPT(RADFN,"DT",RADTI,0))]"" D
72 .... S RARP0=$G(^RADPT(RADFN,"DT",RADTI,0)) D RAEXAM
73 .... Q
74 ... Q
75 .. Q
76 . Q
77 ; If 'RASYN'=1 do summary
78 I 'RAXIT D:RASYN COMPSUM^RAWFR2 D:'RASYN COMP^RAWFR3
79 K RACCESS(DUZ,"DIV-IMG") W ! D ^%ZISC
80 D KILL^RAWFR3
81 Q
82RAEXAM ; Journey through the 'Examination' multiple.
83 S RAEX=0
84 F S RAEX=$O(^RADPT(RADFN,"DT",RADTI,"P",RAEX)) Q:RAEX'>0!(RAXIT) D
85 . I $G(^RADPT(RADFN,"DT",RADTI,"P",RAEX,0))]"" D
86 .. S RAEX0=$G(^RADPT(RADFN,"DT",RADTI,"P",RAEX,0))
87 .. S RAEXS=+$P(RAEX0,U,3)
88 .. I $D(RAWFR(RAEXS)) D SETUP^RAWFR2
89 .. Q
90 . Q
91 Q
Note: See TracBrowser for help on using the repository browser.