- OROVRRPT ;SLC/TC - Order Check Override Reason Report Utility; 8/31/06 1:45pm
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**243**;Dec 17, 1997;Build 242
- ;
- EN ;
- N ANS,TMP
- W @IOF
- D ASKUSER^ORSRCHOR(.ANS,"FILTER SEARCH by") Q:$G(ANS("EXIT"))="YES"
- D
- . N POP,ORDESC,ORRTN,ORSAVE
- . S ORDESC="OROVRRPT Override Reason Report",ORRTN="DISPLAY^OROVRRPT",ORSAVE("*")=""
- . W ! D EN^XUTMDEVQ(ORRTN,ORDESC,.ORSAVE) K ^TMP("OROVRRPT",$J)
- Q
- ;
- DISPLAY ; Print data in an organized report format.
- ;
- D HEADER^ORSRCHOR
- N ORSUB1,ORSUB2,ORSUB3,ORSUB4,ORDNO,NORECS,ORCONT,LINECNT,RECNO S (ORSUB1,ORSUB2,ORSUB3,ORSUB4,ORDNO,RECNO)=0,NORECS="NO RECORDS FOUND!",ORCONT=1
- S LINECNT=$S(ANS("SORT")="OVRDNBY":12,ANS("SORT")="ORCHK":11,ANS("SORT")="DIV":11,ANS("SORT")="DSPGRP":11,ANS("SORT")="DTORD":12)
- F S ORSUB1=$O(^TMP("OROVRRPT",$J,ORSUB1)) Q:ORSUB1="" D Q:ORCONT=0
- . F S ORSUB2=$O(^TMP("OROVRRPT",$J,ORSUB1,ORSUB2)) Q:ORSUB2="" D Q:ORCONT=0
- . . F S ORSUB3=$O(^TMP("OROVRRPT",$J,ORSUB1,ORSUB2,ORSUB3)) Q:ORSUB3="" D Q:ORCONT=0
- . . . F S ORSUB4=$O(^TMP("OROVRRPT",$J,ORSUB1,ORSUB2,ORSUB3,ORSUB4)) Q:ORSUB4="" D Q:ORCONT=0
- . . . . F S ORDNO=$O(^TMP("OROVRRPT",$J,ORSUB1,ORSUB2,ORSUB3,ORSUB4,ORDNO)) Q:ORDNO="" D Q:ORCONT=0
- . . . . . N DATA,OVRRIDBY,ORDCHK1,ORDCHK2,ORDCHK S DATA=$G(^TMP("OROVRRPT",$J,ORSUB1,ORSUB2,ORSUB3,ORSUB4,ORDNO)),OVRRIDBY=$P($G(^VA(200,+$P(DATA,U,3),0)),U)
- . . . . . I '$L(OVRRIDBY) S OVRRIDBY="NONE SPECIFIED"
- . . . . . S ORDCHK1=$S(ANS("SORT")="OVRDNBY":ORSUB4,ANS("SORT")="ORCHK":ORSUB1,ANS("SORT")="DIV":ORSUB3,ANS("SORT")="DSPGRP":ORSUB3,ANS("SORT")="DTORD":ORSUB4)
- . . . . . S ORDCHK2=$P(DATA,U,5),ORDCHK=$S($L(ORDCHK2)>1:ORDCHK1_ORDCHK2,1:ORDCHK1)
- . . . . . I ANS("DELIMIT")="YES" D ; Delimited report printout of non-word processing fields
- . . . . . . S RECNO=RECNO+1
- . . . . . . I ANS("SORT")="OVRDNBY" W !,RECNO_TMP("DLMTR")_$$FMTE^XLFDT(ORSUB1,"1P")_TMP("DLMTR")_ORSUB2_TMP("DLMTR")_ORSUB3_TMP("DLMTR")_ORDNO_TMP("DLMTR")_$$FMTE^XLFDT($P(DATA,U,4),"1P")
- . . . . . . I ANS("SORT")="ORCHK" W !,RECNO_TMP("DLMTR")_$$FMTE^XLFDT(ORSUB4,"1P")_TMP("DLMTR")_ORSUB2_TMP("DLMTR")_ORSUB3_TMP("DLMTR")_ORDNO_TMP("DLMTR")_OVRRIDBY_TMP("DLMTR")_$$FMTE^XLFDT($P(DATA,U,4),"1P")
- . . . . . . I ANS("SORT")="DIV" W !,RECNO_TMP("DLMTR")_$$FMTE^XLFDT(ORSUB4,"1P")_TMP("DLMTR")_ORSUB2_TMP("DLMTR")_ORDNO_TMP("DLMTR")_OVRRIDBY_TMP("DLMTR")_$$FMTE^XLFDT($P(DATA,U,4),"1P")
- . . . . . . I ANS("SORT")="DSPGRP" W !,RECNO_TMP("DLMTR")_$$FMTE^XLFDT(ORSUB4,"1P")_TMP("DLMTR")_ORSUB2_TMP("DLMTR")_ORDNO_TMP("DLMTR")_OVRRIDBY_TMP("DLMTR")_$$FMTE^XLFDT($P(DATA,U,4),"1P")
- . . . . . . I ANS("SORT")="DTORD" W !,RECNO_TMP("DLMTR")_$$FMTE^XLFDT(ORSUB1,"1P")_TMP("DLMTR")_ORDNO_TMP("DLMTR")_OVRRIDBY_TMP("DLMTR")_$$FMTE^XLFDT($P(DATA,U,4),"1P")
- . . . . . . S ^TMP(ANS("SORT"),"ORDER TEXT",RECNO)=$P(DATA,U),^TMP(ANS("SORT"),"ORDER CHK",RECNO)=ORDCHK,^TMP(ANS("SORT"),"OVERRIDE REASON",RECNO)=$P(DATA,U,2)
- . . . . . E D ; Summary report printout
- . . . . . . I ANS("SORT")="OVRDNBY"&(ORCONT=1) W !,$$FMTE^XLFDT(ORSUB1,"1M"),?21,ORSUB2,?40,ORSUB3,?70,ORDNO
- . . . . . . I ANS("SORT")="ORCHK"&(ORCONT=1) W !,$$FMTE^XLFDT(ORSUB4,"1M"),?21,ORSUB2,?40,ORSUB3,?70,ORDNO
- . . . . . . I ANS("SORT")="DIV"&(ORCONT=1) W !,$$FMTE^XLFDT(ORSUB4,"1M"),?25,ORSUB2,?60,ORDNO
- . . . . . . I ANS("SORT")="DSPGRP"&(ORCONT=1) W !,$$FMTE^XLFDT(ORSUB4,"1M"),?25,ORSUB2,?60,ORDNO
- . . . . . . I ANS("SORT")="DTORD"&(ORCONT=1) W !,$$FMTE^XLFDT(ORSUB1,"1M"),?45,ORDNO
- . . . . . . S LINECNT=$$CHK4BRK(LINECNT)
- . . . . . . I ANS("SORT")="OVRDNBY"&(ORCONT=1) W !?3,"D/T Overridden: ",$$FMTE^XLFDT($P(DATA,U,4),"1M")
- . . . . . . E I ORCONT=1 W !?3,"Overridden by: ",OVRRIDBY,?46,"D/T Overridden: ",$$FMTE^XLFDT($P(DATA,U,4),"1M")
- . . . . . . S LINECNT=$$CHK4BRK(LINECNT)
- . . . . . . N CNT,CNT1,CNT2,ORDTXT,OVRRSN S ORDTXT=$P(DATA,U),OVRRSN=$P(DATA,U,2) I ($L(ORDTXT)>65)!($L(OVRRSN)>60)!($L(ORDCHK)>66) D
- . . . . . . . S ORDTXT=$$WRAP^TIULS(ORDTXT,65) I ORCONT=1 W !?3,"Order Text: ",$P(ORDTXT,"|") S LINECNT=$$CHK4BRK(LINECNT)
- . . . . . . . I $L(ORDTXT,"|")>1 F CNT=2:1:$L(ORDTXT,"|") I ORCONT=1 W !?15,$P(ORDTXT,"|",CNT) S LINECNT=$$CHK4BRK(LINECNT)
- . . . . . . . S ORDCHK=$$WRAP^TIULS(ORDCHK,66) I ORCONT=1 W !?3,"Order Chk: ",$P(ORDCHK,"|") S LINECNT=$$CHK4BRK(LINECNT)
- . . . . . . . I $L(ORDCHK,"|")>1 F CNT2=2:1:$L(ORDCHK,"|") I ORCONT=1 W !?14,$P(ORDCHK,"|",CNT2) S LINECNT=$$CHK4BRK(LINECNT)
- . . . . . . . S OVRRSN=$$WRAP^TIULS(OVRRSN,60) I ORCONT=1 W !?3,"Override Reason: ",$P(OVRRSN,"|") S LINECNT=$$CHK4BRK(LINECNT)
- . . . . . . . I (ORCONT=1)&($L(OVRRSN,"|")=1) W ! S LINECNT=$$CHK4BRK(LINECNT)
- . . . . . . . E I $L(OVRRSN,"|")>1 D
- . . . . . . . . F CNT1=2:1:$L(OVRRSN,"|") D Q:ORCONT=0
- . . . . . . . . . W !?20,$P(OVRRSN,"|",CNT1) S LINECNT=$$CHK4BRK(LINECNT)
- . . . . . . . . . I CNT1=$L(OVRRSN,"|") W ! S LINECNT=$$CHK4BRK(LINECNT)
- . . . . . . E I ORCONT=1 D
- . . . . . . . W !?3,"Order Text: ",ORDTXT S LINECNT=$$CHK4BRK(LINECNT)
- . . . . . . . W !?3,"Order Chk: ",ORDCHK S LINECNT=$$CHK4BRK(LINECNT)
- . . . . . . . W !?3,"Override Reason: ",OVRRSN S LINECNT=$$CHK4BRK(LINECNT)
- . . . . . . . W ! S LINECNT=$$CHK4BRK(LINECNT)
- I ANS("DELIMIT")="YES"&($D(^TMP("OROVRRPT",$J))) D ; Delimited report printout of word-processing fields
- . N ROUND F ROUND=1:1:3 D Q:ANS("CONT")="NO"
- . . N DIR,DIRUT,Y,FLD S FLD=$S(ROUND=1:"ORDER TEXT",ROUND=2:"ORDER CHK",ROUND=3:"OVERRIDE REASON"),DIR(0)="Y",DIR("A")="Continue to export the "_FLD_" field only",DIR("B")="YES"
- . . S DIR("?",1)="Entering 'YES' will print out a delimited report of the word-processing field.",DIR("?",2)=""
- . . S DIR("?")="Entering 'NO' will complete the report and allow the user to exit the program." W ! D ^DIR K DIR W !
- . . I '$D(DIRUT),Y=1 D
- . . . S ANS("CONT")="YES" W !,"RECNO"_TMP("DLMTR")_FLD
- . . . N RECNO S RECNO="" F S RECNO=$O(^TMP(ANS("SORT"),FLD,RECNO)) Q:RECNO="" W !,RECNO_TMP("DLMTR"),$G(^TMP(ANS("SORT"),FLD,RECNO))
- . . E S ANS("CONT")="NO" Q
- I '$D(^TMP("OROVRRPT",$J)) W !!!?(IOM-$L(NORECS))/2,NORECS,!!
- K ^TMP("OROVRRPT",$J),^TMP(ANS("SORT"))
- I ($E(IOST)="C")&(ORCONT=1) W ! N DIR,DIRUT S DIR(0)="E",DIR("A")="Report Completed. Please Press ENTER to EXIT" D ^DIR Q:$D(DIRUT)
- Q
- ;
- PGBRK() ; Executes page breaks for a terminal device.
- ; If ORCONT=1, continue page break.
- ; If ORCONT=0, Quit page break.
- ;
- N DIR,Y,ORCONT,DIRUT S DIR(0)="E" D ^DIR S ORCONT=Y Q ORCONT
- ;
- CHK4BRK(LINECNT) ; Check for page break and display appropriate column headers for terminal screen display.
- ;
- S LINECNT=LINECNT+1
- I ($E(IOST)="C")&(IOSL<98)&(LINECNT=22) W ! S ORCONT=$$PGBRK,LINECNT=2 I ORCONT=1 W @IOF D COLHDR^ORSRCHOR
- Q LINECNT
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HOROVRRPT 6744 printed Jan 18, 2025@03:33:32 Page 2
- OROVRRPT ;SLC/TC - Order Check Override Reason Report Utility; 8/31/06 1:45pm
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**243**;Dec 17, 1997;Build 242
- +2 ;
- EN ;
- +1 NEW ANS,TMP
- +2 WRITE @IOF
- +3 DO ASKUSER^ORSRCHOR(.ANS,"FILTER SEARCH by")
- if $GET(ANS("EXIT"))="YES"
- QUIT
- +4 Begin DoDot:1
- +5 NEW POP,ORDESC,ORRTN,ORSAVE
- +6 SET ORDESC="OROVRRPT Override Reason Report"
- SET ORRTN="DISPLAY^OROVRRPT"
- SET ORSAVE("*")=""
- +7 WRITE !
- DO EN^XUTMDEVQ(ORRTN,ORDESC,.ORSAVE)
- KILL ^TMP("OROVRRPT",$JOB)
- End DoDot:1
- +8 QUIT
- +9 ;
- DISPLAY ; Print data in an organized report format.
- +1 ;
- +2 DO HEADER^ORSRCHOR
- +3 NEW ORSUB1,ORSUB2,ORSUB3,ORSUB4,ORDNO,NORECS,ORCONT,LINECNT,RECNO
- SET (ORSUB1,ORSUB2,ORSUB3,ORSUB4,ORDNO,RECNO)=0
- SET NORECS="NO RECORDS FOUND!"
- SET ORCONT=1
- +4 SET LINECNT=$SELECT(ANS("SORT")="OVRDNBY":12,ANS("SORT")="ORCHK":11,ANS("SORT")="DIV":11,ANS("SORT")="DSPGRP":11,ANS("SORT")="DTORD":12)
- +5 FOR
- SET ORSUB1=$ORDER(^TMP("OROVRRPT",$JOB,ORSUB1))
- if ORSUB1=""
- QUIT
- Begin DoDot:1
- +6 FOR
- SET ORSUB2=$ORDER(^TMP("OROVRRPT",$JOB,ORSUB1,ORSUB2))
- if ORSUB2=""
- QUIT
- Begin DoDot:2
- +7 FOR
- SET ORSUB3=$ORDER(^TMP("OROVRRPT",$JOB,ORSUB1,ORSUB2,ORSUB3))
- if ORSUB3=""
- QUIT
- Begin DoDot:3
- +8 FOR
- SET ORSUB4=$ORDER(^TMP("OROVRRPT",$JOB,ORSUB1,ORSUB2,ORSUB3,ORSUB4))
- if ORSUB4=""
- QUIT
- Begin DoDot:4
- +9 FOR
- SET ORDNO=$ORDER(^TMP("OROVRRPT",$JOB,ORSUB1,ORSUB2,ORSUB3,ORSUB4,ORDNO))
- if ORDNO=""
- QUIT
- Begin DoDot:5
- +10 NEW DATA,OVRRIDBY,ORDCHK1,ORDCHK2,ORDCHK
- SET DATA=$GET(^TMP("OROVRRPT",$JOB,ORSUB1,ORSUB2,ORSUB3,ORSUB4,ORDNO))
- SET OVRRIDBY=$PIECE($GET(^VA(200,+$PIECE(DATA,U,3),0)),U)
- +11 IF '$LENGTH(OVRRIDBY)
- SET OVRRIDBY="NONE SPECIFIED"
- +12 SET ORDCHK1=$SELECT(ANS("SORT")="OVRDNBY":ORSUB4,ANS("SORT")="ORCHK":ORSUB1,ANS("SORT")="DIV":ORSUB3,ANS("SORT")="DSPGRP":ORSUB3,ANS("SORT")="DTORD":ORSUB4)
- +13 SET ORDCHK2=$PIECE(DATA,U,5)
- SET ORDCHK=$SELECT($LENGTH(ORDCHK2)>1:ORDCHK1_ORDCHK2,1:ORDCHK1)
- +14 ; Delimited report printout of non-word processing fields
- IF ANS("DELIMIT")="YES"
- Begin DoDot:6
- +15 SET RECNO=RECNO+1
- +16 IF ANS("SORT")="OVRDNBY"
- WRITE !,RECNO_TMP("DLMTR")_$$FMTE^XLFDT(ORSUB1,"1P")_TMP("DLMTR")_ORSUB2_TMP("DLMTR")_ORSUB3_TMP("DLMTR")_ORDNO_TMP("DLMTR")_$$FMTE^XLFDT($PIECE(DATA,U,4),"1P")
- +17 IF ANS("SORT")="ORCHK"
- WRITE !,RECNO_TMP("DLMTR")_$$FMTE^XLFDT(ORSUB4,"1P")_TMP("DLMTR")_ORSUB2_TMP("DLMTR")_ORSUB3_TMP("DLMTR")_ORDNO_TMP("DLMTR")_OVRRIDBY_TMP("DLMTR")_$$FMTE^XLFDT($PIECE(DATA,U,4),"1P")
- +18 IF ANS("SORT")="DIV"
- WRITE !,RECNO_TMP("DLMTR")_$$FMTE^XLFDT(ORSUB4,"1P")_TMP("DLMTR")_ORSUB2_TMP("DLMTR")_ORDNO_TMP("DLMTR")_OVRRIDBY_TMP("DLMTR")_$$FMTE^XLFDT($PIECE(DATA,U,4),"1P")
- +19 IF ANS("SORT")="DSPGRP"
- WRITE !,RECNO_TMP("DLMTR")_$$FMTE^XLFDT(ORSUB4,"1P")_TMP("DLMTR")_ORSUB2_TMP("DLMTR")_ORDNO_TMP("DLMTR")_OVRRIDBY_TMP("DLMTR")_$$FMTE^XLFDT($PIECE(DATA,U,4),"1P")
- +20 IF ANS("SORT")="DTORD"
- WRITE !,RECNO_TMP("DLMTR")_$$FMTE^XLFDT(ORSUB1,"1P")_TMP("DLMTR")_ORDNO_TMP("DLMTR")_OVRRIDBY_TMP("DLMTR")_$$FMTE^XLFDT($PIECE(DATA,U,4),"1P")
- +21 SET ^TMP(ANS("SORT"),"ORDER TEXT",RECNO)=$PIECE(DATA,U)
- SET ^TMP(ANS("SORT"),"ORDER CHK",RECNO)=ORDCHK
- SET ^TMP(ANS("SORT"),"OVERRIDE REASON",RECNO)=$PIECE(DATA,U,2)
- End DoDot:6
- +22 ; Summary report printout
- IF '$TEST
- Begin DoDot:6
- +23 IF ANS("SORT")="OVRDNBY"&(ORCONT=1)
- WRITE !,$$FMTE^XLFDT(ORSUB1,"1M"),?21,ORSUB2,?40,ORSUB3,?70,ORDNO
- +24 IF ANS("SORT")="ORCHK"&(ORCONT=1)
- WRITE !,$$FMTE^XLFDT(ORSUB4,"1M"),?21,ORSUB2,?40,ORSUB3,?70,ORDNO
- +25 IF ANS("SORT")="DIV"&(ORCONT=1)
- WRITE !,$$FMTE^XLFDT(ORSUB4,"1M"),?25,ORSUB2,?60,ORDNO
- +26 IF ANS("SORT")="DSPGRP"&(ORCONT=1)
- WRITE !,$$FMTE^XLFDT(ORSUB4,"1M"),?25,ORSUB2,?60,ORDNO
- +27 IF ANS("SORT")="DTORD"&(ORCONT=1)
- WRITE !,$$FMTE^XLFDT(ORSUB1,"1M"),?45,ORDNO
- +28 SET LINECNT=$$CHK4BRK(LINECNT)
- +29 IF ANS("SORT")="OVRDNBY"&(ORCONT=1)
- WRITE !?3,"D/T Overridden: ",$$FMTE^XLFDT($PIECE(DATA,U,4),"1M")
- +30 IF '$TEST
- IF ORCONT=1
- WRITE !?3,"Overridden by: ",OVRRIDBY,?46,"D/T Overridden: ",$$FMTE^XLFDT($PIECE(DATA,U,4),"1M")
- +31 SET LINECNT=$$CHK4BRK(LINECNT)
- +32 NEW CNT,CNT1,CNT2,ORDTXT,OVRRSN
- SET ORDTXT=$PIECE(DATA,U)
- SET OVRRSN=$PIECE(DATA,U,2)
- IF ($LENGTH(ORDTXT)>65)!($LENGTH(OVRRSN)>60)!($LENGTH(ORDCHK)>66)
- Begin DoDot:7
- +33 SET ORDTXT=$$WRAP^TIULS(ORDTXT,65)
- IF ORCONT=1
- WRITE !?3,"Order Text: ",$PIECE(ORDTXT,"|")
- SET LINECNT=$$CHK4BRK(LINECNT)
- +34 IF $LENGTH(ORDTXT,"|")>1
- FOR CNT=2:1:$LENGTH(ORDTXT,"|")
- IF ORCONT=1
- WRITE !?15,$PIECE(ORDTXT,"|",CNT)
- SET LINECNT=$$CHK4BRK(LINECNT)
- +35 SET ORDCHK=$$WRAP^TIULS(ORDCHK,66)
- IF ORCONT=1
- WRITE !?3,"Order Chk: ",$PIECE(ORDCHK,"|")
- SET LINECNT=$$CHK4BRK(LINECNT)
- +36 IF $LENGTH(ORDCHK,"|")>1
- FOR CNT2=2:1:$LENGTH(ORDCHK,"|")
- IF ORCONT=1
- WRITE !?14,$PIECE(ORDCHK,"|",CNT2)
- SET LINECNT=$$CHK4BRK(LINECNT)
- +37 SET OVRRSN=$$WRAP^TIULS(OVRRSN,60)
- IF ORCONT=1
- WRITE !?3,"Override Reason: ",$PIECE(OVRRSN,"|")
- SET LINECNT=$$CHK4BRK(LINECNT)
- +38 IF (ORCONT=1)&($LENGTH(OVRRSN,"|")=1)
- WRITE !
- SET LINECNT=$$CHK4BRK(LINECNT)
- +39 IF '$TEST
- IF $LENGTH(OVRRSN,"|")>1
- Begin DoDot:8
- +40 FOR CNT1=2:1:$LENGTH(OVRRSN,"|")
- Begin DoDot:9
- +41 WRITE !?20,$PIECE(OVRRSN,"|",CNT1)
- SET LINECNT=$$CHK4BRK(LINECNT)
- +42 IF CNT1=$LENGTH(OVRRSN,"|")
- WRITE !
- SET LINECNT=$$CHK4BRK(LINECNT)
- End DoDot:9
- if ORCONT=0
- QUIT
- End DoDot:8
- End DoDot:7
- +43 IF '$TEST
- IF ORCONT=1
- Begin DoDot:7
- +44 WRITE !?3,"Order Text: ",ORDTXT
- SET LINECNT=$$CHK4BRK(LINECNT)
- +45 WRITE !?3,"Order Chk: ",ORDCHK
- SET LINECNT=$$CHK4BRK(LINECNT)
- +46 WRITE !?3,"Override Reason: ",OVRRSN
- SET LINECNT=$$CHK4BRK(LINECNT)
- +47 WRITE !
- SET LINECNT=$$CHK4BRK(LINECNT)
- End DoDot:7
- End DoDot:6
- End DoDot:5
- if ORCONT=0
- QUIT
- End DoDot:4
- if ORCONT=0
- QUIT
- End DoDot:3
- if ORCONT=0
- QUIT
- End DoDot:2
- if ORCONT=0
- QUIT
- End DoDot:1
- if ORCONT=0
- QUIT
- +48 ; Delimited report printout of word-processing fields
- IF ANS("DELIMIT")="YES"&($DATA(^TMP("OROVRRPT",$JOB)))
- Begin DoDot:1
- +49 NEW ROUND
- FOR ROUND=1:1:3
- Begin DoDot:2
- +50 NEW DIR,DIRUT,Y,FLD
- SET FLD=$SELECT(ROUND=1:"ORDER TEXT",ROUND=2:"ORDER CHK",ROUND=3:"OVERRIDE REASON")
- SET DIR(0)="Y"
- SET DIR("A")="Continue to export the "_FLD_" field only"
- SET DIR("B")="YES"
- +51 SET DIR("?",1)="Entering 'YES' will print out a delimited report of the word-processing field."
- SET DIR("?",2)=""
- +52 SET DIR("?")="Entering 'NO' will complete the report and allow the user to exit the program."
- WRITE !
- DO ^DIR
- KILL DIR
- WRITE !
- +53 IF '$DATA(DIRUT)
- IF Y=1
- Begin DoDot:3
- +54 SET ANS("CONT")="YES"
- WRITE !,"RECNO"_TMP("DLMTR")_FLD
- +55 NEW RECNO
- SET RECNO=""
- FOR
- SET RECNO=$ORDER(^TMP(ANS("SORT"),FLD,RECNO))
- if RECNO=""
- QUIT
- WRITE !,RECNO_TMP("DLMTR"),$GET(^TMP(ANS("SORT"),FLD,RECNO))
- End DoDot:3
- +56 IF '$TEST
- SET ANS("CONT")="NO"
- QUIT
- End DoDot:2
- if ANS("CONT")="NO"
- QUIT
- End DoDot:1
- +57 IF '$DATA(^TMP("OROVRRPT",$JOB))
- WRITE !!!?(IOM-$LENGTH(NORECS))/2,NORECS,!!
- +58 KILL ^TMP("OROVRRPT",$JOB),^TMP(ANS("SORT"))
- +59 IF ($EXTRACT(IOST)="C")&(ORCONT=1)
- WRITE !
- NEW DIR,DIRUT
- SET DIR(0)="E"
- SET DIR("A")="Report Completed. Please Press ENTER to EXIT"
- DO ^DIR
- if $DATA(DIRUT)
- QUIT
- +60 QUIT
- +61 ;
- PGBRK() ; Executes page breaks for a terminal device.
- +1 ; If ORCONT=1, continue page break.
- +2 ; If ORCONT=0, Quit page break.
- +3 ;
- +4 NEW DIR,Y,ORCONT,DIRUT
- SET DIR(0)="E"
- DO ^DIR
- SET ORCONT=Y
- QUIT ORCONT
- +5 ;
- CHK4BRK(LINECNT) ; Check for page break and display appropriate column headers for terminal screen display.
- +1 ;
- +2 SET LINECNT=LINECNT+1
- +3 IF ($EXTRACT(IOST)="C")&(IOSL<98)&(LINECNT=22)
- WRITE !
- SET ORCONT=$$PGBRK
- SET LINECNT=2
- IF ORCONT=1
- WRITE @IOF
- DO COLHDR^ORSRCHOR
- +4 QUIT LINECNT
- +5 ;