ORLPSRB ;SLC/RAF - Continuation of ORLPSRA ; 3/31/08 6:23am
;;3.0;ORDER ENTRY/RESULTS REPORTING;**243**;Dec 17, 1997;Build 242
;
WHO ;loops thru the TMP global for output sort by entering person
I SORT=5&('$D(LONER)) D
.I TYPE=1 S HDR="!!?30,""List of RELEASED but UNSIGNED orders by ENTERING PERSON"""
.I TYPE=2 S HDR="!!?40,""List of LAPSED orders by ENTERING PERSON"""
.I TYPE=3 S HDR="!!?30,""List of UNSIGNED/UNRELEASED orders by ENTERING PERSON"""
.S HDR1="!!,""ENTERED BY"",?23,""PROVIDER"",?46,""PATIENT"",?71,""SSN"",?77,""STATUS"",?87,""ORDER #"",?100,""ORDER DATE"",?118,""LAPSE DATE"""
.S PAGE=0 D HDR^ORLPSR
.I '$D(^TMP("ORUNS",$J)) W !,"No lapsed orders found" Q
.S WHO="" F S WHO=$O(^TMP("ORUNS",$J,WHO)) Q:WHO=""!STOP D
..S PNM="" F S PNM=$O(^TMP("ORUNS",$J,WHO,PNM)) S CNT=0 Q:PNM=""!STOP D
...S IEN=0 F S IEN=$O(^TMP("ORUNS",$J,WHO,PNM,IEN)) S CNT=CNT+1 Q:'IEN!STOP D
....I 'SUMONLY W $P(^(IEN),U),?23,$P(^(IEN),U,2),?46,$P(^(IEN),U,3),?71,$P(^(IEN),U,4),?77,$P(^(IEN),U,5),?87,$P(^(IEN),U,6),?100,$P(^(IEN),U,7),?118,$P(^(IEN),U,8),! D:$Y>(IOSL-4) HDR^ORLPSR Q:STOP
....S ^TMP("ORSTATS",$J,WHO,PNM)=CNT
SWHO ;sorts for a single provider/entering person
I SORT=5&($D(LONER)) S LONER="",PAGE=0 F S LONER=$O(LONER(LONER)) Q:LONER=""!STOP D
.I TYPE=1 S HDR="!!?30,""List of RELEASED but UNSIGNED orders for "",LONER"
.I TYPE=2 S HDR="!!?30,""List of LAPSED orders for "",LONER"
.I TYPE=3 S HDR="!!?30,""List of UNSIGNED/UNRELEASED orders for "",LONER"
.S HDR1="!!,""ENTERED BY"",?23,""PROVIDER"",?46,""PATIENT"",?71,""SSN"",?77,""STATUS"",?87,""ORDER #"",?100,""ORDER DATE"",?118,""LAPSE DATE"""
.D HDR^ORLPSR
.S WHO=LONER I $D(^TMP("ORUNS",$J,WHO)) D
..S PNM="" F S PNM=$O(^TMP("ORUNS",$J,WHO,PNM)) S CNT=0 Q:PNM=""!STOP D
...S IEN=0 F S IEN=$O(^TMP("ORUNS",$J,WHO,PNM,IEN)) S CNT=CNT+1 Q:'IEN!STOP D
....I 'SUMONLY W $P(^(IEN),U),?23,$P(^(IEN),U,2),?46,$P(^(IEN),U,3),?71,$P(^(IEN),U,4),?77,$P(^(IEN),U,5),?87,$P(^(IEN),U,6),?100,$P(^(IEN),U,7),?118,$P(^(IEN),U,8),! D:$Y>(IOSL-4) HDR^ORLPSR Q:STOP
....S ^TMP("ORSTATS",$J,WHO,PNM)=CNT
.I '$D(^TMP("ORUNS",$J,WHO)) W !!,"No lapsed orders found for "_LONER
DIV ;loops thru the TMP global for output sort by division
I SORT=6&('$D(LONER)) D
.I TYPE=1 S HDR="!!?30,""List of RELEASED but UNSIGNED orders by DIVISION"""
.I TYPE=2 S HDR="!!?30,""List of LAPSED orders by DIVISION"""
.I TYPE=3 S HDR="!!?30,""List of UNSIGNED/UNRELEASED orders by DIVISION"""
.S HDR1="!!?15,""ENTERED BY"",?40,""PATIENT"",?65,""SSN"",?71,""STATUS"",?90,""ORDER #"",?102,""ORDER DATE"",?118,""LAPSE DATE"""
.S PAGE=0 D HDR^ORLPSR
.I '$D(^TMP("ORUNS",$J)) W !,"No lapsed orders found" Q
.S DIV="" F S DIV=$O(^TMP("ORUNS",$J,DIV)) Q:DIV=""!STOP W:'SUMONLY "Division: ",DIV D
..S LOC="" F S LOC=$O(^TMP("ORUNS",$J,DIV,LOC)) Q:LOC=""!STOP W:'SUMONLY !?5,"Location: ",LOC D
...S PROV="" F S PROV=$O(^TMP("ORUNS",$J,DIV,LOC,PROV)) Q:PROV=""!STOP W:'SUMONLY !?10,"Provider: ",PROV,! S CNT=0 D
....S IEN=0 F S IEN=$O(^TMP("ORUNS",$J,DIV,LOC,PROV,IEN)) S CNT=CNT+1 Q:'IEN!STOP D
.....W:'SUMONLY ?15,$S(PROV'=$P(^TMP("ORUNS",$J,DIV,LOC,PROV,IEN),U,4):$P(^(IEN),U,4),1:""),?40,$P(^(IEN),U,5),?65,$P(^(IEN),U,6),?71,$P(^(IEN),U,7),?90,$P(^(IEN),U,8),?102,$P(^(IEN),U,9),?118,$P(^(IEN),U,10),! D:$Y>(IOSL-4) HDR^ORLPSR Q:STOP
.....S ^TMP("ORSTATS",$J,DIV,LOC,PROV)=CNT
SDIV ;sorts for a single division
I SORT=6&($D(LONER)) S LONER="",PAGE=0 F S LONER=$O(LONER(LONER)) Q:LONER=""!STOP D
.I TYPE=1 S HDR="!!?30,""List of RELEASED but UNSIGNED orders for "",LONER"
.I TYPE=2 S HDR="!!?30,""List of LAPSED orders for "",LONER"
.I TYPE=3 S HDR="!!?30,""List of UNSIGNED/UNRELEASED orders for "",LONER"
.S HDR1="!!,""PROVIDER"",?23,""ENTERED BY"",?46,""PATIENT"",?69,""SSN"",?72,""STATUS"",?87,""ORDER #"",?100,""ORDER DATE"",?116,""LAPSE DATE"""
.D HDR^ORLPSR
.S DIV=LONER I $D(^TMP("ORUNS",$J,DIV)) D
..S LOC="" F S LOC=$O(^TMP("ORUNS",$J,DIV,LOC)) Q:LOC=""!STOP W:'SUMONLY ?5,"Location: ",LOC,! D W:'SUMONLY !
...S PROV="" F S PROV=$O(^TMP("ORUNS",$J,DIV,LOC,PROV)) S CNT=0 Q:PROV=""!STOP D
....S IEN="" F S IEN=$O(^TMP("ORUNS",$J,DIV,LOC,PROV,IEN)) S CNT=CNT+1 Q:'IEN!STOP D
.....W:'SUMONLY $P(^(IEN),U,3),?23,$P(^(IEN),U,4),?46,$P(^(IEN),U,5),?69,$P(^(IEN),U,6),?72,$P(^(IEN),U,7),?87,$P(^(IEN),U,8),?100,$P(^(IEN),U,9),?116,$P(^(IEN),U,10),! D:$Y>(IOSL-4) HDR^ORLPSR Q:STOP
.....S ^TMP("ORSTATS",$J,DIV,LOC,PROV)=CNT
.I '$D(^TMP("ORUNS",$J,DIV)) W !!,"No lapsed orders found for "_LONER
SERV ;loops thru the TMP global for output sort by service
I SORT=1&('$D(LONER)) D
.I TYPE=1 S HDR="!!?30,""List of RELEASED but UNSIGNED orders by SERVICE/SECTION"""
.I TYPE=2 S HDR="!!?30,""List of LAPSED orders by SERVICE/SECTION"""
.I TYPE=3 S HDR="!!?30,""List of UNSIGNED/UNRELEASED orders by SERVICE/SECTION"""
.S HDR1="!!,""PROVIDER"",?23,""ENTERED BY"",?46,""PATIENT"",?71,""SSN"",?77,""STATUS"",?87,""ORDER #"",?104,""ORDER DATE"",?120,""LAPSE DATE"""
.S PAGE=0 D HDR^ORLPSR
.I '$D(^TMP("ORUNS",$J)) W !,"No lapsed orders found" Q
.S SER="" F S SER=$O(^TMP("ORUNS",$J,SER)) Q:SER=""!STOP W:'SUMONLY "Service/Section: ",SER,! D W:'SUMONLY !
..S PROV="" F S PROV=$O(^TMP("ORUNS",$J,SER,PROV)) S CNT=0 Q:PROV=""!STOP D
...S IEN=0 F S IEN=$O(^TMP("ORUNS",$J,SER,PROV,IEN)) S CNT=CNT+1 Q:'IEN!STOP D
....W:'SUMONLY $P(^TMP("ORUNS",$J,SER,PROV,IEN),U,2),?23,$P(^(IEN),U,3),?46,$P(^(IEN),U,4),?71,$P(^(IEN),U,5),?77,$P(^(IEN),U,6),?87,$P(^(IEN),U,7),?104,$P(^(IEN),U,8),?120,$P(^(IEN),U,9),! D:$Y>(IOSL-4) HDR^ORLPSR Q:STOP
....S ^TMP("ORSTATS",$J,SER,PROV)=CNT
SSERV ;sorts for a single service/section
I SORT=1&($D(LONER)) S LONER="",PAGE=0 F S LONER=$O(LONER(LONER)) Q:LONER=""!STOP D
.I TYPE=1 S HDR="!!?30,""List of RELEASED but UNSIGNED orders for "",LONER"
.I TYPE=2 S HDR="!!?30,""List of LAPSED orders for "",LONER"
.I TYPE=3 S HDR="!!?30,""List of UNSIGNED/UNRELEASED orders for "",LONER"
.S HDR1="!!,""PROVIDER"",?23,""ENTERED BY"",?46,""PATIENT"",?71,""SSN"",?77,""STATUS"",?87,""ORDER #"",?104,""ORDER DATE"",?120,""LAPSE DATE"""
.D HDR^ORLPSR
.S SER=LONER I $D(^TMP("ORUNS",$J,SER)) D
..S PROV="" F S PROV=$O(^TMP("ORUNS",$J,SER,PROV)) S CNT=0 Q:PROV=""!STOP D
...S IEN=0 F S IEN=$O(^TMP("ORUNS",$J,SER,PROV,IEN)) S CNT=CNT+1 Q:'IEN!STOP D
....W:'SUMONLY $P(^(IEN),U,2),?23,$P(^(IEN),U,3),?46,$P(^(IEN),U,4),?71,$P(^(IEN),U,5),?77,$P(^(IEN),U,6),?87,$P(^(IEN),U,7),?104,$P(^(IEN),U,8),?120,$P(^(IEN),U,9),! D:$Y>(IOSL-4) HDR^ORLPSR Q:STOP
....S ^TMP("ORSTATS",$J,SER,PROV)=CNT
.I '$D(^TMP("ORUNS",$J,SER)) W !!,"No lapsed orders found for "_LONER
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORLPSRB 6688 printed Apr 09, 2024@21:33:22 Page 2
ORLPSRB ;SLC/RAF - Continuation of ORLPSRA ; 3/31/08 6:23am
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**243**;Dec 17, 1997;Build 242
+2 ;
WHO ;loops thru the TMP global for output sort by entering person
+1 IF SORT=5&('$DATA(LONER))
Begin DoDot:1
+2 IF TYPE=1
SET HDR="!!?30,""List of RELEASED but UNSIGNED orders by ENTERING PERSON"""
+3 IF TYPE=2
SET HDR="!!?40,""List of LAPSED orders by ENTERING PERSON"""
+4 IF TYPE=3
SET HDR="!!?30,""List of UNSIGNED/UNRELEASED orders by ENTERING PERSON"""
+5 SET HDR1="!!,""ENTERED BY"",?23,""PROVIDER"",?46,""PATIENT"",?71,""SSN"",?77,""STATUS"",?87,""ORDER #"",?100,""ORDER DATE"",?118,""LAPSE DATE"""
+6 SET PAGE=0
DO HDR^ORLPSR
+7 IF '$DATA(^TMP("ORUNS",$JOB))
WRITE !,"No lapsed orders found"
QUIT
+8 SET WHO=""
FOR
SET WHO=$ORDER(^TMP("ORUNS",$JOB,WHO))
if WHO=""!STOP
QUIT
Begin DoDot:2
+9 SET PNM=""
FOR
SET PNM=$ORDER(^TMP("ORUNS",$JOB,WHO,PNM))
SET CNT=0
if PNM=""!STOP
QUIT
Begin DoDot:3
+10 SET IEN=0
FOR
SET IEN=$ORDER(^TMP("ORUNS",$JOB,WHO,PNM,IEN))
SET CNT=CNT+1
if 'IEN!STOP
QUIT
Begin DoDot:4
+11 IF 'SUMONLY
WRITE $PIECE(^(IEN),U),?23,$PIECE(^(IEN),U,2),?46,$PIECE(^(IEN),U,3),?71,$PIECE(^(IEN),U,4),?77,$PIECE(^(IEN),U,5),?87,$PIECE(^(IEN),U,6),?100,$PIECE(^(IEN),U,7),?118,$PIECE(^(IEN),U,8),!
if $Y>(IOSL-4)
DO HDR^ORLPSR
if STOP
QUIT
+12 SET ^TMP("ORSTATS",$JOB,WHO,PNM)=CNT
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
SWHO ;sorts for a single provider/entering person
+1 IF SORT=5&($DATA(LONER))
SET LONER=""
SET PAGE=0
FOR
SET LONER=$ORDER(LONER(LONER))
if LONER=""!STOP
QUIT
Begin DoDot:1
+2 IF TYPE=1
SET HDR="!!?30,""List of RELEASED but UNSIGNED orders for "",LONER"
+3 IF TYPE=2
SET HDR="!!?30,""List of LAPSED orders for "",LONER"
+4 IF TYPE=3
SET HDR="!!?30,""List of UNSIGNED/UNRELEASED orders for "",LONER"
+5 SET HDR1="!!,""ENTERED BY"",?23,""PROVIDER"",?46,""PATIENT"",?71,""SSN"",?77,""STATUS"",?87,""ORDER #"",?100,""ORDER DATE"",?118,""LAPSE DATE"""
+6 DO HDR^ORLPSR
+7 SET WHO=LONER
IF $DATA(^TMP("ORUNS",$JOB,WHO))
Begin DoDot:2
+8 SET PNM=""
FOR
SET PNM=$ORDER(^TMP("ORUNS",$JOB,WHO,PNM))
SET CNT=0
if PNM=""!STOP
QUIT
Begin DoDot:3
+9 SET IEN=0
FOR
SET IEN=$ORDER(^TMP("ORUNS",$JOB,WHO,PNM,IEN))
SET CNT=CNT+1
if 'IEN!STOP
QUIT
Begin DoDot:4
+10 IF 'SUMONLY
WRITE $PIECE(^(IEN),U),?23,$PIECE(^(IEN),U,2),?46,$PIECE(^(IEN),U,3),?71,$PIECE(^(IEN),U,4),?77,$PIECE(^(IEN),U,5),?87,$PIECE(^(IEN),U,6),?100,$PIECE(^(IEN),U,7),?118,$PIECE(^(IEN),U,8),!
if $Y>(IOSL-4)
DO HDR^ORLPSR
if STOP
QUIT
+11 SET ^TMP("ORSTATS",$JOB,WHO,PNM)=CNT
End DoDot:4
End DoDot:3
End DoDot:2
+12 IF '$DATA(^TMP("ORUNS",$JOB,WHO))
WRITE !!,"No lapsed orders found for "_LONER
End DoDot:1
DIV ;loops thru the TMP global for output sort by division
+1 IF SORT=6&('$DATA(LONER))
Begin DoDot:1
+2 IF TYPE=1
SET HDR="!!?30,""List of RELEASED but UNSIGNED orders by DIVISION"""
+3 IF TYPE=2
SET HDR="!!?30,""List of LAPSED orders by DIVISION"""
+4 IF TYPE=3
SET HDR="!!?30,""List of UNSIGNED/UNRELEASED orders by DIVISION"""
+5 SET HDR1="!!?15,""ENTERED BY"",?40,""PATIENT"",?65,""SSN"",?71,""STATUS"",?90,""ORDER #"",?102,""ORDER DATE"",?118,""LAPSE DATE"""
+6 SET PAGE=0
DO HDR^ORLPSR
+7 IF '$DATA(^TMP("ORUNS",$JOB))
WRITE !,"No lapsed orders found"
QUIT
+8 SET DIV=""
FOR
SET DIV=$ORDER(^TMP("ORUNS",$JOB,DIV))
if DIV=""!STOP
QUIT
if 'SUMONLY
WRITE "Division: ",DIV
Begin DoDot:2
+9 SET LOC=""
FOR
SET LOC=$ORDER(^TMP("ORUNS",$JOB,DIV,LOC))
if LOC=""!STOP
QUIT
if 'SUMONLY
WRITE !?5,"Location: ",LOC
Begin DoDot:3
+10 SET PROV=""
FOR
SET PROV=$ORDER(^TMP("ORUNS",$JOB,DIV,LOC,PROV))
if PROV=""!STOP
QUIT
if 'SUMONLY
WRITE !?10,"Provider: ",PROV,!
SET CNT=0
Begin DoDot:4
+11 SET IEN=0
FOR
SET IEN=$ORDER(^TMP("ORUNS",$JOB,DIV,LOC,PROV,IEN))
SET CNT=CNT+1
if 'IEN!STOP
QUIT
Begin DoDot:5
+12 if 'SUMONLY
WRITE ?15,$SELECT(PROV'=$PIECE(^TMP("ORUNS",$JOB,DIV,LOC,PROV,IEN),U,4):$PIECE(^(IEN),U,4),1:""),?40,$PIECE(^(IEN),U,5),?65,$PIECE(^(IEN),U,6),?71,$PIECE(^(IEN),U,7),?90,$PIECE(^(IEN),U,8),?102,$PIECE
(^(IEN),U,9),?118,$PIECE(^(IEN),U,10),!
if $Y>(IOSL-4)
DO HDR^ORLPSR
if STOP
QUIT
+13 SET ^TMP("ORSTATS",$JOB,DIV,LOC,PROV)=CNT
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
SDIV ;sorts for a single division
+1 IF SORT=6&($DATA(LONER))
SET LONER=""
SET PAGE=0
FOR
SET LONER=$ORDER(LONER(LONER))
if LONER=""!STOP
QUIT
Begin DoDot:1
+2 IF TYPE=1
SET HDR="!!?30,""List of RELEASED but UNSIGNED orders for "",LONER"
+3 IF TYPE=2
SET HDR="!!?30,""List of LAPSED orders for "",LONER"
+4 IF TYPE=3
SET HDR="!!?30,""List of UNSIGNED/UNRELEASED orders for "",LONER"
+5 SET HDR1="!!,""PROVIDER"",?23,""ENTERED BY"",?46,""PATIENT"",?69,""SSN"",?72,""STATUS"",?87,""ORDER #"",?100,""ORDER DATE"",?116,""LAPSE DATE"""
+6 DO HDR^ORLPSR
+7 SET DIV=LONER
IF $DATA(^TMP("ORUNS",$JOB,DIV))
Begin DoDot:2
+8 SET LOC=""
FOR
SET LOC=$ORDER(^TMP("ORUNS",$JOB,DIV,LOC))
if LOC=""!STOP
QUIT
if 'SUMONLY
WRITE ?5,"Location: ",LOC,!
Begin DoDot:3
+9 SET PROV=""
FOR
SET PROV=$ORDER(^TMP("ORUNS",$JOB,DIV,LOC,PROV))
SET CNT=0
if PROV=""!STOP
QUIT
Begin DoDot:4
+10 SET IEN=""
FOR
SET IEN=$ORDER(^TMP("ORUNS",$JOB,DIV,LOC,PROV,IEN))
SET CNT=CNT+1
if 'IEN!STOP
QUIT
Begin DoDot:5
+11 if 'SUMONLY
WRITE $PIECE(^(IEN),U,3),?23,$PIECE(^(IEN),U,4),?46,$PIECE(^(IEN),U,5),?69,$PIECE(^(IEN),U,6),?72,$PIECE(^(IEN),U,7),?87,$PIECE(^(IEN),U,8),?100,$PIECE(^(IEN),U,9),?116,$PIECE(^(IEN),U,10),!
if $Y>(IOSL-4)
DO HDR^ORLPSR
if STOP
QUIT
+12 SET ^TMP("ORSTATS",$JOB,DIV,LOC,PROV)=CNT
End DoDot:5
End DoDot:4
End DoDot:3
if 'SUMONLY
WRITE !
End DoDot:2
+13 IF '$DATA(^TMP("ORUNS",$JOB,DIV))
WRITE !!,"No lapsed orders found for "_LONER
End DoDot:1
SERV ;loops thru the TMP global for output sort by service
+1 IF SORT=1&('$DATA(LONER))
Begin DoDot:1
+2 IF TYPE=1
SET HDR="!!?30,""List of RELEASED but UNSIGNED orders by SERVICE/SECTION"""
+3 IF TYPE=2
SET HDR="!!?30,""List of LAPSED orders by SERVICE/SECTION"""
+4 IF TYPE=3
SET HDR="!!?30,""List of UNSIGNED/UNRELEASED orders by SERVICE/SECTION"""
+5 SET HDR1="!!,""PROVIDER"",?23,""ENTERED BY"",?46,""PATIENT"",?71,""SSN"",?77,""STATUS"",?87,""ORDER #"",?104,""ORDER DATE"",?120,""LAPSE DATE"""
+6 SET PAGE=0
DO HDR^ORLPSR
+7 IF '$DATA(^TMP("ORUNS",$JOB))
WRITE !,"No lapsed orders found"
QUIT
+8 SET SER=""
FOR
SET SER=$ORDER(^TMP("ORUNS",$JOB,SER))
if SER=""!STOP
QUIT
if 'SUMONLY
WRITE "Service/Section: ",SER,!
Begin DoDot:2
+9 SET PROV=""
FOR
SET PROV=$ORDER(^TMP("ORUNS",$JOB,SER,PROV))
SET CNT=0
if PROV=""!STOP
QUIT
Begin DoDot:3
+10 SET IEN=0
FOR
SET IEN=$ORDER(^TMP("ORUNS",$JOB,SER,PROV,IEN))
SET CNT=CNT+1
if 'IEN!STOP
QUIT
Begin DoDot:4
+11 if 'SUMONLY
WRITE $PIECE(^TMP("ORUNS",$JOB,SER,PROV,IEN),U,2),?23,$PIECE(^(IEN),U,3),?46,$PIECE(^(IEN),U,4),?71,$PIECE(^(IEN),U,5),?77,$PIECE(^(IEN),U,6),?87,$PIECE(^(IEN),U,7),?104,$PIECE(^(IEN),U,8),?120,$PIECE(^(IEN),
U,9),!
if $Y>(IOSL-4)
DO HDR^ORLPSR
if STOP
QUIT
+12 SET ^TMP("ORSTATS",$JOB,SER,PROV)=CNT
End DoDot:4
End DoDot:3
End DoDot:2
if 'SUMONLY
WRITE !
End DoDot:1
SSERV ;sorts for a single service/section
+1 IF SORT=1&($DATA(LONER))
SET LONER=""
SET PAGE=0
FOR
SET LONER=$ORDER(LONER(LONER))
if LONER=""!STOP
QUIT
Begin DoDot:1
+2 IF TYPE=1
SET HDR="!!?30,""List of RELEASED but UNSIGNED orders for "",LONER"
+3 IF TYPE=2
SET HDR="!!?30,""List of LAPSED orders for "",LONER"
+4 IF TYPE=3
SET HDR="!!?30,""List of UNSIGNED/UNRELEASED orders for "",LONER"
+5 SET HDR1="!!,""PROVIDER"",?23,""ENTERED BY"",?46,""PATIENT"",?71,""SSN"",?77,""STATUS"",?87,""ORDER #"",?104,""ORDER DATE"",?120,""LAPSE DATE"""
+6 DO HDR^ORLPSR
+7 SET SER=LONER
IF $DATA(^TMP("ORUNS",$JOB,SER))
Begin DoDot:2
+8 SET PROV=""
FOR
SET PROV=$ORDER(^TMP("ORUNS",$JOB,SER,PROV))
SET CNT=0
if PROV=""!STOP
QUIT
Begin DoDot:3
+9 SET IEN=0
FOR
SET IEN=$ORDER(^TMP("ORUNS",$JOB,SER,PROV,IEN))
SET CNT=CNT+1
if 'IEN!STOP
QUIT
Begin DoDot:4
+10 if 'SUMONLY
WRITE $PIECE(^(IEN),U,2),?23,$PIECE(^(IEN),U,3),?46,$PIECE(^(IEN),U,4),?71,$PIECE(^(IEN),U,5),?77,$PIECE(^(IEN),U,6),?87,$PIECE(^(IEN),U,7),?104,$PIECE(^(IEN),U,8),?120,$PIECE(^(IEN),U,9),!
if $Y>(IOSL-4)
DO HDR^ORLPSR
if STOP
QUIT
+11 SET ^TMP("ORSTATS",$JOB,SER,PROV)=CNT
End DoDot:4
End DoDot:3
End DoDot:2
+12 IF '$DATA(^TMP("ORUNS",$JOB,SER))
WRITE !!,"No lapsed orders found for "_LONER
End DoDot:1
+13 QUIT
