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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORS100 8923 printed Apr 09, 2024@21:26:25 Page 2
ORS100 ; SLC/RAF-unsigned orders search ;10/19/00 14:02
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**50**;Dec 17, 1997
+2 ;
+3 ;This routine will loop thru the "AS" xref in file 100 and
+4 ;allow the user to sort orders by date range, with a status of unsigned,
+5 ;released/unsigned or unsigned/unreleased. It will also allow sorting by
+6 ;service/section, provider, patient, location, entered by person,
+7 ;or division
+8 ;
EN ;
+1 NEW CNT,DASH,DATE,DCNT,DFN,DIR,DIRUT,DIV,DTOUT,DUOUT,EDATE,EDT
+2 NEW HDR,HDR1,IEN,LCNT,LOC,LONER,LONUM,PAGE,PAT,PNM,PROV,QUIT,RPDT
+3 NEW SD1,SD2,SDATE,SDT,SER,SINGLE,SORT,SSN,STOP,STATUS,SUB,SUMONLY,TOT,TOT0,TOT1
+4 NEW TYPE,VA,VADM,VAERR,WHO,WHEN,Y
+5 SET U="^"
KILL ^TMP("ORUNS",$JOB),^TMP("ORSTATS",$JOB)
+6 WRITE @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
+1 SET DIR(0)="SX^1:Released/Unsigned;2:Unsigned;3:Unsigned/Unreleased"
+2 SET DIR("A")="Enter the type of orders to search"
+3 SET 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"
+4 DO ^DIR
if +Y>0
SET TYPE=+Y
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
GOTO EXIT
SORT ;sets DIR call to ask for the sorting criteria
+1 SET DIR(0)="SX^1:Service/Section;2:Provider;3:Patient;4:Location;5:Entered By;6:Division"
+2 SET DIR("A")="Enter the sort criteria"
+3 SET 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"
+4 DO ^DIR
if +Y>0
SET SORT=+Y
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
GOTO EXIT
SINGLE ;sets DIR call to ask the user if they want to sort for a single
+1 ;service, provider, patient, location, division or entered by
+2 SET DIR(0)="Y"
+3 SET DIR("A")="Would you like a specific "_$SELECT(SORT=1:"Service/Section",SORT=2:"Provider",SORT=3:"Patient",SORT=4:"Location",SORT=5:"Entering person",1:"Division")
+4 SET DIR("B")="NO"
+5 SET DIR("?")="You can limit your sort to one or more Service/Section, Provider, Patient, Location, Entered by, or Division, by entering a YES here"
+6 DO ^DIR
if +Y>0
SET SINGLE=+Y
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
GOTO EXIT
LONER ;sets DIR call to allow the user to select the specific sort entity
+1 ;only asked if the user entered a YES in the previous prompt
+2 IF $DATA(SINGLE)
Begin DoDot:1
+3 FOR
Begin DoDot:2
+4 SET DIR(0)=$SELECT(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")
+5 SET DIR("A")="Select "_$SELECT(SORT=1:"Service/Section: ",SORT=2:"Provider: ",SORT=3:"Patient: ",SORT=4:"Location: ",SORT=5:"Entering Person: ",1:"Division: ")
+6 SET DIR("?")="When finished entering all the selections you want, press return or enter to go on. Enter an ^ to exit the option."
+7 DO ^DIR
if +Y>0
SET LONER($PIECE(Y,U,2))=+Y
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET QUIT=1
End DoDot:2
IF Y=-1!($DATA(QUIT))
QUIT
End DoDot:1
IF $DATA(QUIT)!('$DATA(LONER))
GOTO EXIT
SDATE ;sets DIR call to ask the user for a starting date
+1 SET DIR(0)="DA^::ETX"
+2 SET DIR("A")="Enter a starting date: "
+3 SET 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"
+4 DO ^DIR
if +Y>0
SET (SDATE,SD1)=(9999999-Y)
SET SDT=$$FMTE^XLFDT(Y)
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
GOTO EXIT
EDATE ;sets DIR call to ask the user for an ending date (optional)
+1 SET DIR(0)="DA^::ETX"
+2 SET DIR("A")="Enter an ending date: "
+3 SET 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."
+4 DO ^DIR
SET (EDATE,SD2)=(9999999-Y)
SET EDT=$$FMTE^XLFDT(Y)
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
GOTO EXIT
SWITCH ;takes the date input from the user and does a switcheroo so the program
+1 ;can work as intended
+2 IF EDATE'>SDATE
SET EDATE=SD1
SET SDATE=SD2
SUMONLY ;ask if summary only or full detail
+1 SET DIR(0)="Y"
SET DIR("A")="Print summary only "
SET DIR("B")="NO"
SET DIR("?")="Enter yes for summary report (statistics), no for detailed report."
+2 DO ^DIR
SET SUMONLY=$SELECT(Y=1:1,Y=0:0,1:"^")
KILL DIR
IF SUMONLY="^"
QUIT
TASK ;
+1 SET %ZIS="Q"
DO ^%ZIS
IF POP
QUIT
+2 IF $DATA(IO("Q"))
Begin DoDot:1
+3 SET ZTIO=ION
SET ZTDESC="File 100 order status search"
+4 SET ZTRTN="LOOP^ORS100A"
SET ZTSAVE("SORT")=""
SET ZTSAVE("TYPE")=""
+5 SET ZTSAVE("SDATE")=""
SET ZTSAVE("EDATE")=""
SET ZTSAVE("SINGLE")=""
+6 SET ZTSAVE("LONER*")=""
SET ZTSAVE("SDT")=""
SET ZTSAVE("EDT")=""
SET ZTSAVE("SUMONLY")=""
+7 DO ^%ZTLOAD
IF $DATA(ZTSK)
WRITE !,?32,"REQUEST QUEUED"
End DoDot:1
KILL IO("Q")
QUIT
+8 USE IO
DO LOOP^ORS100A
QUIT
STATS ;SERVICE/SECTION statistics
+1 ;Set SUMONLY back to zero so header will print.
if SUMONLY
SET PAGE=0
SET SUMONLY=0
+2 IF '$DATA(^TMP("ORSTATS",$JOB))
DO HDR
if STOP
QUIT
WRITE !,"There are no statistics for the selected sort range."
QUIT
+3 IF SORT=1&($DATA(^TMP("ORSTATS",$JOB)))
Begin DoDot:1
+4 SET HDR="!!?25,""Order Statistics for Service/Section sort"""
+5 SET HDR1="!,""Service/Section"",?25,""Provider"",?50,""# of Orders"""
+6 SET TOT=0
DO HDR
+7 SET SER=""
FOR
SET SER=$ORDER(^TMP("ORSTATS",$JOB,SER))
SET TOT0=0
if SER=""!STOP
QUIT
Begin DoDot:2
+8 SET PROV=""
FOR
SET PROV=$ORDER(^TMP("ORSTATS",$JOB,SER,PROV))
if PROV=""!STOP
QUIT
Begin DoDot:3
+9 WRITE SER,?25,PROV,?50,^(PROV),!
SET TOT1=^(PROV)
SET TOT0=TOT0+TOT1
+10 SET TOT=TOT+TOT1
if $Y>(IOSL-4)
DO HDR
if STOP
QUIT
End DoDot:3
+11 if 'STOP
WRITE ?46,"SUBTOTAL: ",TOT0,!
End DoDot:2
+12 if 'STOP
WRITE ?46,"------------",!?46,"TOTAL: ",TOT
End DoDot:1
PV ;PROVIDER statistics
+1 IF SORT=2&($DATA(^TMP("ORSTATS",$JOB)))
Begin DoDot:1
+2 SET HDR="!!?25,""Order Statistics for Provider sort"""
+3 SET HDR1="!,""Provider"",?25,""Patient"",?50,""# of Orders"""
+4 SET TOT=0
DO HDR
+5 SET PROV=""
FOR
SET PROV=$ORDER(^TMP("ORSTATS",$JOB,PROV))
SET TOT0=0
if PROV=""!STOP
QUIT
Begin DoDot:2
+6 SET PNM=""
FOR
SET PNM=$ORDER(^TMP("ORSTATS",$JOB,PROV,PNM))
if PNM=""!STOP
QUIT
Begin DoDot:3
+7 WRITE PROV,?25,PNM,?50,^(PNM),!
SET TOT1=^(PNM)
+8 SET TOT=TOT+TOT1
SET TOT0=TOT0+TOT1
if $Y>(IOSL-4)
DO HDR
if STOP
QUIT
End DoDot:3
+9 if 'STOP
WRITE ?46,"SUBTOTAL: ",TOT0,!
End DoDot:2
+10 if 'STOP
WRITE ?46,"------------",!?46,"TOTAL: ",TOT
End DoDot:1
PT ;PATIENT statistics
+1 IF SORT=3&($DATA(^TMP("ORSTATS",$JOB)))
Begin DoDot:1
+2 SET HDR="!!?25,""Order Statistics for Patient sort"""
+3 SET HDR1="!,""Patient"",?25,""Provider"",?50,""# of Orders"""
+4 SET TOT=0
DO HDR
+5 SET PNM=""
FOR
SET PNM=$ORDER(^TMP("ORSTATS",$JOB,PNM))
SET TOT0=0
if PNM=""!STOP
QUIT
Begin DoDot:2
+6 SET PROV=""
FOR
SET PROV=$ORDER(^TMP("ORSTATS",$JOB,PNM,PROV))
if PROV=""!STOP
QUIT
Begin DoDot:3
+7 WRITE PNM,?25,PROV,?50,^(PROV),!
SET TOT1=^(PROV)
SET TOT0=TOT0+TOT1
+8 SET TOT=TOT+TOT1
if $Y>(IOSL-4)
DO HDR
if STOP
QUIT
End DoDot:3
+9 if 'STOP
WRITE ?46,"SUBTOTAL: ",TOT0,!
End DoDot:2
+10 if 'STOP
WRITE ?46,"------------",!?46,"TOTAL: ",TOT
End DoDot:1
L ;LOCATION statistics
+1 IF SORT=4&($DATA(^TMP("ORSTATS",$JOB)))
Begin DoDot:1
+2 SET HDR="!!?25,""Order Statistics for Location sort"""
+3 SET HDR1="!,""Location"",?25,""Provider"",?50,""# of Orders"""
+4 SET TOT=0
DO HDR
+5 SET LOC=""
FOR
SET LOC=$ORDER(^TMP("ORSTATS",$JOB,LOC))
SET TOT0=0
if LOC=""!STOP
QUIT
Begin DoDot:2
+6 SET PROV=""
FOR
SET PROV=$ORDER(^TMP("ORSTATS",$JOB,LOC,PROV))
if PROV=""!STOP
QUIT
Begin DoDot:3
+7 WRITE $EXTRACT(LOC,1,24),?25,PROV,?50,^(PROV),!
SET TOT1=^(PROV)
SET TOT0=TOT0+TOT1
+8 SET TOT=TOT+TOT1
if $Y>(IOSL-4)
DO HDR
if STOP
QUIT
End DoDot:3
+9 if 'STOP
WRITE ?46,"SUBTOTAL: ",TOT0,!
End DoDot:2
+10 if 'STOP
WRITE ?46,"------------",!?46,"TOTAL: ",TOT
End DoDot:1
EB ;ENTERED BY statistics
+1 IF SORT=5&($DATA(^TMP("ORSTATS",$JOB)))
Begin DoDot:1
+2 SET HDR="!!?25,""Order Statistics for Entering Person sort"""
+3 SET HDR1="!,""Entering person"",?25,""Patient"",?50,""# of Orders"""
+4 SET TOT=0
DO HDR
+5 SET WHO=""
FOR
SET WHO=$ORDER(^TMP("ORSTATS",$JOB,WHO))
SET TOT0=0
if WHO=""!STOP
QUIT
Begin DoDot:2
+6 SET PNM=""
FOR
SET PNM=$ORDER(^TMP("ORSTATS",$JOB,WHO,PNM))
if PNM=""!STOP
QUIT
Begin DoDot:3
+7 WRITE WHO,?25,PNM,?50,^(PNM),!
SET TOT1=^(PNM)
SET TOT0=TOT0+TOT1
+8 SET TOT=TOT+TOT1
if $Y>(IOS-4)
DO HDR
if STOP
QUIT
End DoDot:3
+9 if 'STOP
WRITE ?46,"SUBTOTAL: ",TOT0,!
End DoDot:2
+10 if 'STOP
WRITE ?46,"------------",!?46,"TOTAL: ",TOT
End DoDot:1
D ;DIVISION statistics
+1 IF SORT=6&($DATA(^TMP("ORSTATS",$JOB)))
Begin DoDot:1
+2 SET HDR="!!?25,""Order Statistics for Division sort"""
+3 SET DIV=""
FOR
SET DIV=$ORDER(^TMP("ORSTATS",$JOB,DIV))
if DIV=""!STOP
QUIT
SET DCNT=0
Begin DoDot:2
+4 SET LOC=""
FOR
SET LOC=$ORDER(^TMP("ORSTATS",$JOB,DIV,LOC))
if LOC=""!STOP
QUIT
SET LCNT=0
Begin DoDot:3
+5 SET HDR1="!!,""Division: "",DIV,!?5,""Location: "",LOC,!?20,""Provider"",?51,""Orders"""
DO HDR
if STOP
QUIT
+6 SET PROV=""
FOR
SET PROV=$ORDER(^TMP("ORSTATS",$JOB,DIV,LOC,PROV))
if PROV=""!STOP
QUIT
Begin DoDot:4
+7 WRITE ?20,PROV,?51,^(PROV),!
SET LCNT=LCNT+^(PROV)
if $Y>(IOSL-4)
DO HDR
if STOP
QUIT
End DoDot:4
+8 IF 'STOP
WRITE !?41,"Subtotal",?51,LCNT
SET DCNT=DCNT+LCNT
End DoDot:3
+9 IF 'STOP
WRITE !?5,"Total orders for Division: ",DIV_" = "_DCNT
End DoDot:2
End DoDot:1
EXIT KILL ^TMP("ORUNS",$JOB),^TMP("ORSTATS",$JOB)
+1 DO ^%ZISC
+2 QUIT
LOC(LOC) ;resolves the location pointer
+1 NEW X
+2 SET X=$PIECE(^SC(+LOC,0),U)
+3 QUIT X
USER(USER) ;resolves user pointers
+1 NEW X
+2 SET X=$EXTRACT($PIECE(^VA(200,+USER,0),U),1,24)
+3 QUIT X
STAT(STA) ;resolves pointer to the order status file
+1 NEW X
+2 SET X=$EXTRACT($PIECE(^ORD(100.01,+STA,0),U),1,14)
+3 QUIT X
SER(SER) ;resolves pointer to the service/section file
+1 NEW X
+2 SET X=$PIECE(^DIC(49,+SER,0),U)
+3 QUIT X
DIV(LOC) ;determines the division based on the entry in file 44
+1 NEW X
+2 SET X=$PIECE(^SC(+LOC,0),U,15)
IF X=""
QUIT "UNKNOWN"
+3 SET X=$PIECE(^DG(40.8,X,0),U)
+4 QUIT X
HDR ;Print header
+1 IF $GET(SUMONLY)
QUIT
+2 IF $EXTRACT(IOST)="C"&(PAGE)
SET DIR(0)="E"
DO ^DIR
if Y'=1
SET STOP=1
KILL DIR
if STOP
QUIT
+3 IF PAGE!('PAGE&($EXTRACT(IOST)="C"))
WRITE @IOF
+4 IF $DATA(RPDT)
WRITE @RPDT
+5 IF $DATA(HDR)
WRITE @HDR
+6 IF $DATA(HDR1)
WRITE @HDR1
+7 WRITE !,$$REPEAT^XLFSTR("-",IOM),!
+8 SET PAGE=1
+9 QUIT
