- 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 Feb 19, 2025@00:07:07 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
