RAXSTAT ;HIRMFO/GJC-Examination Status List (Print) ;7/24/97 15:18
;;5.0;Radiology/Nuclear Medicine;**31**;Mar 16, 1998
EN1 ; Display Exam Status data by I-Type
K RAVRAD
VEN1 K RADIC,RAQUIT,RAUTIL
S RADIC="^RA(79.2,",RADIC(0)="QEAMZ"
S RADIC("A")="Select Imaging Type: ",RAUTIL="RA XAM STAT"
K ^TMP($J,RAUTIL),^TMP($J,"RA ASK"),^TMP($J,"RA REQ")
D EN1^RASELCT(.RADIC,RAUTIL,"","")
K RADIC,RAUTIL I RAQUIT K RAQUIT,I,POP Q
K RAQUIT
DEV ; Device selection
W ! S %ZIS="QM",%ZIS("A")="Select Device: "
D ^%ZIS I POP K DTOUT,DUOUT,POP Q
I $D(IO("Q")) D Q
. S ZTRTN="START^RAXSTAT"
. S ZTDESC="Rad/Nuc Med Display Examination Status List."
. S ZTSAVE("^TMP($J,""RA XAM STAT"",")=""
. I $D(RAVRAD)#2 S ZTRTN="STARTV^RAXSTAT",ZTDESC="Rad/Nuc Med Display VistaRad Category List.",ZTSAVE("RAVRAD")=""
. D ^%ZTLOAD
. I +$G(ZTSK("D"))>0 W !?5,"Request Queued, Task #: ",$G(ZTSK)
. D HOME^%ZIS K %X,%XX,%Y,%YY,IO("Q"),X,Y,ZTSK
. D EXIT
. Q
I $D(RAVRAD)#2 D STARTV Q ; VistaRad Category only
D START,EXIT
Q
START ; Display output
N I,J,K,RA1,RA72,RAFF,RAFLD,RAFLG,RAHD1,RAHD2,RAIEN,RAIT,RALINE,RANODE
N RAORD,RAPCE,RAPG,RAR,RAREQ,RAREQL,RASK,RASKL,RAST,RAWORK,RAWORKL
N RAXIT S (RAFLG,RAPG,RAXIT)=0
S:$D(ZTQUEUED) ZTREQ="@" U IO S RAHD1="Examination Statuses"
S RAHD2="Run Date: "_$$FMTE^XLFDT($$NOW^XLFDT(),"1P")
S RASK="ASK ON STATUS TRACKING:",$P(RASKL,"-",($L(RASK)+1))=""
S RAREQ="REQUIRED FOR CHANGE TO THIS STATUS:"
S $P(RAREQL,"-",($L(RAREQ)+1))=""
S RAWORK="WORKLOAD REPORTS THAT USE THIS STATUS IN ITS COMPLETION:"
S $P(RAWORKL,"-",($L(RAWORK)+1))=""
S $P(RALINE,"-",(IOM+1))="" S (RA1,RAIT)=""
F S RAIT=$O(^TMP($J,"RA XAM STAT",RAIT)) Q:RAIT']"" D Q:RAXIT
. S RA1=1,RAORD="" S:RAFLG RAXIT=$$EOS^RAUTL5() Q:RAXIT
. D HDR ; Form feed for every I-Type encountered
. F S RAORD=$O(^RA(72,"AA",RAIT,RAORD)) Q:RAORD']"" D Q:RAXIT
.. S RAIEN=0
.. F S RAIEN=+$O(^RA(72,"AA",RAIT,RAORD,RAIEN)) Q:RAIEN'>0 D Q:RAXIT
... D FORMAT
... Q
.. Q
. Q
Q:RAXIT
I 'RAFLG D HDR W !!,$$CJ^XLFSTR("*** No records to print! ***",IOM)
Q
EXIT ; Kill variables
W ! D ^%ZISC K ^TMP($J,"RA XAM STAT")
K %XX,%YY,Y,POP,I,DISYS,RAVRAD
S X=$$EOS^RAUTL5() K X
Q
FORMAT ; Format the output
S RAFF=0,RAFLG=1
S RA72(0)=$G(^RA(72,RAIEN,0)),RA72(.1)=$G(^RA(72,RAIEN,.1))
S RA72(.2)=$G(^RA(72,RAIEN,.2)),RA72(.3)=$G(^RA(72,RAIEN,.3))
S RA72(.5)=$G(^RA(72,RAIEN,.5)),RA72(.6)=$G(^RA(72,RAIEN,.6))
K ^TMP($J,"RA ASK"),^TMP($J,"RA REQ")
D SET(.RA72) ; set TMP globals to display parameters 'Ask On Status
; Tracking' & 'Required For Change To This Status' in a column format
; (side by side)
I RA1 W !?10,"Type Of Imaging: ",RAIT S RA1=0
W !!,"Status: ***",$P(RA72(0),"^")_"***",?54,"Order: ",RAORD
W !,"Default Next Status: ",$$GET1^DIQ(72,+$P(RA72(0),"^",2)_",",.01)
W ?54,"User Key Needed: ",$$GET1^DIQ(72,RAIEN_",",4)
I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT D HDR
W !,"Generate Examined HL7 Message: ",$$GET1^DIQ(72,RAIEN_",",8)
I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT D HDR
W !,"Generate Exam Alert: ",$$GET1^DIQ(72,RAIEN_",",1)
W ?54,"Allow Cancelling?: ",$$GET1^DIQ(72,RAIEN_",",6)
I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT D HDR
W !,"Appear On Status Tracking?: ",$$GET1^DIQ(72,RAIEN_",",5)
W ?54,"Print Dosage Ticket: ",$$GET1^DIQ(72,RAIEN_",",.611)
I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT D HDR
W !,"VistaRad Category: ",$$GET1^DIQ(72,RAIEN_",",9),!
I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT D HDR
W !,RASK,?39,RAREQ,!,RASKL,?39,RAREQL,!
S (RAST,RAR)=.001
F D Q:'RAST&('RAR) Q:RAXIT
. I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT D
.. S RAFF=0 D HDR W !,RASK,?39,RAREQ,!,RASKL,?39,RAREQL,!
.. Q
. W:RAFF ! D ASK:RAST,REQ:RAR S RAFF=1
. Q
Q:RAXIT W !?9,RAWORK,!?9,RAWORKL
F K=.31,.32,.33,.34,.35,.36,.37,.38,.39,.311,.312,.313,.314,.315 D Q:RAXIT
. S RAFLD=$P($G(^DD(72,K,0)),"^") Q:RAFLD=""
. S RANODE=$E(K,1,2),RAPCE=$E(K,3,999999)
. I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT D
.. D HDR W !?9,RAWORK,!?9,RAWORKL
.. Q
. I $$UP^XLFSTR($P(RA72(RANODE),"^",RAPCE))="Y" D
.. W !?14,$P(RAFLD," REPORT?")
.. Q
. Q
W ! K ^TMP($J,"RA ASK"),^TMP($J,"RA REQ")
Q
ASK ; Display 'Ask on Status Tracking' parameters (if any)
S RAST=$O(^TMP($J,"RA ASK",RAST)) Q:RAST'>0
W ?4,$G(^TMP($J,"RA ASK",RAST))
Q
HDR ; Header
D:'$D(IOF) HOME^%ZIS W:$Y @IOF
S RAPG=RAPG+1 W !?(IOM-$L(RAHD1)\2),RAHD1
W ?$S(IOM=132:120,1:68),"Page: ",RAPG
W !,$$CJ^XLFSTR(RAHD2,IOM),!,RALINE
I $D(ZTQUEUED) D STOPCHK^RAUTL9 S:$G(ZTSTOP)=1 RAXIT=1
Q
REQ ; Display 'Required For Change To This Status' parameters (if any)
S RAR=$O(^TMP($J,"RA REQ",RAR)) Q:RAR'>0
W ?44,$G(^TMP($J,"RA REQ",RAR))
Q
SET(RA72) ; set TMP globals so we can display parameters 'Ask On Status
; Tracking' & 'Required For Change To This Status' in a column format
; (side by side)
; Input Variable: 'Y' ien of file 72
F I=.21,.22,.23,.24,.25,.26,.27,.28,.211,.213,.214,.61,.63,.64,.65,.67,.68,.69 D
. S RAFLD=$P($G(^DD(72,I,0)),"^") Q:RAFLD=""
. S RANODE=$E(I,1,2),RAPCE=$E(I,3,999999)
. I $$UP^XLFSTR($P(RA72(RANODE),"^",RAPCE))="Y" D
.. S:RAFLD["ASK FOR " RAFLD=$P(RAFLD,"ASK FOR ",2)
.. S:RAFLD["ASK " RAFLD=$P(RAFLD,"ASK ",2)
.. S ^TMP($J,"RA ASK",I)=$P(RAFLD,"?")
.. Q
. Q
F J=.11,.12,.13,.14,.15,.16,.111,.112,.116,.113,.114,.51,.53,.54,.55,.57,.58,.59 D
. S RAFLD=$P($G(^DD(72,J,0)),"^") Q:RAFLD=""
. S RANODE=$E(J,1,2),RAPCE=$E(J,3,999999)
. I $$UP^XLFSTR($P(RA72(RANODE),"^",RAPCE))="Y" D
.. S:RAFLD[" REQUIRED?" RAFLD=$P(RAFLD," REQUIRED?")
.. S ^TMP($J,"RA REQ",J)=RAFLD
.. Q
. Q
Q
STARTV ;Display VistaRad Category only
N RA1,RA72,RAFLG,RAHD1,RAHD2,RAIEN,RAIT,RAORD,RAPG,RALINE
N RAXIT S (RAFLG,RAPG,RAXIT)=0
S:$D(ZTQUEUED) ZTREQ="@" U IO S RAHD1="VistaRad Categories"
S RAHD2="Run Date: "_$$FMTE^XLFDT($$NOW^XLFDT(),"1P")
S $P(RALINE,"-",(IOM+1))="" S (RA1,RAIT)=""
F S RAIT=$O(^TMP($J,"RA XAM STAT",RAIT)) Q:RAIT']"" D Q:RAXIT
. S RA1=1,RAORD=""
. D:'RAPG HDR ; Form feed 1st page
. F S RAORD=$O(^RA(72,"AA",RAIT,RAORD)) Q:RAORD']"" D Q:RAXIT
.. S RAIEN=0
.. F S RAIEN=+$O(^RA(72,"AA",RAIT,RAORD,RAIEN)) Q:RAIEN'>0 D Q:RAXIT
... S RAFLG=1
... S RA72(0)=$G(^RA(72,RAIEN,0))
... I RA1 D HDR3 S RA1=0 Q:RAXIT
... I $Y>(IOSL-4) S RAXIT=$$EOS^RAUTL5() Q:RAXIT D HDR
... W !,$P(RA72(0),"^"),?30,RAORD,?35,$$GET1^DIQ(72,RAIEN_",",9)
.. Q
. Q
D EXIT
Q
VRADP I '$$IMAGE^RARIC1() W !!,"Current system is not running Vista Imaging -- nothing done.",! Q
S RAVRAD=1 G VEN1
HDR3 I $Y>(IOSL-10) S RAXIT=$$EOS^RAUTL5() Q:RAXIT D HDR
W !!?10,"Type Of Imaging: ",RAIT,!,"Status",?27,"Order",?35,"VistaRad Category",!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAXSTAT 6784 printed Apr 09, 2024@21:42:43 Page 2
RAXSTAT ;HIRMFO/GJC-Examination Status List (Print) ;7/24/97 15:18
+1 ;;5.0;Radiology/Nuclear Medicine;**31**;Mar 16, 1998
EN1 ; Display Exam Status data by I-Type
+1 KILL RAVRAD
VEN1 KILL RADIC,RAQUIT,RAUTIL
+1 SET RADIC="^RA(79.2,"
SET RADIC(0)="QEAMZ"
+2 SET RADIC("A")="Select Imaging Type: "
SET RAUTIL="RA XAM STAT"
+3 KILL ^TMP($JOB,RAUTIL),^TMP($JOB,"RA ASK"),^TMP($JOB,"RA REQ")
+4 DO EN1^RASELCT(.RADIC,RAUTIL,"","")
+5 KILL RADIC,RAUTIL
IF RAQUIT
KILL RAQUIT,I,POP
QUIT
+6 KILL RAQUIT
DEV ; Device selection
+1 WRITE !
SET %ZIS="QM"
SET %ZIS("A")="Select Device: "
+2 DO ^%ZIS
IF POP
KILL DTOUT,DUOUT,POP
QUIT
+3 IF $DATA(IO("Q"))
Begin DoDot:1
+4 SET ZTRTN="START^RAXSTAT"
+5 SET ZTDESC="Rad/Nuc Med Display Examination Status List."
+6 SET ZTSAVE("^TMP($J,""RA XAM STAT"",")=""
+7 IF $DATA(RAVRAD)#2
SET ZTRTN="STARTV^RAXSTAT"
SET ZTDESC="Rad/Nuc Med Display VistaRad Category List."
SET ZTSAVE("RAVRAD")=""
+8 DO ^%ZTLOAD
+9 IF +$GET(ZTSK("D"))>0
WRITE !?5,"Request Queued, Task #: ",$GET(ZTSK)
+10 DO HOME^%ZIS
KILL %X,%XX,%Y,%YY,IO("Q"),X,Y,ZTSK
+11 DO EXIT
+12 QUIT
End DoDot:1
QUIT
+13 ; VistaRad Category only
IF $DATA(RAVRAD)#2
DO STARTV
QUIT
+14 DO START
DO EXIT
+15 QUIT
START ; Display output
+1 NEW I,J,K,RA1,RA72,RAFF,RAFLD,RAFLG,RAHD1,RAHD2,RAIEN,RAIT,RALINE,RANODE
+2 NEW RAORD,RAPCE,RAPG,RAR,RAREQ,RAREQL,RASK,RASKL,RAST,RAWORK,RAWORKL
+3 NEW RAXIT
SET (RAFLG,RAPG,RAXIT)=0
+4 if $DATA(ZTQUEUED)
SET ZTREQ="@"
USE IO
SET RAHD1="Examination Statuses"
+5 SET RAHD2="Run Date: "_$$FMTE^XLFDT($$NOW^XLFDT(),"1P")
+6 SET RASK="ASK ON STATUS TRACKING:"
SET $PIECE(RASKL,"-",($LENGTH(RASK)+1))=""
+7 SET RAREQ="REQUIRED FOR CHANGE TO THIS STATUS:"
+8 SET $PIECE(RAREQL,"-",($LENGTH(RAREQ)+1))=""
+9 SET RAWORK="WORKLOAD REPORTS THAT USE THIS STATUS IN ITS COMPLETION:"
+10 SET $PIECE(RAWORKL,"-",($LENGTH(RAWORK)+1))=""
+11 SET $PIECE(RALINE,"-",(IOM+1))=""
SET (RA1,RAIT)=""
+12 FOR
SET RAIT=$ORDER(^TMP($JOB,"RA XAM STAT",RAIT))
if RAIT']""
QUIT
Begin DoDot:1
+13 SET RA1=1
SET RAORD=""
if RAFLG
SET RAXIT=$$EOS^RAUTL5()
if RAXIT
QUIT
+14 ; Form feed for every I-Type encountered
DO HDR
+15 FOR
SET RAORD=$ORDER(^RA(72,"AA",RAIT,RAORD))
if RAORD']""
QUIT
Begin DoDot:2
+16 SET RAIEN=0
+17 FOR
SET RAIEN=+$ORDER(^RA(72,"AA",RAIT,RAORD,RAIEN))
if RAIEN'>0
QUIT
Begin DoDot:3
+18 DO FORMAT
+19 QUIT
End DoDot:3
if RAXIT
QUIT
+20 QUIT
End DoDot:2
if RAXIT
QUIT
+21 QUIT
End DoDot:1
if RAXIT
QUIT
+22 if RAXIT
QUIT
+23 IF 'RAFLG
DO HDR
WRITE !!,$$CJ^XLFSTR("*** No records to print! ***",IOM)
+24 QUIT
EXIT ; Kill variables
+1 WRITE !
DO ^%ZISC
KILL ^TMP($JOB,"RA XAM STAT")
+2 KILL %XX,%YY,Y,POP,I,DISYS,RAVRAD
+3 SET X=$$EOS^RAUTL5()
KILL X
+4 QUIT
FORMAT ; Format the output
+1 SET RAFF=0
SET RAFLG=1
+2 SET RA72(0)=$GET(^RA(72,RAIEN,0))
SET RA72(.1)=$GET(^RA(72,RAIEN,.1))
+3 SET RA72(.2)=$GET(^RA(72,RAIEN,.2))
SET RA72(.3)=$GET(^RA(72,RAIEN,.3))
+4 SET RA72(.5)=$GET(^RA(72,RAIEN,.5))
SET RA72(.6)=$GET(^RA(72,RAIEN,.6))
+5 KILL ^TMP($JOB,"RA ASK"),^TMP($JOB,"RA REQ")
+6 ; set TMP globals to display parameters 'Ask On Status
DO SET(.RA72)
+7 ; Tracking' & 'Required For Change To This Status' in a column format
+8 ; (side by side)
+9 IF RA1
WRITE !?10,"Type Of Imaging: ",RAIT
SET RA1=0
+10 WRITE !!,"Status: ***",$PIECE(RA72(0),"^")_"***",?54,"Order: ",RAORD
+11 WRITE !,"Default Next Status: ",$$GET1^DIQ(72,+$PIECE(RA72(0),"^",2)_",",.01)
+12 WRITE ?54,"User Key Needed: ",$$GET1^DIQ(72,RAIEN_",",4)
+13 IF $Y>(IOSL-4)
SET RAXIT=$$EOS^RAUTL5()
if RAXIT
QUIT
DO HDR
+14 WRITE !,"Generate Examined HL7 Message: ",$$GET1^DIQ(72,RAIEN_",",8)
+15 IF $Y>(IOSL-4)
SET RAXIT=$$EOS^RAUTL5()
if RAXIT
QUIT
DO HDR
+16 WRITE !,"Generate Exam Alert: ",$$GET1^DIQ(72,RAIEN_",",1)
+17 WRITE ?54,"Allow Cancelling?: ",$$GET1^DIQ(72,RAIEN_",",6)
+18 IF $Y>(IOSL-4)
SET RAXIT=$$EOS^RAUTL5()
if RAXIT
QUIT
DO HDR
+19 WRITE !,"Appear On Status Tracking?: ",$$GET1^DIQ(72,RAIEN_",",5)
+20 WRITE ?54,"Print Dosage Ticket: ",$$GET1^DIQ(72,RAIEN_",",.611)
+21 IF $Y>(IOSL-4)
SET RAXIT=$$EOS^RAUTL5()
if RAXIT
QUIT
DO HDR
+22 WRITE !,"VistaRad Category: ",$$GET1^DIQ(72,RAIEN_",",9),!
+23 IF $Y>(IOSL-4)
SET RAXIT=$$EOS^RAUTL5()
if RAXIT
QUIT
DO HDR
+24 WRITE !,RASK,?39,RAREQ,!,RASKL,?39,RAREQL,!
+25 SET (RAST,RAR)=.001
+26 FOR
Begin DoDot:1
+27 IF $Y>(IOSL-4)
SET RAXIT=$$EOS^RAUTL5()
if RAXIT
QUIT
Begin DoDot:2
+28 SET RAFF=0
DO HDR
WRITE !,RASK,?39,RAREQ,!,RASKL,?39,RAREQL,!
+29 QUIT
End DoDot:2
+30 if RAFF
WRITE !
if RAST
DO ASK
if RAR
DO REQ
SET RAFF=1
+31 QUIT
End DoDot:1
if 'RAST&('RAR)
QUIT
if RAXIT
QUIT
+32 if RAXIT
QUIT
WRITE !?9,RAWORK,!?9,RAWORKL
+33 FOR K=.31,.32,.33,.34,.35,.36,.37,.38,.39,.311,.312,.313,.314,.315
Begin DoDot:1
+34 SET RAFLD=$PIECE($GET(^DD(72,K,0)),"^")
if RAFLD=""
QUIT
+35 SET RANODE=$EXTRACT(K,1,2)
SET RAPCE=$EXTRACT(K,3,999999)
+36 IF $Y>(IOSL-4)
SET RAXIT=$$EOS^RAUTL5()
if RAXIT
QUIT
Begin DoDot:2
+37 DO HDR
WRITE !?9,RAWORK,!?9,RAWORKL
+38 QUIT
End DoDot:2
+39 IF $$UP^XLFSTR($PIECE(RA72(RANODE),"^",RAPCE))="Y"
Begin DoDot:2
+40 WRITE !?14,$PIECE(RAFLD," REPORT?")
+41 QUIT
End DoDot:2
+42 QUIT
End DoDot:1
if RAXIT
QUIT
+43 WRITE !
KILL ^TMP($JOB,"RA ASK"),^TMP($JOB,"RA REQ")
+44 QUIT
ASK ; Display 'Ask on Status Tracking' parameters (if any)
+1 SET RAST=$ORDER(^TMP($JOB,"RA ASK",RAST))
if RAST'>0
QUIT
+2 WRITE ?4,$GET(^TMP($JOB,"RA ASK",RAST))
+3 QUIT
HDR ; Header
+1 if '$DATA(IOF)
DO HOME^%ZIS
if $Y
WRITE @IOF
+2 SET RAPG=RAPG+1
WRITE !?(IOM-$LENGTH(RAHD1)\2),RAHD1
+3 WRITE ?$SELECT(IOM=132:120,1:68),"Page: ",RAPG
+4 WRITE !,$$CJ^XLFSTR(RAHD2,IOM),!,RALINE
+5 IF $DATA(ZTQUEUED)
DO STOPCHK^RAUTL9
if $GET(ZTSTOP)=1
SET RAXIT=1
+6 QUIT
REQ ; Display 'Required For Change To This Status' parameters (if any)
+1 SET RAR=$ORDER(^TMP($JOB,"RA REQ",RAR))
if RAR'>0
QUIT
+2 WRITE ?44,$GET(^TMP($JOB,"RA REQ",RAR))
+3 QUIT
SET(RA72) ; set TMP globals so we can display parameters 'Ask On Status
+1 ; Tracking' & 'Required For Change To This Status' in a column format
+2 ; (side by side)
+3 ; Input Variable: 'Y' ien of file 72
+4 FOR I=.21,.22,.23,.24,.25,.26,.27,.28,.211,.213,.214,.61,.63,.64,.65,.67,.68,.69
Begin DoDot:1
+5 SET RAFLD=$PIECE($GET(^DD(72,I,0)),"^")
if RAFLD=""
QUIT
+6 SET RANODE=$EXTRACT(I,1,2)
SET RAPCE=$EXTRACT(I,3,999999)
+7 IF $$UP^XLFSTR($PIECE(RA72(RANODE),"^",RAPCE))="Y"
Begin DoDot:2
+8 if RAFLD["ASK FOR "
SET RAFLD=$PIECE(RAFLD,"ASK FOR ",2)
+9 if RAFLD["ASK "
SET RAFLD=$PIECE(RAFLD,"ASK ",2)
+10 SET ^TMP($JOB,"RA ASK",I)=$PIECE(RAFLD,"?")
+11 QUIT
End DoDot:2
+12 QUIT
End DoDot:1
+13 FOR J=.11,.12,.13,.14,.15,.16,.111,.112,.116,.113,.114,.51,.53,.54,.55,.57,.58,.59
Begin DoDot:1
+14 SET RAFLD=$PIECE($GET(^DD(72,J,0)),"^")
if RAFLD=""
QUIT
+15 SET RANODE=$EXTRACT(J,1,2)
SET RAPCE=$EXTRACT(J,3,999999)
+16 IF $$UP^XLFSTR($PIECE(RA72(RANODE),"^",RAPCE))="Y"
Begin DoDot:2
+17 if RAFLD[" REQUIRED?"
SET RAFLD=$PIECE(RAFLD," REQUIRED?")
+18 SET ^TMP($JOB,"RA REQ",J)=RAFLD
+19 QUIT
End DoDot:2
+20 QUIT
End DoDot:1
+21 QUIT
STARTV ;Display VistaRad Category only
+1 NEW RA1,RA72,RAFLG,RAHD1,RAHD2,RAIEN,RAIT,RAORD,RAPG,RALINE
+2 NEW RAXIT
SET (RAFLG,RAPG,RAXIT)=0
+3 if $DATA(ZTQUEUED)
SET ZTREQ="@"
USE IO
SET RAHD1="VistaRad Categories"
+4 SET RAHD2="Run Date: "_$$FMTE^XLFDT($$NOW^XLFDT(),"1P")
+5 SET $PIECE(RALINE,"-",(IOM+1))=""
SET (RA1,RAIT)=""
+6 FOR
SET RAIT=$ORDER(^TMP($JOB,"RA XAM STAT",RAIT))
if RAIT']""
QUIT
Begin DoDot:1
+7 SET RA1=1
SET RAORD=""
+8 ; Form feed 1st page
if 'RAPG
DO HDR
+9 FOR
SET RAORD=$ORDER(^RA(72,"AA",RAIT,RAORD))
if RAORD']""
QUIT
Begin DoDot:2
+10 SET RAIEN=0
+11 FOR
SET RAIEN=+$ORDER(^RA(72,"AA",RAIT,RAORD,RAIEN))
if RAIEN'>0
QUIT
Begin DoDot:3
+12 SET RAFLG=1
+13 SET RA72(0)=$GET(^RA(72,RAIEN,0))
+14 IF RA1
DO HDR3
SET RA1=0
if RAXIT
QUIT
+15 IF $Y>(IOSL-4)
SET RAXIT=$$EOS^RAUTL5()
if RAXIT
QUIT
DO HDR
+16 WRITE !,$PIECE(RA72(0),"^"),?30,RAORD,?35,$$GET1^DIQ(72,RAIEN_",",9)
End DoDot:3
if RAXIT
QUIT
+17 QUIT
End DoDot:2
if RAXIT
QUIT
+18 QUIT
End DoDot:1
if RAXIT
QUIT
+19 DO EXIT
+20 QUIT
VRADP IF '$$IMAGE^RARIC1()
WRITE !!,"Current system is not running Vista Imaging -- nothing done.",!
QUIT
+1 SET RAVRAD=1
GOTO VEN1
HDR3 IF $Y>(IOSL-10)
SET RAXIT=$$EOS^RAUTL5()
if RAXIT
QUIT
DO HDR
+1 WRITE !!?10,"Type Of Imaging: ",RAIT,!,"Status",?27,"Order",?35,"VistaRad Category",!
+2 QUIT
