source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORLPSR.m

ORLPSR  ; SLC/RAF-unsigned orders search ;10/19/00  14:02
        ;;3.0;ORDER ENTRY/RESULTS REPORTING;**243**;Dec 17, 1997;Build 242
        ;
        ;This routine will loop thru the "AS" xref in file 100 and 
        ;allow the user to sort orders by date range, with a status of unsigned,
        ;released/unsigned or unsigned/unreleased. It will also allow sorting by
        ;service/section, provider, patient, location, entered by person,
        ;or division
        ;
EN      ;
        N CNT,DASH,DATE,DCNT,DFN,DIR,DIRUT,DIV,DTOUT,DUOUT,EDATE,EDT
        N HDR,HDR1,IEN,LCNT,LOC,LONER,LONUM,PAGE,PAT,PNM,PROV,QUIT,RPDT
        N SD1,SD2,SDATE,SDT,SER,SINGLE,SORT,SSN,STOP,STATUS,SUB,SUMONLY,TOT,TOT0,TOT1
        N TYPE,VA,VADM,VAERR,WHO,WHEN,Y
        S U="^" K ^TMP("ORUNS",$J),^TMP("ORSTATS",$J)
        W @IOF,!!?30,"Lapsed Orders Search",!?15,"This report is formatted for a 132 column output.",!
TYPE    S TYPE=2
SORT    ;sets DIR call to ask for the sorting criteria
        S DIR(0)="SX^1:Service/Section;2:Provider;3:Patient;4:Location;5:Entered By;6:Division"
        S DIR("A")="Enter the sort criteria"
        S DIR("?")="To sort orders by Service/Section enter a 1, by Provider enter a 2, by Patient enter a 3, by Location enter a 4, by Entering Person enter a 5 and by Division enter a 6, Enter an ^ to exit the option"
        D ^DIR S:+Y>0 SORT=+Y K DIR I $D(DTOUT)!$D(DUOUT) G EXIT
SINGLE  ;sets DIR call to ask the user if they want to sort for a single
        ;service, provider, patient, location, division or entered by
        S DIR(0)="Y"
        S DIR("A")="Would you like a specific "_$S(SORT=1:"Service/Section",SORT=2:"Provider",SORT=3:"Patient",SORT=4:"Location",SORT=5:"Entering person",1:"Division")
        S DIR("B")="NO"
        S DIR("?")="You can limit your sort to one or more Service/Section, Provider, Patient, Location, Entered by, or Division, by entering a YES  here"
        D ^DIR S:+Y>0 SINGLE=+Y K DIR I $D(DTOUT)!$D(DUOUT) G EXIT
