ORSRCHOR ;SLC/TC - Search Utility for Order Check Override Reason Report; 11/15/06 1:45pm
;;3.0;ORDER ENTRY/RESULTS REPORTING;**243**;Dec 17, 1997;Build 242
;
;
ASKUSER(ANS,DIR,ORQUIT) ; Controls prompting of the report utility.
;
I $G(ANS("EXIT"))="YES" Q
S ANS("EXIT")="NO"
N DIRUT,POP,X,Y
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"
D ^DIR I $D(DIRUT) S ANS("EXIT")="YES" Q
N ORRSPNSE S ORRSPNSE=Y K DIR
N %DT,CNT,Y,DUOUT,DTOUT
S %DT="AE" F CNT=1:1:2 D
. 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),"@"))
. D ^%DT I Y=-1 S CNT=2 Q
. E D
. . I CNT=1 S TMP("STRDT")=$P(Y,".")
. . I CNT=2 S TMP("ENDDT")=$P(Y,".")_".24"
I '$D(TMP("STRDT"))!'$D(TMP("ENDDT"))!$D(DTOUT)!$D(DUOUT) S ANS("EXIT")="YES" Q
I ORRSPNSE=1 D ; filter search by OVERRIDDEN BY field
. 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
. S ANS("SORT")="OVRDNBY",TMP("OVRBYIEN")=+Y,TMP("OVRBY")=Y(0,0)
I ORRSPNSE=2 D ; filter search by ORDER CHK
. 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
. S ANS("SORT")="ORCHK",TMP("ORCHKIEN")=+Y,TMP("ORCHK")=Y(0,0)
I ORRSPNSE=3 D ; filter search by DIUISION
. 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
. S ANS("SORT")="DIV",TMP("ORDIVIEN")=+Y,TMP("ORDIV")=Y(0,0)
I ORRSPNSE=4 D ; filter search by DISPLAY GROUP
. 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
. S ANS("SORT")="DSPGRP",TMP("ORDGPIEN")=+Y,TMP("ORDSPGRP")=Y(0,0)
I ORRSPNSE=5 D ; filter search by DIVISION & DISPLAY GROUP
. N DIC,CNT,Y,DTOUT,DUOUT S DIC(0)="QEAMZ",ANS("SORT")="DTORD"
. F CNT=1:1:2 D
. . S DIC=$S(CNT=1:"^DG(40.8,",CNT=2:"^ORD(100.98,")
. . D ^DIC I Y=-1 S CNT=2 Q
. . E D
. . . I CNT=1 S TMP("ORDIVIEN")=+Y,TMP("ORDIV")=Y(0,0)
. . . I CNT=2 S TMP("ORDGPIEN")=+Y,TMP("ORDSPGRP")=Y(0,0)
. I '$D(TMP("ORDIVIEN"))!'$D(TMP("ORDGPIEN"))!$D(DTOUT)!$D(DUOUT) S ANS("EXIT")="YES" Q
I ANS("EXIT")="NO" D
. N DIR,DIRUT,POP,X,Y S DIR(0)="Y",DIR("A")="Print delimited output only",DIR("B")="NO"
. S DIR("?",1)="Entering 'YES' will allow the user to specify a delimiter character",DIR("?",2)="and create a delimited report.",DIR("?",3)=""
. S DIR("?")="Entering 'NO' will create a regular summary report."
. D ^DIR I $D(DIRUT) S ANS("EXIT")="YES" Q
. S ANS("DELIMIT")=Y(0) I ANS("DELIMIT")="YES" D
. . N DIR,DIRUT,X,Y S DIR("A")="Specify REPORT DELIMITER CHARACTER",DIR("B")="U"
. . S DIR(0)="S^P:Pipe;T:Tilde;U:Up arrow"
. . D ^DIR I $D(DIRUT) S ANS("EXIT")="YES" Q
. . S ANS("DELIMITER")=Y K DIR
. W !,"Searching....." D SRCHBYDT(TMP("STRDT"),TMP("ENDDT"))
Q
;
SRCHBYDT(STRDT,ENDDT) ; Search by Date/Time Ordered and sort by Date/Time Ordered, Division, Display Group, or Order Chk.
;
N AFGLB,ORDNO
K ^TMP("OROVRRPT",$J) ; Ensures a fresh start
S AFGLB=$NA(^OR(100,"AF")),TMP=$NA(^TMP("OROVRRPT",$J))
S (ORDNO,ORDACT)=0
I (ANS("SORT")="OVRDNBY") S (TMP("ORCHKIEN"),TMP("ORDIVIEN"),TMP("ORDGPIEN"))=""
I (ANS("SORT")="ORCHK") S (TMP("OVRBYIEN"),TMP("ORDIVIEN"),TMP("ORDGPIEN"))=""
I (ANS("SORT")="DIV") S (TMP("ORCHKIEN"),TMP("OVRBYIEN"),TMP("ORDGPIEN"))=""
I (ANS("SORT")="DSPGRP") S (TMP("ORCHKIEN"),TMP("ORDIVIEN"),TMP("OVRBYIEN"))=""
I (ANS("SORT")="DTORD") S (TMP("ORCHKIEN"),TMP("OVRBYIEN"))=""
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
. 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
. N PTLOC,DIVIEN,DIVISN,ORDLG,DSPGRIEN,DSPGRP S PTLOC=$P(ORD0,U,10),ORDLG=$P(ORD0,U,5)
. 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
. E S DIVISN="NONE SPECIFIED"
. 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)
. E S DSPGRP="NONE SPECIFIED"
. N ORDCHK1,ORDCHK2 I $L(ORDCHK)>255 S ORDCHK1=$E(ORDCHK,1,255),ORDCHK2=$E(ORDCHK,256,$L(ORDCHK))
. I (ANS("SORT")="OVRDNBY")&($P(ORD9,U,5)=TMP("OVRBYIEN")) D
. . 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
. . E S @TMP@(STRDT,DIVISN,DSPGRP,ORDCHK,ORDNO)=ORD8_U_$P(ORD9,U,4)_U_TMP("OVRBY")_U_$P(ORD9,U,6)
. I (ANS("SORT")="ORCHK")&($P(ORD9,U)=TMP("ORCHKIEN")) D
. . N ORCHCK1,ORCHCK2 I $L(ORD91)>255 D
. . . 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
. . E S @TMP@(ORD91,DIVISN,DSPGRP,STRDT,ORDNO)=ORD8_U_$P(ORD9,U,4)_U_$P(ORD9,U,5)_U_$P(ORD9,U,6)
. I (ANS("SORT")="DIV")&($P($G(^SC(+$P($G(^OR(100,ORDNO,0)),U,10),0)),U,15)=TMP("ORDIVIEN")) D
. . 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
. . 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)
. I (ANS("SORT")="DSPGRP")&($P($G(^ORD(101.41,+$P($G(^OR(100,ORDNO,0)),U,5),0)),U,5)=TMP("ORDGPIEN")) D
. . 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
. . 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)
. 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
. . 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
. . 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)
Q
;
;
N SORT,SRTORD,TITLE,PERTTL,TTLIEN S TITLE="Order Check Override Reason Report",SORT="Sorted in Ascending order by: "
I ANS("SORT")="OVRDNBY" S SRTORD="Date/Time Ordered, Division, Display Group, Order Chk, & Order#"
I ANS("SORT")="ORCHK" S SRTORD="Order Chk, Division, Display Group, Date/Time Ordered, & Order#"
I ANS("SORT")="DTORD" S SRTORD="Date/Time Ordered, Order Chk, & Order#"
I ANS("SORT")="DIV" S SRTORD="Display Group, Order Chk, Date/Time Ordered, & Order#"
I ANS("SORT")="DSPGRP" S SRTORD="Division, Order Chk, Date/Time Ordered, & Order#"
I $D(IO("SPOOL"))!($D(IO("HFSIO"))) S IOM=80
W @IOF,?(IOM-$L(TITLE))/2,TITLE,!?(IOM-$L(SORT))/2,SORT,!?(IOM-$L(SRTORD))/2,SRTORD
W !!!,"Current User: ",$E($$GET1^DIQ(200,+$G(DUZ),.01),1,26),?42,"Current Date: ",$$HTE^XLFDT($H)
W !,"Date Range Searched: ",$$FMTE^XLFDT(TMP("STRDT"),"1D")," - ",$$FMTE^XLFDT(TMP("ENDDT"),"1D"),?54,"WHERE"
I ANS("SORT")="OVRDNBY" D
. S TTLIEN=$P($G(^VA(200,TMP("OVRBYIEN"),0)),U,9) I TTLIEN="" S PERTTL="NONE SPECIFIED"
. E S PERTTL=$P($G(^DIC(3.1,TTLIEN,0)),U) I PERTTL="" S PERTTL="NONE SPECIFIED"
. W !,"Order Chks are Overridden By: ",TMP("OVRBY"),!,"Title: ",PERTTL,!!
I ANS("SORT")="ORCHK" W !,"Order Check: ",TMP("ORCHK"),!!
I ANS("SORT")="DIV" W !,"Division: ",TMP("ORDIV"),!!
I ANS("SORT")="DSPGRP" W !,"Display Group: ",TMP("ORDSPGRP"),!!
I ANS("SORT")="DTORD" W !,"Division: ",TMP("ORDIV"),!,"Display Group: ",TMP("ORDSPGRP"),!!
I ANS("DELIMIT")="YES"&($D(^TMP("OROVRRPT",$J))) D
. S TMP("DLMTR")=$S(ANS("DELIMITER")="P":"|",ANS("DELIMITER")="T":"~",ANS("DELIMITER")="U":"^")
. 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"
. 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"
. 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"
. 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"
. I ANS("SORT")="DTORD" W "RECNO"_TMP("DLMTR")_"Date/Time Ordered"_TMP("DLMTR")_"Order#"_TMP("DLMTR")_"Overridden by"_TMP("DLMTR")_"D/T Overridden"
COLHDR I ANS("DELIMIT")="NO" D
. I ANS("SORT")="OVRDNBY"!(ANS("SORT")="ORCHK") W "Date/Time Ordered",?21,"Division",?40,"Display Group",?70,"Order#",!,"-----------------",?21,"--------",?40,"-------------",?70,"------"
. I ANS("SORT")="DIV" W "Date/Time Ordered",?25,"Display Group",?60,"Order#",!,"-----------------",?25,"-------------",?60,"------"
. I ANS("SORT")="DSPGRP" W "Date/Time Ordered",?25,"Division",?60,"Order#",!,"-----------------",?25,"--------",?60,"------"
. I ANS("SORT")="DTORD" W "Date/Time Ordered",?45,"Order#",!,"-----------------",?45,"------"
Q
;
ORSRCHOR ;SLC/TC - Search Utility for Order Check Override Reason Report; 11/15/06 1:45pm
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**243**;Dec 17, 1997;Build 242
+2 ;
+3 ;
ASKUSER(ANS,DIR,ORQUIT) ; Controls prompting of the report utility.
+1 ;
+2 IF $GET(ANS("EXIT"))="YES"
QUIT
+3 SET ANS("EXIT")="NO"
+4 NEW DIRUT,POP,X,Y
+5 SET 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"
SET DIR("A")=DIR
SET DIR("B")="1"
+6 DO ^DIR
IF $DATA(DIRUT)
SET ANS("EXIT")="YES"
QUIT
+7 NEW ORRSPNSE
SET ORRSPNSE=Y
KILL DIR
+8 NEW %DT,CNT,Y,DUOUT,DTOUT
+9 SET %DT="AE"
FOR CNT=1:1:2
Begin DoDot:1
+10 SET %DT("A")=$SELECT(CNT=1:"SEARCH Orders Beginning: ",CNT=2:$JUSTIFY("Thru: ",25))
SET %DT("B")=$SELECT(CNT=1:"",CNT=2:$PIECE($$HTE^XLFDT($HOROLOG),"@"))
+11 DO ^%DT
IF Y=-1
SET CNT=2
QUIT
+12 IF '$TEST
Begin DoDot:2
+13 IF CNT=1
SET TMP("STRDT")=$PIECE(Y,".")
+14 IF CNT=2
SET TMP("ENDDT")=$PIECE(Y,".")_".24"
End DoDot:2
End DoDot:1
+15 IF '$DATA(TMP("STRDT"))!'$DATA(TMP("ENDDT"))!$DATA(DTOUT)!$DATA(DUOUT)
SET ANS("EXIT")="YES"
QUIT
+16 ; filter search by OVERRIDDEN BY field
IF ORRSPNSE=1
Begin DoDot:1
+17 NEW DIC,Y,DTOUT,DUOUT
SET DIC="^VA(200,"
SET DIC(0)="QEAMZ"
SET DIC("A")="SEARCH Order Chks Overridden By: "
DO ^DIC
IF (Y=-1)!$DATA(DTOUT)!$DATA(DUOUT)
SET ANS("EXIT")="YES"
QUIT
+18 SET ANS("SORT")="OVRDNBY"
SET TMP("OVRBYIEN")=+Y
SET TMP("OVRBY")=Y(0,0)
End DoDot:1
+19 ; filter search by ORDER CHK
IF ORRSPNSE=2
Begin DoDot:1
+20 NEW DIC,Y,DTOUT,DUOUT
SET DIC="^ORD(100.8,"
SET DIC(0)="QEAMZ"
DO ^DIC
IF (Y=-1)!$DATA(DTOUT)!$DATA(DUOUT)
SET ANS("EXIT")="YES"
QUIT
+21 SET ANS("SORT")="ORCHK"
SET TMP("ORCHKIEN")=+Y
SET TMP("ORCHK")=Y(0,0)
End DoDot:1
+22 ; filter search by DIUISION
IF ORRSPNSE=3
Begin DoDot:1
+23 NEW DIC,Y,DTOUT,DUOUT
SET DIC="^DG(40.8,"
SET DIC(0)="QEAMZ"
DO ^DIC
IF (Y=-1)!$DATA(DTOUT)!$DATA(DUOUT)
SET ANS("EXIT")="YES"
QUIT
+24 SET ANS("SORT")="DIV"
SET TMP("ORDIVIEN")=+Y
SET TMP("ORDIV")=Y(0,0)
End DoDot:1
+25 ; filter search by DISPLAY GROUP
IF ORRSPNSE=4
Begin DoDot:1
+26 NEW DIC,Y,DTOUT,DUOUT
SET DIC="^ORD(100.98,"
SET DIC(0)="QEAMZ"
DO ^DIC
IF (Y=-1)!$DATA(DTOUT)!$DATA(DUOUT)
SET ANS("EXIT")="YES"
QUIT
+27 SET ANS("SORT")="DSPGRP"
SET TMP("ORDGPIEN")=+Y
SET TMP("ORDSPGRP")=Y(0,0)
End DoDot:1
+28 ; filter search by DIVISION & DISPLAY GROUP
IF ORRSPNSE=5
Begin DoDot:1
+29 NEW DIC,CNT,Y,DTOUT,DUOUT
SET DIC(0)="QEAMZ"
SET ANS("SORT")="DTORD"
+30 FOR CNT=1:1:2
Begin DoDot:2
+31 SET DIC=$SELECT(CNT=1:"^DG(40.8,",CNT=2:"^ORD(100.98,")
+32 DO ^DIC
IF Y=-1
SET CNT=2
QUIT
+33 IF '$TEST
Begin DoDot:3
+34 IF CNT=1
SET TMP("ORDIVIEN")=+Y
SET TMP("ORDIV")=Y(0,0)
+35 IF CNT=2
SET TMP("ORDGPIEN")=+Y
SET TMP("ORDSPGRP")=Y(0,0)
End DoDot:3
End DoDot:2
+36 IF '$DATA(TMP("ORDIVIEN"))!'$DATA(TMP("ORDGPIEN"))!$DATA(DTOUT)!$DATA(DUOUT)
SET ANS("EXIT")="YES"
QUIT
End DoDot:1
+37 IF ANS("EXIT")="NO"
Begin DoDot:1
+38 NEW DIR,DIRUT,POP,X,Y
SET DIR(0)="Y"
SET DIR("A")="Print delimited output only"
SET DIR("B")="NO"
+39 SET DIR("?",1)="Entering 'YES' will allow the user to specify a delimiter character"
SET DIR("?",2)="and create a delimited report."
SET DIR("?",3)=""
+40 SET DIR("?")="Entering 'NO' will create a regular summary report."
+41 DO ^DIR
IF $DATA(DIRUT)
SET ANS("EXIT")="YES"
QUIT
+42 SET ANS("DELIMIT")=Y(0)
IF ANS("DELIMIT")="YES"
Begin DoDot:2
+43 NEW DIR,DIRUT,X,Y
SET DIR("A")="Specify REPORT DELIMITER CHARACTER"
SET DIR("B")="U"
+44 SET DIR(0)="S^P:Pipe;T:Tilde;U:Up arrow"
+45 DO ^DIR
IF $DATA(DIRUT)
SET ANS("EXIT")="YES"
QUIT
+46 SET ANS("DELIMITER")=Y
KILL DIR
End DoDot:2
+47 WRITE !,"Searching....."
DO SRCHBYDT(TMP("STRDT"),TMP("ENDDT"))
End DoDot:1
+48 QUIT
+49 ;
SRCHBYDT(STRDT,ENDDT) ; Search by Date/Time Ordered and sort by Date/Time Ordered, Division, Display Group, or Order Chk.
+1 ;
+2 NEW AFGLB,ORDNO
+3 ; Ensures a fresh start
KILL ^TMP("OROVRRPT",$JOB)
+4 SET AFGLB=$NAME(^OR(100,"AF"))
SET TMP=$NAME(^TMP("OROVRRPT",$JOB))
+5 SET (ORDNO,ORDACT)=0
+6 IF (ANS("SORT")="OVRDNBY")
SET (TMP("ORCHKIEN"),TMP("ORDIVIEN"),TMP("ORDGPIEN"))=""
+7 IF (ANS("SORT")="ORCHK")
SET (TMP("OVRBYIEN"),TMP("ORDIVIEN"),TMP("ORDGPIEN"))=""
+8 IF (ANS("SORT")="DIV")
SET (TMP("ORCHKIEN"),TMP("OVRBYIEN"),TMP("ORDGPIEN"))=""
+9 IF (ANS("SORT")="DSPGRP")
SET (TMP("ORCHKIEN"),TMP("ORDIVIEN"),TMP("OVRBYIEN"))=""
+10 IF (ANS("SORT")="DTORD")
SET (TMP("ORCHKIEN"),TMP("OVRBYIEN"))=""
+11 FOR
SET STRDT=$ORDER(@AFGLB@(STRDT))
IF '+STRDT!(STRDT>ENDDT)
QUIT
FOR
SET ORDNO=$ORDER(@AFGLB@(STRDT,ORDNO))
IF '+ORDNO
QUIT
FOR
SET ORDACT=$ORDER(@AFGLB@(STRDT,ORDNO,ORDACT))
IF '+ORDACT
QUIT
IF (ORDACT=1)&($DATA(^OR(100,ORDNO,9)))&($LENGTH($PIECE($GET(^OR(100,ORDNO,9,1,0)),U,4))>0)
Begin DoDot:1
+12 NEW ORD0,ORD8,ORD9,ORD91,ORDCHK
SET ORD0=$GET(^OR(100,ORDNO,0))
SET ORD8=$GET(^OR(100,ORDNO,8,1,.1,1,0))
SET ORD9=$GET(^OR(100,ORDNO,9,1,0))
SET ORD91=$GET(^OR(100,ORDNO,9,1,1))
SET ORDCHK=$GET(^ORD(100.8,$PIECE(ORD9,U),0))_": "_ORD91
+13 NEW PTLOC,DIVIEN,DIVISN,ORDLG,DSPGRIEN,DSPGRP
SET PTLOC=$PIECE(ORD0,U,10)
SET ORDLG=$PIECE(ORD0,U,5)
+14 ;DBIA #10040
IF $DATA(PTLOC)&($PIECE(PTLOC,";",2)="SC(")&($DATA(^SC(+PTLOC,0)))
SET DIVIEN=$PIECE($GET(^SC(+PTLOC,0)),U,15)
SET DIVISN=$PIECE($GET(^DG(40.8,DIVIEN,0)),U)
+15 IF '$TEST
SET DIVISN="NONE SPECIFIED"
+16 IF $DATA(ORDLG)&($PIECE(ORDLG,";",2)="ORD(101.41,")&($DATA(^ORD(101.41,+ORDLG,0)))
SET DSPGRIEN=$PIECE($GET(^ORD(101.41,+ORDLG,0)),U,5)
SET DSPGRP=$PIECE($GET(^ORD(100.98,DSPGRIEN,0)),U)
+17 IF '$TEST
SET DSPGRP="NONE SPECIFIED"
+18 NEW ORDCHK1,ORDCHK2
IF $LENGTH(ORDCHK)>255
SET ORDCHK1=$EXTRACT(ORDCHK,1,255)
SET ORDCHK2=$EXTRACT(ORDCHK,256,$LENGTH(ORDCHK))
+19 IF (ANS("SORT")="OVRDNBY")&($PIECE(ORD9,U,5)=TMP("OVRBYIEN"))
Begin DoDot:2
+20 IF $LENGTH(ORDCHK)>255
SET @TMP@(STRDT,DIVISN,DSPGRP,ORDCHK1,ORDNO)=ORD8_U_$PIECE(ORD9,U,4)_U_TMP("OVRBY")_U_$PIECE(ORD9,U,6)_U_ORDCHK2
+21 IF '$TEST
SET @TMP@(STRDT,DIVISN,DSPGRP,ORDCHK,ORDNO)=ORD8_U_$PIECE(ORD9,U,4)_U_TMP("OVRBY")_U_$PIECE(ORD9,U,6)
End DoDot:2
+22 IF (ANS("SORT")="ORCHK")&($PIECE(ORD9,U)=TMP("ORCHKIEN"))
Begin DoDot:2
+23 NEW ORCHCK1,ORCHCK2
IF $LENGTH(ORD91)>255
Begin DoDot:3
+24 SET ORCHCK1=$EXTRACT(ORD91,1,255)
SET ORCHCK2=$EXTRACT(ORD91,256,$LENGTH(ORD91))
SET @TMP@(ORCHCK1,DIVISN,DSPGRP,STRDT,ORDNO)=ORD8_U_$PIECE(ORD9,U,4)_U_$PIECE(ORD9,U,5)_U_$PIECE(ORD9,U,6)_U_ORCHCK2
End DoDot:3
+25 IF '$TEST
SET @TMP@(ORD91,DIVISN,DSPGRP,STRDT,ORDNO)=ORD8_U_$PIECE(ORD9,U,4)_U_$PIECE(ORD9,U,5)_U_$PIECE(ORD9,U,6)
End DoDot:2
+26 IF (ANS("SORT")="DIV")&($PIECE($GET(^SC(+$PIECE($GET(^OR(100,ORDNO,0)),U,10),0)),U,15)=TMP("ORDIVIEN"))
Begin DoDot:2
+27 IF $LENGTH(ORDCHK)>255
SET @TMP@(TMP("ORDIV"),DSPGRP,ORDCHK1,STRDT,ORDNO)=ORD8_U_$PIECE(ORD9,U,4)_U_$PIECE(ORD9,U,5)_U_$PIECE(ORD9,U,6)_U_ORDCHK2
+28 IF '$TEST
SET @TMP@(TMP("ORDIV"),DSPGRP,ORDCHK,STRDT,ORDNO)=ORD8_U_$PIECE(ORD9,U,4)_U_$PIECE(ORD9,U,5)_U_$PIECE(ORD9,U,6)
End DoDot:2
+29 IF (ANS("SORT")="DSPGRP")&($PIECE($GET(^ORD(101.41,+$PIECE($GET(^OR(100,ORDNO,0)),U,5),0)),U,5)=TMP("ORDGPIEN"))
Begin DoDot:2
+30 IF $LENGTH(ORDCHK)>255
SET @TMP@(TMP("ORDSPGRP"),DIVISN,ORDCHK1,STRDT,ORDNO)=ORD8_U_$PIECE(ORD9,U,4)_U_$PIECE(ORD9,U,5)_U_$PIECE(ORD9,U,6)_U_ORDCHK2
+31 IF '$TEST
SET @TMP@(TMP("ORDSPGRP"),DIVISN,ORDCHK,STRDT,ORDNO)=ORD8_U_$PIECE(ORD9,U,4)_U_$PIECE(ORD9,U,5)_U_$PIECE(ORD9,U,6)
End DoDot:2
+32 IF (ANS("SORT")="DTORD")&($PIECE($GET(^SC(+$PIECE($GET(^OR(100,ORDNO,0)),U,10),0)),U,15)=TMP("ORDIVIEN"))&($PIECE($GET(^ORD(101.41,+$PIECE($GET(^OR(100,ORDNO,0)),U,5),0)),U,5)=TMP("ORDGPIEN"))
Begin DoDot:2
+33 IF $LENGTH(ORDCHK)>255
SET @TMP@(STRDT,TMP("ORDIV"),TMP("ORDSPGRP"),ORDCHK1,ORDNO)=ORD8_U_$PIECE(ORD9,U,4)_U_$PIECE(ORD9,U,5)_U_$PIECE(ORD9,U,6)_U_ORDCHK2
+34 IF '$TEST
SET @TMP@(STRDT,TMP("ORDIV"),TMP("ORDSPGRP"),ORDCHK,ORDNO)=ORD8_U_$PIECE(ORD9,U,4)_U_$PIECE(ORD9,U,5)_U_$PIECE(ORD9,U,6)
End DoDot:2
End DoDot:1
+35 QUIT
+36 ;
+1 ;
+2 NEW SORT,SRTORD,TITLE,PERTTL,TTLIEN
SET TITLE="Order Check Override Reason Report"
SET SORT="Sorted in Ascending order by: "
+3 IF ANS("SORT")="OVRDNBY"
SET SRTORD="Date/Time Ordered, Division, Display Group, Order Chk, & Order#"
+4 IF ANS("SORT")="ORCHK"
SET SRTORD="Order Chk, Division, Display Group, Date/Time Ordered, & Order#"
+5 IF ANS("SORT")="DTORD"
SET SRTORD="Date/Time Ordered, Order Chk, & Order#"
+6 IF ANS("SORT")="DIV"
SET SRTORD="Display Group, Order Chk, Date/Time Ordered, & Order#"
+7 IF ANS("SORT")="DSPGRP"
SET SRTORD="Division, Order Chk, Date/Time Ordered, & Order#"
+8 IF $DATA(IO("SPOOL"))!($DATA(IO("HFSIO")))
SET IOM=80
+9 WRITE @IOF,?(IOM-$LENGTH(TITLE))/2,TITLE,!?(IOM-$LENGTH(SORT))/2,SORT,!?(IOM-$LENGTH(SRTORD))/2,SRTORD
+10 WRITE !!!,"Current User: ",$EXTRACT($$GET1^DIQ(200,+$GET(DUZ),.01),1,26),?42,"Current Date: ",$$HTE^XLFDT($HOROLOG)
+11 WRITE !,"Date Range Searched: ",$$FMTE^XLFDT(TMP("STRDT"),"1D")," - ",$$FMTE^XLFDT(TMP("ENDDT"),"1D"),?54,"WHERE"
+12 IF ANS("SORT")="OVRDNBY"
Begin DoDot:1
+13 SET TTLIEN=$PIECE($GET(^VA(200,TMP("OVRBYIEN"),0)),U,9)
IF TTLIEN=""
SET PERTTL="NONE SPECIFIED"
+14 IF '$TEST
SET PERTTL=$PIECE($GET(^DIC(3.1,TTLIEN,0)),U)
IF PERTTL=""
SET PERTTL="NONE SPECIFIED"
+15 WRITE !,"Order Chks are Overridden By: ",TMP("OVRBY"),!,"Title: ",PERTTL,!!
End DoDot:1
+16 IF ANS("SORT")="ORCHK"
WRITE !,"Order Check: ",TMP("ORCHK"),!!
+17 IF ANS("SORT")="DIV"
WRITE !,"Division: ",TMP("ORDIV"),!!
+18 IF ANS("SORT")="DSPGRP"
WRITE !,"Display Group: ",TMP("ORDSPGRP"),!!
+19 IF ANS("SORT")="DTORD"
WRITE !,"Division: ",TMP("ORDIV"),!,"Display Group: ",TMP("ORDSPGRP"),!!
+20 IF ANS("DELIMIT")="YES"&($DATA(^TMP("OROVRRPT",$JOB)))
Begin DoDot:1
+21 SET TMP("DLMTR")=$SELECT(ANS("DELIMITER")="P":"|",ANS("DELIMITER")="T":"~",ANS("DELIMITER")="U":"^")
+22 IF ANS("SORT")="OVRDNBY"
WRITE "RECNO"_TMP("DLMTR")_"Date/Time Ordered"_TMP("DLMTR")_"Division"_TMP("DLMTR")_"Display Group"_TMP("DLMTR")_"Order#"_TMP("DLMTR")_"D/T Overridden"
+23 IF ANS("SORT")="ORCHK"
WRITE "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"
+24 IF ANS("SORT")="DIV"
WRITE "RECNO"_TMP("DLMTR")_"Date/Time Ordered"_TMP("DLMTR")_"Display Group"_TMP("DLMTR")_"Order#"_TMP("DLMTR")_"Overridden by"_TMP("DLMTR")_"D/T Overridden"
+25 IF ANS("SORT")="DSPGRP"
WRITE "RECNO"_TMP("DLMTR")_"Date/Time Ordered"_TMP("DLMTR")_"Division"_TMP("DLMTR")_"Order#"_TMP("DLMTR")_"Overridden by"_TMP("DLMTR")_"D/T Overridden"
+26 IF ANS("SORT")="DTORD"
WRITE "RECNO"_TMP("DLMTR")_"Date/Time Ordered"_TMP("DLMTR")_"Order#"_TMP("DLMTR")_"Overridden by"_TMP("DLMTR")_"D/T Overridden"
End DoDot:1
COLHDR IF ANS("DELIMIT")="NO"
Begin DoDot:1
+1 IF ANS("SORT")="OVRDNBY"!(ANS("SORT")="ORCHK")
WRITE "Date/Time Ordered",?21,"Division",?40,"Display Group",?70,"Order#",!,"-----------------",?21,"--------",?40,"-------------",?70,"------"
+2 IF ANS("SORT")="DIV"
WRITE "Date/Time Ordered",?25,"Display Group",?60,"Order#",!,"-----------------",?25,"-------------",?60,"------"
+3 IF ANS("SORT")="DSPGRP"
WRITE "Date/Time Ordered",?25,"Division",?60,"Order#",!,"-----------------",?25,"--------",?60,"------"
+4 IF ANS("SORT")="DTORD"
WRITE "Date/Time Ordered",?45,"Order#",!,"-----------------",?45,"------"
End DoDot:1
+5 QUIT
+6 ;
