- 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 Feb 19, 2025@00:00:36 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
