| 1 | RART2 ;HISC/GJC-Reporting Menu (Part 3) ;4/3/97 08:33
|
|---|
| 2 | ;;5.0;Radiology/Nuclear Medicine;**26**;Mar 16, 1998
|
|---|
| 3 | 4 ;;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
|
|---|
| 29 | START ; 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
|
|---|
| 37 | CLOSE ; Close the device
|
|---|
| 38 | W ! D ^%ZISC
|
|---|
| 39 | Q4 ; 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
|
|---|
| 50 | CHK(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
|
|---|
