- ORSRCHOR ;SLC/TC - Search Utility for Order Check Override Reason Report; 09/28/2009 15:00 ;09/16/10 20:05
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**243,293**;Dec 17, 1997;Build 20
- ;
- ;
- 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,ORDACT
- 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 D
- . K ^TMP($J,"OROCDATA") D OCAPI^ORCHECK(ORDNO,"OROCDATA")
- . I (ORDACT=1)&($$OCCNT^OROCAPI1(ORDNO))&($L($G(^TMP($J,"OROCDATA",1,"OR REASON")))>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))
- . . S ORD9=$G(^TMP($J,"OROCDATA",1,"OC NUMBER"))_U_$G(^TMP($J,"OROCDATA",1,"OC LEVEL"))_U_U_$G(^TMP($J,"OROCDATA",1,"OR REASON"))_U_$G(^TMP($J,"OROCDATA",1,"OR PROVIDER"))_U_$G(^TMP($J,"OROCDATA",1,"OR DT"))
- . . S ORD91=$G(^TMP($J,"OROCDATA",1,"OC TEXT",1,0))
- . . S 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)
- K ^TMP($J,"OROCDATA")
- 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
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORSRCHOR 10090 printed Jan 18, 2025@03:35:26 Page 2
- ORSRCHOR ;SLC/TC - Search Utility for Order Check Override Reason Report; 09/28/2009 15:00 ;09/16/10 20:05
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**243,293**;Dec 17, 1997;Build 20
- +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,ORDACT
- +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
- Begin DoDot:1
- +12 KILL ^TMP($JOB,"OROCDATA")
- DO OCAPI^ORCHECK(ORDNO,"OROCDATA")
- +13 IF (ORDACT=1)&($$OCCNT^OROCAPI1(ORDNO))&($LENGTH($GET(^TMP($JOB,"OROCDATA",1,"OR REASON")))>0)
- Begin DoDot:2
- +14 NEW ORD0,ORD8,ORD9,ORD91,ORDCHK
- SET ORD0=$GET(^OR(100,ORDNO,0))
- SET ORD8=$GET(^OR(100,ORDNO,8,1,.1,1,0))
- +15 SET ORD9=$GET(^TMP($JOB,"OROCDATA",1,"OC NUMBER"))_U_$GET(^TMP($JOB,"OROCDATA",1,"OC LEVEL"))_U_U_$GET(^TMP($JOB,"OROCDATA",1,"OR REASON"))_U_$GET(^TMP($JOB,"OROCDATA",1,"OR PROVIDER"))_U_$GET(^TMP($JOB,"OROCDATA",1,"OR
- DT"))
- +16 SET ORD91=$GET(^TMP($JOB,"OROCDATA",1,"OC TEXT",1,0))
- +17 SET ORDCHK=$GET(^ORD(100.8,$PIECE(ORD9,U),0))_": "_ORD91
- +18 NEW PTLOC,DIVIEN,DIVISN,ORDLG,DSPGRIEN,DSPGRP
- SET PTLOC=$PIECE(ORD0,U,10)
- SET ORDLG=$PIECE(ORD0,U,5)
- +19 ;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)
- +20 IF '$TEST
- SET DIVISN="NONE SPECIFIED"
- +21 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)
- +22 IF '$TEST
- SET DSPGRP="NONE SPECIFIED"
- +23 NEW ORDCHK1,ORDCHK2
- IF $LENGTH(ORDCHK)>255
- SET ORDCHK1=$EXTRACT(ORDCHK,1,255)
- SET ORDCHK2=$EXTRACT(ORDCHK,256,$LENGTH(ORDCHK))
- +24 IF (ANS("SORT")="OVRDNBY")&($PIECE(ORD9,U,5)=TMP("OVRBYIEN"))
- Begin DoDot:3
- +25 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
- +26 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:3
- +27 IF (ANS("SORT")="ORCHK")&($PIECE(ORD9,U)=TMP("ORCHKIEN"))
- Begin DoDot:3
- +28 NEW ORCHCK1,ORCHCK2
- IF $LENGTH(ORD91)>255
- Begin DoDot:4
- +29 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:4
- +30 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:3
- +31 IF (ANS("SORT")="DIV")&($PIECE($GET(^SC(+$PIECE($GET(^OR(100,ORDNO,0)),U,10),0)),U,15)=TMP("ORDIVIEN"))
- Begin DoDot:3
- +32 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
- +33 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:3
- +34 IF (ANS("SORT")="DSPGRP")&($PIECE($GET(^ORD(101.41,+$PIECE($GET(^OR(100,ORDNO,0)),U,5),0)),U,5)=TMP("ORDGPIEN"))
- Begin DoDot:3
- +35 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
- +36 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:3
- +37 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:3
- +38 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
- +39 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:3
- End DoDot:2
- End DoDot:1
- +40 KILL ^TMP($JOB,"OROCDATA")
- +41 QUIT
- +42 ;
- +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 ;