LONER   ;sets DIR call to allow the user to select the specific sort entity
        ;only asked if the user entered a YES in the previous prompt
        I $D(SINGLE) D  I $D(QUIT)!('$D(LONER)) G EXIT
        .F  D  I Y=-1!($D(QUIT)) Q
        ..S DIR(0)=$S(SORT=1:"PAO^49:AEQM",SORT=2:"PAO^200:AEQM,",SORT=3:"PAO^2:AEQM",SORT=4:"PAO^44:AEQM",SORT=5:"PAO^200:AEQM",SORT=6:"PAO^40.8:AEQM")
        ..S DIR("A")="Select "_$S(SORT=1:"Service/Section: ",SORT=2:"Provider: ",SORT=3:"Patient: ",SORT=4:"Location: ",SORT=5:"Entering Person: ",1:"Division: ")
        ..S DIR("?")="When finished entering all the selections you want, press return or enter to go on. Enter an ^ to exit the option."
        ..D ^DIR S:+Y>0 LONER($P(Y,U,2))=+Y K DIR I $D(DTOUT)!$D(DUOUT) S QUIT=1
SDATE   ;sets DIR call to ask the user for a starting date
        S DIR(0)="DA^::ETX"
        S DIR("A")="Enter a starting date: "
        S DIR("?")="Enter the date or date/time that you want the search to start with.  Example: If your site has a 48 hr grace period for signing orders,         enter T-2"
        D ^DIR S:+Y>0 (SDATE,SD1)=(9999999-Y),SDT=$$FMTE^XLFDT(Y) K DIR I $D(DTOUT)!$D(DUOUT) G EXIT
EDATE   ;sets DIR call to ask the user for an ending date (optional)
        S DIR(0)="DA^::ETX"
        S DIR("A")="Enter an ending date: "
        S DIR("?")="Enter the date or date/time that you want the search to end with. This field can be used to ignore pre-CPRS unsigned orders by entering the date of your CPRS installation."
        D ^DIR S (EDATE,SD2)=(9999999-Y),EDT=$$FMTE^XLFDT(Y) K DIR I $D(DTOUT)!$D(DUOUT) G EXIT
SWITCH  ;takes the date input from the user and does a switcheroo so the program
        ;can work as intended
        I EDATE'>SDATE S EDATE=SD1,SDATE=SD2
SUMONLY ;ask if summary only or full detail
        S DIR(0)="Y",DIR("A")="Print summary only ",DIR("B")="NO",DIR("?")="Enter yes for summary report (statistics), no for detailed report."
        D ^DIR S SUMONLY=$S(Y=1:1,Y=0:0,1:"^") K DIR I SUMONLY="^" Q
TASK    ;
        S %ZIS="Q" D ^%ZIS I POP Q
        I $D(IO("Q")) D  K IO("Q") Q
        .S ZTIO=ION,ZTDESC="File 100 order status search"
        .S ZTRTN="LOOP^ORLPSRA",ZTSAVE("SORT")="",ZTSAVE("TYPE")=""
        .S ZTSAVE("SDATE")="",ZTSAVE("EDATE")="",ZTSAVE("SINGLE")=""
        .S ZTSAVE("LONER*")="",ZTSAVE("SDT")="",ZTSAVE("EDT")="",ZTSAVE("SUMONLY")=""
        .D ^%ZTLOAD I $D(ZTSK) W !,?32,"REQUEST QUEUED"
        U IO D LOOP^ORLPSRA Q
STATS   ;SERVICE/SECTION statistics
        S:SUMONLY PAGE=0 S SUMONLY=0 ;Set SUMONLY back to zero so header will print.
        I '$D(^TMP("ORSTATS",$J)) D HDR Q:STOP  W !,"There are no statistics for the selected sort range." Q
        I SORT=1&($D(^TMP("ORSTATS",$J))) D
        .S HDR="!!?25,""Order Statistics for Service/Section sort"""
        .S HDR1="!,""Service/Section"",?25,""Provider"",?50,""# of Orders"""
        .S TOT=0 D HDR
        .S SER="" F  S SER=$O(^TMP("ORSTATS",$J,SER)) S TOT0=0 Q:SER=""!STOP  D
        ..S PROV="" F  S PROV=$O(^TMP("ORSTATS",$J,SER,PROV)) Q:PROV=""!STOP  D
        ...W SER,?25,PROV,?50,^(PROV),! S TOT1=^(PROV),TOT0=TOT0+TOT1
        ...S TOT=TOT+TOT1 D:$Y>(IOSL-4) HDR Q:STOP
        ..W:'STOP ?46,"SUBTOTAL: ",TOT0,!
        .W:'STOP ?46,"------------",!?46,"TOTAL: ",TOT
PV      ;PROVIDER statistics
        I SORT=2&($D(^TMP("ORSTATS",$J))) D
        .S HDR="!!?25,""Order Statistics for Provider sort"""
        .S HDR1="!,""Provider"",?25,""Patient"",?50,""# of Orders"""
        .S TOT=0 D HDR
        .S PROV="" F  S PROV=$O(^TMP("ORSTATS",$J,PROV)) S TOT0=0 Q:PROV=""!STOP  D
        ..S PNM="" F  S PNM=$O(^TMP("ORSTATS",$J,PROV,PNM)) Q:PNM=""!STOP  D
        ...W PROV,?25,PNM,?50,^(PNM),! S TOT1=^(PNM)
        ...S TOT=TOT+TOT1,TOT0=TOT0+TOT1 D:$Y>(IOSL-4) HDR Q:STOP
        ..W:'STOP ?46,"SUBTOTAL: ",TOT0,!
        .W:'STOP ?46,"------------",!?46,"TOTAL: ",TOT
PT      ;PATIENT statistics
        I SORT=3&($D(^TMP("ORSTATS",$J))) D
        .S HDR="!!?25,""Order Statistics for Patient sort"""
        .S HDR1="!,""Patient"",?25,""Provider"",?50,""# of Orders"""
        .S TOT=0 D HDR
        .S PNM="" F  S PNM=$O(^TMP("ORSTATS",$J,PNM)) S TOT0=0 Q:PNM=""!STOP  D
        ..S PROV="" F  S PROV=$O(^TMP("ORSTATS",$J,PNM,PROV)) Q:PROV=""!STOP  D
        ...W PNM,?25,PROV,?50,^(PROV),! S TOT1=^(PROV),TOT0=TOT0+TOT1
        ...S TOT=TOT+TOT1 D:$Y>(IOSL-4) HDR Q:STOP
        ..W:'STOP ?46,"SUBTOTAL: ",TOT0,!
        .W:'STOP ?46,"------------",!?46,"TOTAL: ",TOT
L       ;LOCATION statistics
        I SORT=4&($D(^TMP("ORSTATS",$J))) D
        .S HDR="!!?25,""Order Statistics for Location sort"""
        .S HDR1="!,""Location"",?25,""Provider"",?50,""# of Orders"""
        .S TOT=0 D HDR
        .S LOC="" F  S LOC=$O(^TMP("ORSTATS",$J,LOC)) S TOT0=0 Q:LOC=""!STOP  D
        ..S PROV="" F  S PROV=$O(^TMP("ORSTATS",$J,LOC,PROV)) Q:PROV=""!STOP  D
        ...W $E(LOC,1,24),?25,PROV,?50,^(PROV),! S TOT1=^(PROV),TOT0=TOT0+TOT1
        ...S TOT=TOT+TOT1 D:$Y>(IOSL-4) HDR Q:STOP
        ..W:'STOP ?46,"SUBTOTAL: ",TOT0,!
        .W:'STOP ?46,"------------",!?46,"TOTAL: ",TOT
EB      ;ENTERED BY statistics
        I SORT=5&($D(^TMP("ORSTATS",$J))) D
        .S HDR="!!?25,""Order Statistics for Entering Person sort"""
        .S HDR1="!,""Entering person"",?25,""Patient"",?50,""# of Orders"""
        .S TOT=0 D HDR
        .S WHO="" F  S WHO=$O(^TMP("ORSTATS",$J,WHO)) S TOT0=0 Q:WHO=""!STOP  D
        ..S PNM="" F  S PNM=$O(^TMP("ORSTATS",$J,WHO,PNM)) Q:PNM=""!STOP  D
        ...W WHO,?25,PNM,?50,^(PNM),! S TOT1=^(PNM),TOT0=TOT0+TOT1
        ...S TOT=TOT+TOT1 D:$Y>(IOS-4) HDR Q:STOP
        ..W:'STOP ?46,"SUBTOTAL: ",TOT0,!
        .W:'STOP ?46,"------------",!?46,"TOTAL: ",TOT
D       ;DIVISION statistics
        I SORT=6&($D(^TMP("ORSTATS",$J))) D
        .S HDR="!!?25,""Order Statistics for Division sort"""
        .S DIV="" F  S DIV=$O(^TMP("ORSTATS",$J,DIV)) Q:DIV=""!STOP  S DCNT=0 D
        ..S LOC="" F  S LOC=$O(^TMP("ORSTATS",$J,DIV,LOC)) Q:LOC=""!STOP  S LCNT=0 D
        ...S HDR1="!!,""Division: "",DIV,!?5,""Location: "",LOC,!?20,""Provider"",?51,""Orders""" D HDR Q:STOP
        ...S PROV="" F  S PROV=$O(^TMP("ORSTATS",$J,DIV,LOC,PROV)) Q:PROV=""!STOP  D
        ....W ?20,PROV,?51,^(PROV),! S LCNT=LCNT+^(PROV) D:$Y>(IOSL-4) HDR Q:STOP
        ...I 'STOP W !?41,"Subtotal",?51,LCNT S DCNT=DCNT+LCNT
        ..I 'STOP W !?5,"Total orders for Division: ",DIV_" = "_DCNT
EXIT    K ^TMP("ORUNS",$J),^TMP("ORSTATS",$J)
        D ^%ZISC
        Q
LOC(LOC)        ;resolves the location pointer
        N X
        S X=$P(^SC(+LOC,0),U)
        Q X
USER(USER)      ;resolves user pointers
        N X
        S X=$E($P(^VA(200,+USER,0),U),1,24)
        Q X
STAT(STA)       ;resolves pointer to the order status file
        N X
        S X=$E($P(^ORD(100.01,+STA,0),U),1,14)
        Q X
SER(SER)        ;resolves pointer to the service/section file
        N X
        S X=$P(^DIC(49,+SER,0),U)
        Q X
DIV(LOC)        ;determines the division based on the entry in file 44
        N X
        S X=$P(^SC(+LOC,0),U,15) I X="" Q "UNKNOWN"
        S X=$P(^DG(40.8,X,0),U)
        Q X
HDR     ;Print header
        I $G(SUMONLY) Q
        I $E(IOST)="C"&(PAGE) S DIR(0)="E" D ^DIR S:Y'=1 STOP=1 K DIR Q:STOP
        I PAGE!('PAGE&($E(IOST)="C")) W @IOF
        I $D(RPDT) W @RPDT
        I $D(HDR) W @HDR
        I $D(HDR1) W @HDR1
        W !,$$REPEAT^XLFSTR("-",IOM),!
        S PAGE=1
        Q