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

ORS100 ; SLC/RAF-unsigned orders search ;10/19/00  14:02
 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**50**;Dec 17, 1997
 ;
 ;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,"Unsigned Orders Search",!?15,"This report is formatted for a 132 column output.",!
TYPE ;sets DIR call to ask the user to select the type of order status
 S DIR(0)="SX^1:Released/Unsigned;2:Unsigned;3:Unsigned/Unreleased"
 S DIR("A")="Enter the type of orders to search"
 S DIR("?")="You may enter a 1 for Released/Unsigned orders, 2 for Unsigned orders, 3 for Unsigned/Unreleased orders. Enter an ^ to exit the option"
 D ^DIR S:+Y>0 TYPE=+Y K DIR I $D(DTOUT)!$D(DUOUT) G EXIT
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^ORS100A",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^ORS100A 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