Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ORSRCHOR

ORSRCHOR.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ;
  1. ASKUSER(ANS,DIR,ORQUIT) ; Controls prompting of the report utility.
  1. ;
  1. I $G(ANS("EXIT"))="YES" Q
  1. S ANS("EXIT")="NO"
  1. N DIRUT,POP,X,Y
  1. 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"
  1. D ^DIR I $D(DIRUT) S ANS("EXIT")="YES" Q
  1. N ORRSPNSE S ORRSPNSE=Y K DIR
  1. N %DT,CNT,Y,DUOUT,DTOUT
  1. S %DT="AE" F CNT=1:1:2 D
  1. . 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),"@"))
  1. . D ^%DT I Y=-1 S CNT=2 Q
  1. . E D
  1. . . I CNT=1 S TMP("STRDT")=$P(Y,".")
  1. . . I CNT=2 S TMP("ENDDT")=$P(Y,".")_".24"
  1. I '$D(TMP("STRDT"))!'$D(TMP("ENDDT"))!$D(DTOUT)!$D(DUOUT) S ANS("EXIT")="YES" Q
  1. I ORRSPNSE=1 D ; filter search by OVERRIDDEN BY field
  1. . 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
  1. . S ANS("SORT")="OVRDNBY",TMP("OVRBYIEN")=+Y,TMP("OVRBY")=Y(0,0)
  1. I ORRSPNSE=2 D ; filter search by ORDER CHK
  1. . 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
  1. . S ANS("SORT")="ORCHK",TMP("ORCHKIEN")=+Y,TMP("ORCHK")=Y(0,0)
  1. I ORRSPNSE=3 D ; filter search by DIUISION
  1. . 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
  1. . S ANS("SORT")="DIV",TMP("ORDIVIEN")=+Y,TMP("ORDIV")=Y(0,0)
  1. I ORRSPNSE=4 D ; filter search by DISPLAY GROUP
  1. . 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
  1. . S ANS("SORT")="DSPGRP",TMP("ORDGPIEN")=+Y,TMP("ORDSPGRP")=Y(0,0)
  1. I ORRSPNSE=5 D ; filter search by DIVISION & DISPLAY GROUP
  1. . N DIC,CNT,Y,DTOUT,DUOUT S DIC(0)="QEAMZ",ANS("SORT")="DTORD"
  1. . F CNT=1:1:2 D
  1. . . S DIC=$S(CNT=1:"^DG(40.8,",CNT=2:"^ORD(100.98,")
  1. . . D ^DIC I Y=-1 S CNT=2 Q
  1. . . E D
  1. . . . I CNT=1 S TMP("ORDIVIEN")=+Y,TMP("ORDIV")=Y(0,0)
  1. . . . I CNT=2 S TMP("ORDGPIEN")=+Y,TMP("ORDSPGRP")=Y(0,0)
  1. . I '$D(TMP("ORDIVIEN"))!'$D(TMP("ORDGPIEN"))!$D(DTOUT)!$D(DUOUT) S ANS("EXIT")="YES" Q
  1. I ANS("EXIT")="NO" D
  1. . N DIR,DIRUT,POP,X,Y S DIR(0)="Y",DIR("A")="Print delimited output only",DIR("B")="NO"
  1. . S DIR("?",1)="Entering 'YES' will allow the user to specify a delimiter character",DIR("?",2)="and create a delimited report.",DIR("?",3)=""
  1. . S DIR("?")="Entering 'NO' will create a regular summary report."
  1. . D ^DIR I $D(DIRUT) S ANS("EXIT")="YES" Q
  1. . S ANS("DELIMIT")=Y(0) I ANS("DELIMIT")="YES" D
  1. . . N DIR,DIRUT,X,Y S DIR("A")="Specify REPORT DELIMITER CHARACTER",DIR("B")="U"
  1. . . S DIR(0)="S^P:Pipe;T:Tilde;U:Up arrow"
  1. . . D ^DIR I $D(DIRUT) S ANS("EXIT")="YES" Q
  1. . . S ANS("DELIMITER")=Y K DIR
  1. . W !,"Searching....." D SRCHBYDT(TMP("STRDT"),TMP("ENDDT"))
  1. Q
  1. ;
  1. SRCHBYDT(STRDT,ENDDT) ; Search by Date/Time Ordered and sort by Date/Time Ordered, Division, Display Group, or Order Chk.
  1. ;
  1. N AFGLB,ORDNO,ORDACT
  1. K ^TMP("OROVRRPT",$J) ; Ensures a fresh start
  1. S AFGLB=$NA(^OR(100,"AF")),TMP=$NA(^TMP("OROVRRPT",$J))
  1. S (ORDNO,ORDACT)=0
  1. I (ANS("SORT")="OVRDNBY") S (TMP("ORCHKIEN"),TMP("ORDIVIEN"),TMP("ORDGPIEN"))=""
  1. I (ANS("SORT")="ORCHK") S (TMP("OVRBYIEN"),TMP("ORDIVIEN"),TMP("ORDGPIEN"))=""
  1. I (ANS("SORT")="DIV") S (TMP("ORCHKIEN"),TMP("OVRBYIEN"),TMP("ORDGPIEN"))=""
  1. I (ANS("SORT")="DSPGRP") S (TMP("ORCHKIEN"),TMP("ORDIVIEN"),TMP("OVRBYIEN"))=""
  1. I (ANS("SORT")="DTORD") S (TMP("ORCHKIEN"),TMP("OVRBYIEN"))=""
  1. 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
  1. . K ^TMP($J,"OROCDATA") D OCAPI^ORCHECK(ORDNO,"OROCDATA")
  1. . I (ORDACT=1)&($$OCCNT^OROCAPI1(ORDNO))&($L($G(^TMP($J,"OROCDATA",1,"OR REASON")))>0) D
  1. . . N ORD0,ORD8,ORD9,ORD91,ORDCHK S ORD0=$G(^OR(100,ORDNO,0)),ORD8=$G(^OR(100,ORDNO,8,1,.1,1,0))
  1. . . 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"))
  1. . . S ORD91=$G(^TMP($J,"OROCDATA",1,"OC TEXT",1,0))
  1. . . S ORDCHK=$G(^ORD(100.8,$P(ORD9,U),0))_": "_ORD91
  1. . . N PTLOC,DIVIEN,DIVISN,ORDLG,DSPGRIEN,DSPGRP S PTLOC=$P(ORD0,U,10),ORDLG=$P(ORD0,U,5)
  1. . . 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
  1. . . E S DIVISN="NONE SPECIFIED"
  1. . . 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)
  1. . . E S DSPGRP="NONE SPECIFIED"
  1. . . N ORDCHK1,ORDCHK2 I $L(ORDCHK)>255 S ORDCHK1=$E(ORDCHK,1,255),ORDCHK2=$E(ORDCHK,256,$L(ORDCHK))
  1. . . I (ANS("SORT")="OVRDNBY")&($P(ORD9,U,5)=TMP("OVRBYIEN")) D
  1. . . . 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
  1. . . . E S @TMP@(STRDT,DIVISN,DSPGRP,ORDCHK,ORDNO)=ORD8_U_$P(ORD9,U,4)_U_TMP("OVRBY")_U_$P(ORD9,U,6)
  1. . . I (ANS("SORT")="ORCHK")&($P(ORD9,U)=TMP("ORCHKIEN")) D
  1. . . . N ORCHCK1,ORCHCK2 I $L(ORD91)>255 D
  1. . . . . 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
  1. . . . E S @TMP@(ORD91,DIVISN,DSPGRP,STRDT,ORDNO)=ORD8_U_$P(ORD9,U,4)_U_$P(ORD9,U,5)_U_$P(ORD9,U,6)
  1. . . I (ANS("SORT")="DIV")&($P($G(^SC(+$P($G(^OR(100,ORDNO,0)),U,10),0)),U,15)=TMP("ORDIVIEN")) D
  1. . . . 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
  1. . . . 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)
  1. . . I (ANS("SORT")="DSPGRP")&($P($G(^ORD(101.41,+$P($G(^OR(100,ORDNO,0)),U,5),0)),U,5)=TMP("ORDGPIEN")) D
  1. . . . 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
  1. . . . 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)
  1. . . 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
  1. . . . 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
  1. . . . 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)
  1. K ^TMP($J,"OROCDATA")
  1. Q
  1. ;
  1. ;
  1. N SORT,SRTORD,TITLE,PERTTL,TTLIEN S TITLE="Order Check Override Reason Report",SORT="Sorted in Ascending order by: "
  1. I ANS("SORT")="OVRDNBY" S SRTORD="Date/Time Ordered, Division, Display Group, Order Chk, & Order#"
  1. I ANS("SORT")="ORCHK" S SRTORD="Order Chk, Division, Display Group, Date/Time Ordered, & Order#"
  1. I ANS("SORT")="DTORD" S SRTORD="Date/Time Ordered, Order Chk, & Order#"
  1. I ANS("SORT")="DIV" S SRTORD="Display Group, Order Chk, Date/Time Ordered, & Order#"
  1. I ANS("SORT")="DSPGRP" S SRTORD="Division, Order Chk, Date/Time Ordered, & Order#"
  1. I $D(IO("SPOOL"))!($D(IO("HFSIO"))) S IOM=80
  1. W @IOF,?(IOM-$L(TITLE))/2,TITLE,!?(IOM-$L(SORT))/2,SORT,!?(IOM-$L(SRTORD))/2,SRTORD
  1. W !!!,"Current User: ",$E($$GET1^DIQ(200,+$G(DUZ),.01),1,26),?42,"Current Date: ",$$HTE^XLFDT($H)
  1. W !,"Date Range Searched: ",$$FMTE^XLFDT(TMP("STRDT"),"1D")," - ",$$FMTE^XLFDT(TMP("ENDDT"),"1D"),?54,"WHERE"
  1. I ANS("SORT")="OVRDNBY" D
  1. . S TTLIEN=$P($G(^VA(200,TMP("OVRBYIEN"),0)),U,9) I TTLIEN="" S PERTTL="NONE SPECIFIED"
  1. . E S PERTTL=$P($G(^DIC(3.1,TTLIEN,0)),U) I PERTTL="" S PERTTL="NONE SPECIFIED"
  1. . W !,"Order Chks are Overridden By: ",TMP("OVRBY"),!,"Title: ",PERTTL,!!
  1. I ANS("SORT")="ORCHK" W !,"Order Check: ",TMP("ORCHK"),!!
  1. I ANS("SORT")="DIV" W !,"Division: ",TMP("ORDIV"),!!
  1. I ANS("SORT")="DSPGRP" W !,"Display Group: ",TMP("ORDSPGRP"),!!
  1. I ANS("SORT")="DTORD" W !,"Division: ",TMP("ORDIV"),!,"Display Group: ",TMP("ORDSPGRP"),!!
  1. I ANS("DELIMIT")="YES"&($D(^TMP("OROVRRPT",$J))) D
  1. . S TMP("DLMTR")=$S(ANS("DELIMITER")="P":"|",ANS("DELIMITER")="T":"~",ANS("DELIMITER")="U":"^")
  1. . 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"
  1. . 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"
  1. . 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"
  1. . 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"
  1. . I ANS("SORT")="DTORD" W "RECNO"_TMP("DLMTR")_"Date/Time Ordered"_TMP("DLMTR")_"Order#"_TMP("DLMTR")_"Overridden by"_TMP("DLMTR")_"D/T Overridden"
  1. COLHDR I ANS("DELIMIT")="NO" D
  1. . I ANS("SORT")="OVRDNBY"!(ANS("SORT")="ORCHK") W "Date/Time Ordered",?21,"Division",?40,"Display Group",?70,"Order#",!,"-----------------",?21,"--------",?40,"-------------",?70,"------"
  1. . I ANS("SORT")="DIV" W "Date/Time Ordered",?25,"Display Group",?60,"Order#",!,"-----------------",?25,"-------------",?60,"------"
  1. . I ANS("SORT")="DSPGRP" W "Date/Time Ordered",?25,"Division",?60,"Order#",!,"-----------------",?25,"--------",?60,"------"
  1. . I ANS("SORT")="DTORD" W "Date/Time Ordered",?45,"Order#",!,"-----------------",?45,"------"
  1. Q
  1. ;