source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/OROVRRPT.m@ 862

Last change on this file since 862 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 6.5 KB
Line 
1OROVRRPT ;SLC/TC - Order Check Override Reason Report Utility; 8/31/06 1:45pm
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**243**;Dec 17, 1997;Build 242
3 ;
4EN ;
5 N ANS,TMP
6 W @IOF
7 D ASKUSER^ORSRCHOR(.ANS,"FILTER SEARCH by") Q:$G(ANS("EXIT"))="YES"
8 D
9 . N POP,ORDESC,ORRTN,ORSAVE
10 . S ORDESC="OROVRRPT Override Reason Report",ORRTN="DISPLAY^OROVRRPT",ORSAVE("*")=""
11 . W ! D EN^XUTMDEVQ(ORRTN,ORDESC,.ORSAVE) K ^TMP("OROVRRPT",$J)
12 Q
13 ;
14DISPLAY ; Print data in an organized report format.
15 ;
16 D HEADER^ORSRCHOR
17 N ORSUB1,ORSUB2,ORSUB3,ORSUB4,ORDNO,NORECS,ORCONT,LINECNT,RECNO S (ORSUB1,ORSUB2,ORSUB3,ORSUB4,ORDNO,RECNO)=0,NORECS="NO RECORDS FOUND!",ORCONT=1
18 S LINECNT=$S(ANS("SORT")="OVRDNBY":12,ANS("SORT")="ORCHK":11,ANS("SORT")="DIV":11,ANS("SORT")="DSPGRP":11,ANS("SORT")="DTORD":12)
19 F S ORSUB1=$O(^TMP("OROVRRPT",$J,ORSUB1)) Q:ORSUB1="" D Q:ORCONT=0
20 . F S ORSUB2=$O(^TMP("OROVRRPT",$J,ORSUB1,ORSUB2)) Q:ORSUB2="" D Q:ORCONT=0
21 . . F S ORSUB3=$O(^TMP("OROVRRPT",$J,ORSUB1,ORSUB2,ORSUB3)) Q:ORSUB3="" D Q:ORCONT=0
22 . . . F S ORSUB4=$O(^TMP("OROVRRPT",$J,ORSUB1,ORSUB2,ORSUB3,ORSUB4)) Q:ORSUB4="" D Q:ORCONT=0
23 . . . . F S ORDNO=$O(^TMP("OROVRRPT",$J,ORSUB1,ORSUB2,ORSUB3,ORSUB4,ORDNO)) Q:ORDNO="" D Q:ORCONT=0
24 . . . . . 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)
25 . . . . . I '$L(OVRRIDBY) S OVRRIDBY="NONE SPECIFIED"
26 . . . . . S ORDCHK1=$S(ANS("SORT")="OVRDNBY":ORSUB4,ANS("SORT")="ORCHK":ORSUB1,ANS("SORT")="DIV":ORSUB3,ANS("SORT")="DSPGRP":ORSUB3,ANS("SORT")="DTORD":ORSUB4)
27 . . . . . S ORDCHK2=$P(DATA,U,5),ORDCHK=$S($L(ORDCHK2)>1:ORDCHK1_ORDCHK2,1:ORDCHK1)
28 . . . . . I ANS("DELIMIT")="YES" D ; Delimited report printout of non-word processing fields
29 . . . . . . S RECNO=RECNO+1
30 . . . . . . 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")
31 . . . . . . 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")
32 . . . . . . 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")
33 . . . . . . 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")
34 . . . . . . 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")
35 . . . . . . 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)
36 . . . . . E D ; Summary report printout
37 . . . . . . I ANS("SORT")="OVRDNBY"&(ORCONT=1) W !,$$FMTE^XLFDT(ORSUB1,"1M"),?21,ORSUB2,?40,ORSUB3,?70,ORDNO
38 . . . . . . I ANS("SORT")="ORCHK"&(ORCONT=1) W !,$$FMTE^XLFDT(ORSUB4,"1M"),?21,ORSUB2,?40,ORSUB3,?70,ORDNO
39 . . . . . . I ANS("SORT")="DIV"&(ORCONT=1) W !,$$FMTE^XLFDT(ORSUB4,"1M"),?25,ORSUB2,?60,ORDNO
40 . . . . . . I ANS("SORT")="DSPGRP"&(ORCONT=1) W !,$$FMTE^XLFDT(ORSUB4,"1M"),?25,ORSUB2,?60,ORDNO
41 . . . . . . I ANS("SORT")="DTORD"&(ORCONT=1) W !,$$FMTE^XLFDT(ORSUB1,"1M"),?45,ORDNO
42 . . . . . . S LINECNT=$$CHK4BRK(LINECNT)
43 . . . . . . I ANS("SORT")="OVRDNBY"&(ORCONT=1) W !?3,"D/T Overridden: ",$$FMTE^XLFDT($P(DATA,U,4),"1M")
44 . . . . . . E I ORCONT=1 W !?3,"Overridden by: ",OVRRIDBY,?46,"D/T Overridden: ",$$FMTE^XLFDT($P(DATA,U,4),"1M")
45 . . . . . . S LINECNT=$$CHK4BRK(LINECNT)
46 . . . . . . 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
47 . . . . . . . S ORDTXT=$$WRAP^TIULS(ORDTXT,65) I ORCONT=1 W !?3,"Order Text: ",$P(ORDTXT,"|") S LINECNT=$$CHK4BRK(LINECNT)
48 . . . . . . . I $L(ORDTXT,"|")>1 F CNT=2:1:$L(ORDTXT,"|") I ORCONT=1 W !?15,$P(ORDTXT,"|",CNT) S LINECNT=$$CHK4BRK(LINECNT)
49 . . . . . . . S ORDCHK=$$WRAP^TIULS(ORDCHK,66) I ORCONT=1 W !?3,"Order Chk: ",$P(ORDCHK,"|") S LINECNT=$$CHK4BRK(LINECNT)
50 . . . . . . . I $L(ORDCHK,"|")>1 F CNT2=2:1:$L(ORDCHK,"|") I ORCONT=1 W !?14,$P(ORDCHK,"|",CNT2) S LINECNT=$$CHK4BRK(LINECNT)
51 . . . . . . . S OVRRSN=$$WRAP^TIULS(OVRRSN,60) I ORCONT=1 W !?3,"Override Reason: ",$P(OVRRSN,"|") S LINECNT=$$CHK4BRK(LINECNT)
52 . . . . . . . I (ORCONT=1)&($L(OVRRSN,"|")=1) W ! S LINECNT=$$CHK4BRK(LINECNT)
53 . . . . . . . E I $L(OVRRSN,"|")>1 D
54 . . . . . . . . F CNT1=2:1:$L(OVRRSN,"|") D Q:ORCONT=0
55 . . . . . . . . . W !?20,$P(OVRRSN,"|",CNT1) S LINECNT=$$CHK4BRK(LINECNT)
56 . . . . . . . . . I CNT1=$L(OVRRSN,"|") W ! S LINECNT=$$CHK4BRK(LINECNT)
57 . . . . . . E I ORCONT=1 D
58 . . . . . . . W !?3,"Order Text: ",ORDTXT S LINECNT=$$CHK4BRK(LINECNT)
59 . . . . . . . W !?3,"Order Chk: ",ORDCHK S LINECNT=$$CHK4BRK(LINECNT)
60 . . . . . . . W !?3,"Override Reason: ",OVRRSN S LINECNT=$$CHK4BRK(LINECNT)
61 . . . . . . . W ! S LINECNT=$$CHK4BRK(LINECNT)
62 I ANS("DELIMIT")="YES"&($D(^TMP("OROVRRPT",$J))) D ; Delimited report printout of word-processing fields
63 . N ROUND F ROUND=1:1:3 D Q:ANS("CONT")="NO"
64 . . 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"
65 . . S DIR("?",1)="Entering 'YES' will print out a delimited report of the word-processing field.",DIR("?",2)=""
66 . . S DIR("?")="Entering 'NO' will complete the report and allow the user to exit the program." W ! D ^DIR K DIR W !
67 . . I '$D(DIRUT),Y=1 D
68 . . . S ANS("CONT")="YES" W !,"RECNO"_TMP("DLMTR")_FLD
69 . . . 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))
70 . . E S ANS("CONT")="NO" Q
71 I '$D(^TMP("OROVRRPT",$J)) W !!!?(IOM-$L(NORECS))/2,NORECS,!!
72 K ^TMP("OROVRRPT",$J),^TMP(ANS("SORT"))
73 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)
74 Q
75 ;
76PGBRK() ; Executes page breaks for a terminal device.
77 ; If ORCONT=1, continue page break.
78 ; If ORCONT=0, Quit page break.
79 ;
80 N DIR,Y,ORCONT,DIRUT S DIR(0)="E" D ^DIR S ORCONT=Y Q ORCONT
81 ;
82CHK4BRK(LINECNT) ; Check for page break and display appropriate column headers for terminal screen display.
83 ;
84 S LINECNT=LINECNT+1
85 I ($E(IOST)="C")&(IOSL<98)&(LINECNT=22) W ! S ORCONT=$$PGBRK,LINECNT=2 I ORCONT=1 W @IOF D COLHDR^ORSRCHOR
86 Q LINECNT
87 ;
Note: See TracBrowser for help on using the repository browser.