- 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
- 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
