RART2 ;HISC/GJC-Reporting Menu (Part 3) ;4/3/97 08:33
;;5.0;Radiology/Nuclear Medicine;**26,47**;Mar 16, 1998;Build 21
4 ;;Print Report By Patient
K ^TMP($J,"RAEX")
S RAF1="" ; allow the user to select a range of case #'s
S DIC(0)="AEMQ" D ^RADPA
I Y<0 D Q4 Q
S RADFN=+Y,RAHEAD="**** Patient's Exams ****",RAREPORT=1
D ^RAPTLU
I X="^" D Q4 Q
S RAGJC=0 F S RAGJC=$O(^TMP($J,"RAEX",RAGJC)) Q:RAGJC'>0 D
. I '$D(RADUP(RAGJC)) K ^TMP($J,"RAEX",RAGJC) Q
. D CHK(RAGJC) ; check all existing entries!
. Q
I '$D(^TMP($J,"RAEX")) D D Q4 Q ; quit if nothing to print
. W !?4,"There are no reports left to print!",$C(7)
. Q
K %ZIS,IOP W ! S %ZIS="QM",%ZIS("A")="Select a device: "
D ^%ZIS I POP D Q4 Q
I $D(IO("Q")) D D Q4 Q
. S ZTRTN="START^RART2",ZTSAVE("^TMP($J,""RAEX"",")=""
. S ZTDESC="Rad/Nuc Med Print Selected Reports By Patient"
. S:'$D(RADFT) ZTSAVE("RASTFL")="",RASTFL=""
. S:$D(RAOPT) ZTSAVE("RAOPT")=""
. D ^%ZTLOAD
. I +$G(ZTSK("D"))>0 W !?5,"Request Queued, Task #: ",$G(ZTSK)
. D HOME^%ZIS K IO("Q") ;restore home device parameters P26
. Q
START ; start printing the data
U IO S RAGJC=0 ; RAOOUT is defined in RARTR if abnormal exit (eos)
F S RAGJC=$O(^TMP($J,"RAEX",RAGJC)) Q:RAGJC'>0 D Q:$D(RAOOUT)
. S RAXAM=$G(^TMP($J,"RAEX",RAGJC))
. S RARPT=+$P(RAXAM,"^",10) D:RARPT PRT^RARTR
. Q
D CLOSE
Q
CLOSE ; Close the device
W ! D ^%ZISC
Q4 ; Kill & Quit
S:$D(ZTQUEUED) ZTREQ="@"
K %I,%W,%X,%XX,%Y,%YY,%ZHFN,%ZISZ,C,DFN,DIC,DIROUT,DIRUT,DIW,DIWF,DIWL
K DIWR,DIWT,DLAYGO,DTOUT,DUOUT,ER,RACATP,RACN,RACNI,RADATE,RADFN,RADFT
K RADOC,RADTE,RADTI,RADUP,RAF1,RAGJC,RAHEAD,RAI,RAMES,RANM,RANME,RANOW
K RANUM,RAOATP,RAOOUT,RAPAR,RAPOP,RAPRC,RAPTLOC,RAREDT,RAREPORT,RARPT
K RAS,RASEL,RASSN,RAST,RASTFL,RAXAM,X,X1,X2,XMAP0R,XMDISP1,XMGAPI1
;K XMLOC,XMN,XMREC,XQXFLG,XMXUSER,Y,ZTDESC,ZTRTN,ZTSAVE,ZTSK
K XMLOC,XMN,XMREC,XMXUSER,Y,ZTDESC,ZTRTN,ZTSAVE,ZTSK ;P47
K ^TMP($J,"RAEX")
K DIPGM,I,POP,RAIMGTYI,RAVERFDT,RAWHOVER,RAPRTSET,DISYS
Q
CHK(X) ; check if a valid report
; 'X' is the subscript on ^TMP($J,"RAEX")
N RACASE,RAXAM,Y S RAXAM=$G(^TMP($J,"RAEX",X))
S RACASE=$P(RAXAM,"^",8),Y=$P(RAXAM,"^",10)
I '$L(Y)!('$D(^RARPT(+Y,0))) D Q
. W !?3,*7,"No report filed for case number ",RACASE,"."
. K ^TMP($J,"RAEX",X)
. Q
I $D(RADFT),$P(^RARPT(+Y,0),"^",5)'["D" D Q
. W !?3,"Report for case number ",RACASE," is not in a 'draft' status."
. W $C(7) K ^TMP($J,"RAEX",X)
. Q
I '$D(RADFT),$P(^RARPT(+Y,0),"^",5)["D" D Q
. W !?3,"Report filed for case number ",RACASE," but not available"
. W " for printing.",$C(7)
. K ^TMP($J,"RAEX",X)
. Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRART2 2670 printed Apr 09, 2024@21:35:34 Page 2
RART2 ;HISC/GJC-Reporting Menu (Part 3) ;4/3/97 08:33
+1 ;;5.0;Radiology/Nuclear Medicine;**26,47**;Mar 16, 1998;Build 21
4 ;;Print Report By Patient
+1 KILL ^TMP($JOB,"RAEX")
+2 ; allow the user to select a range of case #'s
SET RAF1=""
+3 SET DIC(0)="AEMQ"
DO ^RADPA
+4 IF Y<0
DO Q4
QUIT
+5 SET RADFN=+Y
SET RAHEAD="**** Patient's Exams ****"
SET RAREPORT=1
+6 DO ^RAPTLU
+7 IF X="^"
DO Q4
QUIT
+8 SET RAGJC=0
FOR
SET RAGJC=$ORDER(^TMP($JOB,"RAEX",RAGJC))
if RAGJC'>0
QUIT
Begin DoDot:1
+9 IF '$DATA(RADUP(RAGJC))
KILL ^TMP($JOB,"RAEX",RAGJC)
QUIT
+10 ; check all existing entries!
DO CHK(RAGJC)
+11 QUIT
End DoDot:1
+12 ; quit if nothing to print
IF '$DATA(^TMP($JOB,"RAEX"))
Begin DoDot:1
+13 WRITE !?4,"There are no reports left to print!",$CHAR(7)
+14 QUIT
End DoDot:1
DO Q4
QUIT
+15 KILL %ZIS,IOP
WRITE !
SET %ZIS="QM"
SET %ZIS("A")="Select a device: "
+16 DO ^%ZIS
IF POP
DO Q4
QUIT
+17 IF $DATA(IO("Q"))
Begin DoDot:1
+18 SET ZTRTN="START^RART2"
SET ZTSAVE("^TMP($J,""RAEX"",")=""
+19 SET ZTDESC="Rad/Nuc Med Print Selected Reports By Patient"
+20 if '$DATA(RADFT)
SET ZTSAVE("RASTFL")=""
SET RASTFL=""
+21 if $DATA(RAOPT)
SET ZTSAVE("RAOPT")=""
+22 DO ^%ZTLOAD
+23 IF +$GET(ZTSK("D"))>0
WRITE !?5,"Request Queued, Task #: ",$GET(ZTSK)
+24 ;restore home device parameters P26
DO HOME^%ZIS
KILL IO("Q")
+25 QUIT
End DoDot:1
DO Q4
QUIT
START ; start printing the data
+1 ; RAOOUT is defined in RARTR if abnormal exit (eos)
USE IO
SET RAGJC=0
+2 FOR
SET RAGJC=$ORDER(^TMP($JOB,"RAEX",RAGJC))
if RAGJC'>0
QUIT
Begin DoDot:1
+3 SET RAXAM=$GET(^TMP($JOB,"RAEX",RAGJC))
+4 SET RARPT=+$PIECE(RAXAM,"^",10)
if RARPT
DO PRT^RARTR
+5 QUIT
End DoDot:1
if $DATA(RAOOUT)
QUIT
+6 DO CLOSE
+7 QUIT
CLOSE ; Close the device
+1 WRITE !
DO ^%ZISC
Q4 ; Kill & Quit
+1 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 KILL %I,%W,%X,%XX,%Y,%YY,%ZHFN,%ZISZ,C,DFN,DIC,DIROUT,DIRUT,DIW,DIWF,DIWL
+3 KILL DIWR,DIWT,DLAYGO,DTOUT,DUOUT,ER,RACATP,RACN,RACNI,RADATE,RADFN,RADFT
+4 KILL RADOC,RADTE,RADTI,RADUP,RAF1,RAGJC,RAHEAD,RAI,RAMES,RANM,RANME,RANOW
+5 KILL RANUM,RAOATP,RAOOUT,RAPAR,RAPOP,RAPRC,RAPTLOC,RAREDT,RAREPORT,RARPT
+6 KILL RAS,RASEL,RASSN,RAST,RASTFL,RAXAM,X,X1,X2,XMAP0R,XMDISP1,XMGAPI1
+7 ;K XMLOC,XMN,XMREC,XQXFLG,XMXUSER,Y,ZTDESC,ZTRTN,ZTSAVE,ZTSK
+8 ;P47
KILL XMLOC,XMN,XMREC,XMXUSER,Y,ZTDESC,ZTRTN,ZTSAVE,ZTSK
+9 KILL ^TMP($JOB,"RAEX")
+10 KILL DIPGM,I,POP,RAIMGTYI,RAVERFDT,RAWHOVER,RAPRTSET,DISYS
+11 QUIT
CHK(X) ; check if a valid report
+1 ; 'X' is the subscript on ^TMP($J,"RAEX")
+2 NEW RACASE,RAXAM,Y
SET RAXAM=$GET(^TMP($JOB,"RAEX",X))
+3 SET RACASE=$PIECE(RAXAM,"^",8)
SET Y=$PIECE(RAXAM,"^",10)
+4 IF '$LENGTH(Y)!('$DATA(^RARPT(+Y,0)))
Begin DoDot:1
+5 WRITE !?3,*7,"No report filed for case number ",RACASE,"."
+6 KILL ^TMP($JOB,"RAEX",X)
+7 QUIT
End DoDot:1
QUIT
+8 IF $DATA(RADFT)
IF $PIECE(^RARPT(+Y,0),"^",5)'["D"
Begin DoDot:1
+9 WRITE !?3,"Report for case number ",RACASE," is not in a 'draft' status."
+10 WRITE $CHAR(7)
KILL ^TMP($JOB,"RAEX",X)
+11 QUIT
End DoDot:1
QUIT
+12 IF '$DATA(RADFT)
IF $PIECE(^RARPT(+Y,0),"^",5)["D"
Begin DoDot:1
+13 WRITE !?3,"Report filed for case number ",RACASE," but not available"
+14 WRITE " for printing.",$CHAR(7)
+15 KILL ^TMP($JOB,"RAEX",X)
+16 QUIT
End DoDot:1
QUIT
+17 QUIT
