source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORSRCHOR.m@ 1211

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

initial load of WorldVistAEHR
File size: 9.4 KB
Line 
1ORSRCHOR ;SLC/TC - Search Utility for Order Check Override Reason Report; 11/15/06 1:45pm
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**243**;Dec 17, 1997;Build 242
3 ;
4 ;
5ASKUSER(ANS,DIR,ORQUIT) ; Controls prompting of the report utility.
6 ;
7 I $G(ANS("EXIT"))="YES" Q
8 S ANS("EXIT")="NO"
9 N DIRUT,POP,X,Y
10 S DIR(0)="S^1:DATE/TIME ORDERED & OVERRIDDEN BY;2:DATE/TIME ORDERED & ORDER CHECK;3:DATE/TIME ORDERED & DIVISION;4:DATE/TIME ORDERED & DISPLAY GROUP;5:DATE/TIME ORDERED, DIVISION, & DISPLAY GROUP",DIR("A")=DIR,DIR("B")="1"
11 D ^DIR I $D(DIRUT) S ANS("EXIT")="YES" Q
12 N ORRSPNSE S ORRSPNSE=Y K DIR
13 N %DT,CNT,Y,DUOUT,DTOUT
14 S %DT="AE" F CNT=1:1:2 D
15 . S %DT("A")=$S(CNT=1:"SEARCH Orders Beginning: ",CNT=2:$J("Thru: ",25)),%DT("B")=$S(CNT=1:"",CNT=2:$P($$HTE^XLFDT($H),"@"))
16 . D ^%DT I Y=-1 S CNT=2 Q
17 . E D
18 . . I CNT=1 S TMP("STRDT")=$P(Y,".")
19 . . I CNT=2 S TMP("ENDDT")=$P(Y,".")_".24"
20 I '$D(TMP("STRDT"))!'$D(TMP("ENDDT"))!$D(DTOUT)!$D(DUOUT) S ANS("EXIT")="YES" Q
21 I ORRSPNSE=1 D ; filter search by OVERRIDDEN BY field
22 . N DIC,Y,DTOUT,DUOUT S DIC="^VA(200,",DIC(0)="QEAMZ",DIC("A")="SEARCH Order Chks Overridden By: " D ^DIC I (Y=-1)!$D(DTOUT)!$D(DUOUT) S ANS("EXIT")="YES" Q
23 . S ANS("SORT")="OVRDNBY",TMP("OVRBYIEN")=+Y,TMP("OVRBY")=Y(0,0)
24 I ORRSPNSE=2 D ; filter search by ORDER CHK
25 . N DIC,Y,DTOUT,DUOUT S DIC="^ORD(100.8,",DIC(0)="QEAMZ" D ^DIC I (Y=-1)!$D(DTOUT)!$D(DUOUT) S ANS("EXIT")="YES" Q
26 . S ANS("SORT")="ORCHK",TMP("ORCHKIEN")=+Y,TMP("ORCHK")=Y(0,0)
27 I ORRSPNSE=3 D ; filter search by DIUISION
28 . N DIC,Y,DTOUT,DUOUT S DIC="^DG(40.8,",DIC(0)="QEAMZ" D ^DIC I (Y=-1)!$D(DTOUT)!$D(DUOUT) S ANS("EXIT")="YES" Q
29 . S ANS("SORT")="DIV",TMP("ORDIVIEN")=+Y,TMP("ORDIV")=Y(0,0)
30 I ORRSPNSE=4 D ; filter search by DISPLAY GROUP
31 . N DIC,Y,DTOUT,DUOUT S DIC="^ORD(100.98,",DIC(0)="QEAMZ" D ^DIC I (Y=-1)!$D(DTOUT)!$D(DUOUT) S ANS("EXIT")="YES" Q
32 . S ANS("SORT")="DSPGRP",TMP("ORDGPIEN")=+Y,TMP("ORDSPGRP")=Y(0,0)
33 I ORRSPNSE=5 D ; filter search by DIVISION & DISPLAY GROUP
34 . N DIC,CNT,Y,DTOUT,DUOUT S DIC(0)="QEAMZ",ANS("SORT")="DTORD"
35 . F CNT=1:1:2 D
36 . . S DIC=$S(CNT=1:"^DG(40.8,",CNT=2:"^ORD(100.98,")
37 . . D ^DIC I Y=-1 S CNT=2 Q
38 . . E D
39 . . . I CNT=1 S TMP("ORDIVIEN")=+Y,TMP("ORDIV")=Y(0,0)
40 . . . I CNT=2 S TMP("ORDGPIEN")=+Y,TMP("ORDSPGRP")=Y(0,0)
41 . I '$D(TMP("ORDIVIEN"))!'$D(TMP("ORDGPIEN"))!$D(DTOUT)!$D(DUOUT) S ANS("EXIT")="YES" Q
42 I ANS("EXIT")="NO" D
43 . N DIR,DIRUT,POP,X,Y S DIR(0)="Y",DIR("A")="Print delimited output only",DIR("B")="NO"
44 . S DIR("?",1)="Entering 'YES' will allow the user to specify a delimiter character",DIR("?",2)="and create a delimited report.",DIR("?",3)=""
45 . S DIR("?")="Entering 'NO' will create a regular summary report."
46 . D ^DIR I $D(DIRUT) S ANS("EXIT")="YES" Q
47 . S ANS("DELIMIT")=Y(0) I ANS("DELIMIT")="YES" D
48 . . N DIR,DIRUT,X,Y S DIR("A")="Specify REPORT DELIMITER CHARACTER",DIR("B")="U"
49 . . S DIR(0)="S^P:Pipe;T:Tilde;U:Up arrow"
50 . . D ^DIR I $D(DIRUT) S ANS("EXIT")="YES" Q
51 . . S ANS("DELIMITER")=Y K DIR
52 . W !,"Searching....." D SRCHBYDT(TMP("STRDT"),TMP("ENDDT"))
53 Q
54 ;
55SRCHBYDT(STRDT,ENDDT) ; Search by Date/Time Ordered and sort by Date/Time Ordered, Division, Display Group, or Order Chk.
56 ;
57 N AFGLB,ORDNO
58 K ^TMP("OROVRRPT",$J) ; Ensures a fresh start
59 S AFGLB=$NA(^OR(100,"AF")),TMP=$NA(^TMP("OROVRRPT",$J))
60 S (ORDNO,ORDACT)=0
61 I (ANS("SORT")="OVRDNBY") S (TMP("ORCHKIEN"),TMP("ORDIVIEN"),TMP("ORDGPIEN"))=""
62 I (ANS("SORT")="ORCHK") S (TMP("OVRBYIEN"),TMP("ORDIVIEN"),TMP("ORDGPIEN"))=""
63 I (ANS("SORT")="DIV") S (TMP("ORCHKIEN"),TMP("OVRBYIEN"),TMP("ORDGPIEN"))=""
64 I (ANS("SORT")="DSPGRP") S (TMP("ORCHKIEN"),TMP("ORDIVIEN"),TMP("OVRBYIEN"))=""
65 I (ANS("SORT")="DTORD") S (TMP("ORCHKIEN"),TMP("OVRBYIEN"))=""
66 F S STRDT=$O(@AFGLB@(STRDT)) Q:'+STRDT!(STRDT>ENDDT) F S ORDNO=$O(@AFGLB@(STRDT,ORDNO)) Q:'+ORDNO F S ORDACT=$O(@AFGLB@(STRDT,ORDNO,ORDACT)) Q:'+ORDACT I (ORDACT=1)&($D(^OR(100,ORDNO,9)))&($L($P($G(^OR(100,ORDNO,9,1,0)),U,4))>0) D
67 . N ORD0,ORD8,ORD9,ORD91,ORDCHK S ORD0=$G(^OR(100,ORDNO,0)),ORD8=$G(^OR(100,ORDNO,8,1,.1,1,0)),ORD9=$G(^OR(100,ORDNO,9,1,0)),ORD91=$G(^OR(100,ORDNO,9,1,1)),ORDCHK=$G(^ORD(100.8,$P(ORD9,U),0))_": "_ORD91
68 . N PTLOC,DIVIEN,DIVISN,ORDLG,DSPGRIEN,DSPGRP S PTLOC=$P(ORD0,U,10),ORDLG=$P(ORD0,U,5)
69 . I $D(PTLOC)&($P(PTLOC,";",2)="SC(")&($D(^SC(+PTLOC,0))) S DIVIEN=$P($G(^SC(+PTLOC,0)),U,15),DIVISN=$P($G(^DG(40.8,DIVIEN,0)),U) ;DBIA #10040
70 . E S DIVISN="NONE SPECIFIED"
71 . I $D(ORDLG)&($P(ORDLG,";",2)="ORD(101.41,")&($D(^ORD(101.41,+ORDLG,0))) S DSPGRIEN=$P($G(^ORD(101.41,+ORDLG,0)),U,5),DSPGRP=$P($G(^ORD(100.98,DSPGRIEN,0)),U)
72 . E S DSPGRP="NONE SPECIFIED"
73 . N ORDCHK1,ORDCHK2 I $L(ORDCHK)>255 S ORDCHK1=$E(ORDCHK,1,255),ORDCHK2=$E(ORDCHK,256,$L(ORDCHK))
74 . I (ANS("SORT")="OVRDNBY")&($P(ORD9,U,5)=TMP("OVRBYIEN")) D
75 . . I $L(ORDCHK)>255 S @TMP@(STRDT,DIVISN,DSPGRP,ORDCHK1,ORDNO)=ORD8_U_$P(ORD9,U,4)_U_TMP("OVRBY")_U_$P(ORD9,U,6)_U_ORDCHK2
76 . . E S @TMP@(STRDT,DIVISN,DSPGRP,ORDCHK,ORDNO)=ORD8_U_$P(ORD9,U,4)_U_TMP("OVRBY")_U_$P(ORD9,U,6)
77 . I (ANS("SORT")="ORCHK")&($P(ORD9,U)=TMP("ORCHKIEN")) D
78 . . N ORCHCK1,ORCHCK2 I $L(ORD91)>255 D
79 . . . S ORCHCK1=$E(ORD91,1,255),ORCHCK2=$E(ORD91,256,$L(ORD91)),@TMP@(ORCHCK1,DIVISN,DSPGRP,STRDT,ORDNO)=ORD8_U_$P(ORD9,U,4)_U_$P(ORD9,U,5)_U_$P(ORD9,U,6)_U_ORCHCK2
80 . . E S @TMP@(ORD91,DIVISN,DSPGRP,STRDT,ORDNO)=ORD8_U_$P(ORD9,U,4)_U_$P(ORD9,U,5)_U_$P(ORD9,U,6)
81 . I (ANS("SORT")="DIV")&($P($G(^SC(+$P($G(^OR(100,ORDNO,0)),U,10),0)),U,15)=TMP("ORDIVIEN")) D
82 . . I $L(ORDCHK)>255 S @TMP@(TMP("ORDIV"),DSPGRP,ORDCHK1,STRDT,ORDNO)=ORD8_U_$P(ORD9,U,4)_U_$P(ORD9,U,5)_U_$P(ORD9,U,6)_U_ORDCHK2
83 . . E S @TMP@(TMP("ORDIV"),DSPGRP,ORDCHK,STRDT,ORDNO)=ORD8_U_$P(ORD9,U,4)_U_$P(ORD9,U,5)_U_$P(ORD9,U,6)
84 . I (ANS("SORT")="DSPGRP")&($P($G(^ORD(101.41,+$P($G(^OR(100,ORDNO,0)),U,5),0)),U,5)=TMP("ORDGPIEN")) D
85 . . I $L(ORDCHK)>255 S @TMP@(TMP("ORDSPGRP"),DIVISN,ORDCHK1,STRDT,ORDNO)=ORD8_U_$P(ORD9,U,4)_U_$P(ORD9,U,5)_U_$P(ORD9,U,6)_U_ORDCHK2
86 . . E S @TMP@(TMP("ORDSPGRP"),DIVISN,ORDCHK,STRDT,ORDNO)=ORD8_U_$P(ORD9,U,4)_U_$P(ORD9,U,5)_U_$P(ORD9,U,6)
87 . I (ANS("SORT")="DTORD")&($P($G(^SC(+$P($G(^OR(100,ORDNO,0)),U,10),0)),U,15)=TMP("ORDIVIEN"))&($P($G(^ORD(101.41,+$P($G(^OR(100,ORDNO,0)),U,5),0)),U,5)=TMP("ORDGPIEN")) D
88 . . I $L(ORDCHK)>255 S @TMP@(STRDT,TMP("ORDIV"),TMP("ORDSPGRP"),ORDCHK1,ORDNO)=ORD8_U_$P(ORD9,U,4)_U_$P(ORD9,U,5)_U_$P(ORD9,U,6)_U_ORDCHK2
89 . . E S @TMP@(STRDT,TMP("ORDIV"),TMP("ORDSPGRP"),ORDCHK,ORDNO)=ORD8_U_$P(ORD9,U,4)_U_$P(ORD9,U,5)_U_$P(ORD9,U,6)
90 Q
91 ;
92HEADER ; Prints out the report header
93 ;
94 N SORT,SRTORD,TITLE,PERTTL,TTLIEN S TITLE="Order Check Override Reason Report",SORT="Sorted in Ascending order by: "
95 I ANS("SORT")="OVRDNBY" S SRTORD="Date/Time Ordered, Division, Display Group, Order Chk, & Order#"
96 I ANS("SORT")="ORCHK" S SRTORD="Order Chk, Division, Display Group, Date/Time Ordered, & Order#"
97 I ANS("SORT")="DTORD" S SRTORD="Date/Time Ordered, Order Chk, & Order#"
98 I ANS("SORT")="DIV" S SRTORD="Display Group, Order Chk, Date/Time Ordered, & Order#"
99 I ANS("SORT")="DSPGRP" S SRTORD="Division, Order Chk, Date/Time Ordered, & Order#"
100 I $D(IO("SPOOL"))!($D(IO("HFSIO"))) S IOM=80
101 W @IOF,?(IOM-$L(TITLE))/2,TITLE,!?(IOM-$L(SORT))/2,SORT,!?(IOM-$L(SRTORD))/2,SRTORD
102 W !!!,"Current User: ",$E($$GET1^DIQ(200,+$G(DUZ),.01),1,26),?42,"Current Date: ",$$HTE^XLFDT($H)
103 W !,"Date Range Searched: ",$$FMTE^XLFDT(TMP("STRDT"),"1D")," - ",$$FMTE^XLFDT(TMP("ENDDT"),"1D"),?54,"WHERE"
104 I ANS("SORT")="OVRDNBY" D
105 . S TTLIEN=$P($G(^VA(200,TMP("OVRBYIEN"),0)),U,9) I TTLIEN="" S PERTTL="NONE SPECIFIED"
106 . E S PERTTL=$P($G(^DIC(3.1,TTLIEN,0)),U) I PERTTL="" S PERTTL="NONE SPECIFIED"
107 . W !,"Order Chks are Overridden By: ",TMP("OVRBY"),!,"Title: ",PERTTL,!!
108 I ANS("SORT")="ORCHK" W !,"Order Check: ",TMP("ORCHK"),!!
109 I ANS("SORT")="DIV" W !,"Division: ",TMP("ORDIV"),!!
110 I ANS("SORT")="DSPGRP" W !,"Display Group: ",TMP("ORDSPGRP"),!!
111 I ANS("SORT")="DTORD" W !,"Division: ",TMP("ORDIV"),!,"Display Group: ",TMP("ORDSPGRP"),!!
112 I ANS("DELIMIT")="YES"&($D(^TMP("OROVRRPT",$J))) D
113 . S TMP("DLMTR")=$S(ANS("DELIMITER")="P":"|",ANS("DELIMITER")="T":"~",ANS("DELIMITER")="U":"^")
114 . I ANS("SORT")="OVRDNBY" W "RECNO"_TMP("DLMTR")_"Date/Time Ordered"_TMP("DLMTR")_"Division"_TMP("DLMTR")_"Display Group"_TMP("DLMTR")_"Order#"_TMP("DLMTR")_"D/T Overridden"
115 . I ANS("SORT")="ORCHK" W "RECNO"_TMP("DLMTR")_"Date/Time Ordered"_TMP("DLMTR")_"Division"_TMP("DLMTR")_"Display Group"_TMP("DLMTR")_"Order#"_TMP("DLMTR")_"Overridden by"_TMP("DLMTR")_"D/T Overridden"
116 . I ANS("SORT")="DIV" W "RECNO"_TMP("DLMTR")_"Date/Time Ordered"_TMP("DLMTR")_"Display Group"_TMP("DLMTR")_"Order#"_TMP("DLMTR")_"Overridden by"_TMP("DLMTR")_"D/T Overridden"
117 . I ANS("SORT")="DSPGRP" W "RECNO"_TMP("DLMTR")_"Date/Time Ordered"_TMP("DLMTR")_"Division"_TMP("DLMTR")_"Order#"_TMP("DLMTR")_"Overridden by"_TMP("DLMTR")_"D/T Overridden"
118 . I ANS("SORT")="DTORD" W "RECNO"_TMP("DLMTR")_"Date/Time Ordered"_TMP("DLMTR")_"Order#"_TMP("DLMTR")_"Overridden by"_TMP("DLMTR")_"D/T Overridden"
119COLHDR I ANS("DELIMIT")="NO" D
120 . I ANS("SORT")="OVRDNBY"!(ANS("SORT")="ORCHK") W "Date/Time Ordered",?21,"Division",?40,"Display Group",?70,"Order#",!,"-----------------",?21,"--------",?40,"-------------",?70,"------"
121 . I ANS("SORT")="DIV" W "Date/Time Ordered",?25,"Display Group",?60,"Order#",!,"-----------------",?25,"-------------",?60,"------"
122 . I ANS("SORT")="DSPGRP" W "Date/Time Ordered",?25,"Division",?60,"Order#",!,"-----------------",?25,"--------",?60,"------"
123 . I ANS("SORT")="DTORD" W "Date/Time Ordered",?45,"Order#",!,"-----------------",?45,"------"
124 Q
125 ;
Note: See TracBrowser for help on using the repository browser.