source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RART2.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 2.5 KB
Line 
1RART2 ;HISC/GJC-Reporting Menu (Part 3) ;4/3/97 08:33
2 ;;5.0;Radiology/Nuclear Medicine;**26**;Mar 16, 1998
34 ;;Print Report By Patient
4 K ^TMP($J,"RAEX")
5 S RAF1="" ; allow the user to select a range of case #'s
6 S DIC(0)="AEMQ" D ^RADPA
7 I Y<0 D Q4 Q
8 S RADFN=+Y,RAHEAD="**** Patient's Exams ****",RAREPORT=1
9 D ^RAPTLU
10 I X="^" D Q4 Q
11 S RAGJC=0 F S RAGJC=$O(^TMP($J,"RAEX",RAGJC)) Q:RAGJC'>0 D
12 . I '$D(RADUP(RAGJC)) K ^TMP($J,"RAEX",RAGJC) Q
13 . D CHK(RAGJC) ; check all existing entries!
14 . Q
15 I '$D(^TMP($J,"RAEX")) D D Q4 Q ; quit if nothing to print
16 . W !?4,"There are no reports left to print!",$C(7)
17 . Q
18 K %ZIS,IOP W ! S %ZIS="QM",%ZIS("A")="Select a device: "
19 D ^%ZIS I POP D Q4 Q
20 I $D(IO("Q")) D D Q4 Q
21 . S ZTRTN="START^RART2",ZTSAVE("^TMP($J,""RAEX"",")=""
22 . S ZTDESC="Rad/Nuc Med Print Selected Reports By Patient"
23 . S:'$D(RADFT) ZTSAVE("RASTFL")="",RASTFL=""
24 . S:$D(RAOPT) ZTSAVE("RAOPT")=""
25 . D ^%ZTLOAD
26 . I +$G(ZTSK("D"))>0 W !?5,"Request Queued, Task #: ",$G(ZTSK)
27 . D HOME^%ZIS K IO("Q") ;restore home device parameters P26
28 . Q
29START ; start printing the data
30 U IO S RAGJC=0 ; RAOOUT is defined in RARTR if abnormal exit (eos)
31 F S RAGJC=$O(^TMP($J,"RAEX",RAGJC)) Q:RAGJC'>0 D Q:$D(RAOOUT)
32 . S RAXAM=$G(^TMP($J,"RAEX",RAGJC))
33 . S RARPT=+$P(RAXAM,"^",10) D:RARPT PRT^RARTR
34 . Q
35 D CLOSE
36 Q
37CLOSE ; Close the device
38 W ! D ^%ZISC
39Q4 ; Kill & Quit
40 S:$D(ZTQUEUED) ZTREQ="@"
41 K %I,%W,%X,%XX,%Y,%YY,%ZHFN,%ZISZ,C,DFN,DIC,DIROUT,DIRUT,DIW,DIWF,DIWL
42 K DIWR,DIWT,DLAYGO,DTOUT,DUOUT,ER,RACATP,RACN,RACNI,RADATE,RADFN,RADFT
43 K RADOC,RADTE,RADTI,RADUP,RAF1,RAGJC,RAHEAD,RAI,RAMES,RANM,RANME,RANOW
44 K RANUM,RAOATP,RAOOUT,RAPAR,RAPOP,RAPRC,RAPTLOC,RAREDT,RAREPORT,RARPT
45 K RAS,RASEL,RASSN,RAST,RASTFL,RAXAM,X,X1,X2,XMAP0R,XMDISP1,XMGAPI1
46 K XMLOC,XMN,XMREC,XQXFLG,XMXUSER,Y,ZTDESC,ZTRTN,ZTSAVE,ZTSK
47 K ^TMP($J,"RAEX")
48 K DIPGM,I,POP,RAIMGTYI,RAVERFDT,RAWHOVER,RAPRTSET,DISYS
49 Q
50CHK(X) ; check if a valid report
51 ; 'X' is the subscript on ^TMP($J,"RAEX")
52 N RACASE,RAXAM,Y S RAXAM=$G(^TMP($J,"RAEX",X))
53 S RACASE=$P(RAXAM,"^",8),Y=$P(RAXAM,"^",10)
54 I '$L(Y)!('$D(^RARPT(+Y,0))) D Q
55 . W !?3,*7,"No report filed for case number ",RACASE,"."
56 . K ^TMP($J,"RAEX",X)
57 . Q
58 I $D(RADFT),$P(^RARPT(+Y,0),"^",5)'["D" D Q
59 . W !?3,"Report for case number ",RACASE," is not in a 'draft' status."
60 . W $C(7) K ^TMP($J,"RAEX",X)
61 . Q
62 I '$D(RADFT),$P(^RARPT(+Y,0),"^",5)["D" D Q
63 . W !?3,"Report filed for case number ",RACASE," but not available"
64 . W " for printing.",$C(7)
65 . K ^TMP($J,"RAEX",X)
66 . Q
67 Q
Note: See TracBrowser for help on using the repository browser.