- ORLPSRA ;SLC/RAF - Continuation of ORLPSR ; 3/31/08 6:24am
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**243**;Dec 17, 1997;Build 242
- ;
- LOOP ;called from ORLPSR
- ;goes thru the "ALPS" xref in 100 for order dates - called from ORLPSR
- S RPDT="""Report Date: "",$$FMTE^XLFDT($$NOW^XLFDT),"" Sort Range From: "",SDT,"" To: "",EDT",STOP=0
- S PAT="" F S PAT=$O(^OR(100,"ALPS",PAT)) Q:'PAT!STOP D
- .Q:$P(^DPT(+PAT,0),U,21) ;Quit if test patient
- .S DATE=0 F S DATE=$O(^OR(100,"ALPS",PAT,DATE)) Q:'DATE!STOP I DATE>SDATE,DATE<EDATE D
- ..S IEN=0 F S IEN=$O(^OR(100,"ALPS",PAT,DATE,IEN)) Q:'IEN!STOP D
- ...S SUB=0 F S SUB=$O(^OR(100,"ALPS",PAT,DATE,IEN,SUB)) Q:'SUB!STOP D
- ....I $D(^OR(100,IEN,8,SUB,0)) D
- .....;W !,DATE
- .....;I TYPE=1 Q:+$P(^(0),U,15)=11
- .....;I TYPE=3 Q:+$P(^(0),U,15)'=11
- .....N LTYPE S LTYPE=$G(^OR(100,"ALPS",PAT,DATE,IEN,SUB))
- .....I LTYPE="DELAYED ORDER" S LTYPE="DO"
- .....N LDATE S LDATE=""
- .....S (LOC,DIV)="**DELAYED ORDER/NOT ENTERED" ;Reset values as delayed orders may not have these values yet
- .....I $D(^VA(200,+$P(^OR(100,IEN,8,SUB,0),U,3),0)) S PROV=$$USER^ORLPSR(+$P(^OR(100,IEN,8,SUB,0),U,3))
- .....I $D(^VA(200,+$P(^OR(100,IEN,8,SUB,0),U,3),5)),$L($P(^(5),U)) S SER=$$SER^ORLPSR(+$P(^VA(200,+$P(^OR(100,IEN,8,SUB,0),U,3),5),U))
- .....E S SER="MISSING from file 200"
- .....I $D(^VA(200,+$P(^OR(100,IEN,8,SUB,0),U,13))) S WHO=$$USER^ORLPSR(+$P(^OR(100,IEN,8,SUB,0),U,13))
- .....I $G(^OR(100,IEN,6)) I $P(^(6),U)=9&($P(^(6),U,5)="AUTO DC") S WHO=$$USER^ORLPSR(+$P(^OR(100,IEN,8,1,0),U,13)) ;If DCd nature is auto and text is auto dc set entered by to original entry person
- .....S DFN=+$P(^OR(100,IEN,0),U,2) D DEM^VADPT S SSN=VA("BID"),PNM=$E(VADM(1),1,24)
- .....I $D(^OR(100,IEN,3)),$P(^(3),U,3) S STATUS=$$STAT^ORLPSR(+$P(^(3),U,3))
- .....I $D(^OR(100,IEN,0)),$P(^(0),U,10) S LOC=$$LOC^ORLPSR(+$P(^(0),U,10))
- .....I $D(^OR(100,IEN,0)),$P(^(0),U,10) S DIV=$$DIV^ORLPSR(+$P(^(0),U,10))
- .....I $D(^OR(100,IEN,8,SUB,0)),$P(^(0),U) S WHEN=$$FMTE^XLFDT($P($P(^(0),U),"."))
- .....I $D(^OR(100,IEN,10)),$P(^(10),U) S LDATE=$$FMTE^XLFDT($P($P(^(10),U),"."))
- .....I $L(LTYPE) S STATUS=STATUS_"("_LTYPE_")"
- .....I SORT=1 S ^TMP("ORUNS",$J,SER,PROV,IEN)=SER_U_PROV_U_WHO_U_PNM_U_SSN_U_STATUS_U_IEN_U_WHEN_U_LDATE
- .....I SORT=2 S ^TMP("ORUNS",$J,PROV,PNM,IEN)=PROV_U_WHO_U_PNM_U_SSN_U_STATUS_U_IEN_U_WHEN_U_LDATE
- .....I SORT=3 S ^TMP("ORUNS",$J,PNM,PROV,IEN)=PNM_U_SSN_U_PROV_U_WHO_U_STATUS_U_IEN_U_WHEN_U_LDATE
- .....I SORT=4 S ^TMP("ORUNS",$J,LOC,PROV,IEN)=LOC_U_PROV_U_WHO_U_PNM_U_SSN_U_STATUS_U_IEN_U_WHEN_U_LDATE
- .....I SORT=5 S ^TMP("ORUNS",$J,WHO,PNM,IEN)=WHO_U_PROV_U_PNM_U_SSN_U_STATUS_U_IEN_U_WHEN_U_LDATE
- .....I SORT=6 S ^TMP("ORUNS",$J,DIV,LOC,PROV,IEN)=DIV_U_LOC_U_PROV_U_WHO_U_PNM_U_SSN_U_STATUS_U_IEN_U_WHEN_U_LDATE
- PROV ;loops thru the TMP global for output sort by provider
- I SORT=2&('$D(LONER)) D
- .I TYPE=1 S HDR="!!?30,""List of RELEASED but UNSIGNED orders by PROVIDER"""
- .I TYPE=2 S HDR="!!?40,""List of LAPSED orders by PROVIDER"""
- .I TYPE=3 S HDR="!!?30,""List of UNSIGNED/UNRELEASED orders by PROVIDER"""
- .S HDR1="!!,""PROVIDER"",?25,""ENTERED BY"",?50,""PATIENT"",?75,""SSN"",?81,""STATUS"",?91,""ORDER #"",?104,""ORDER DATE"",?118,""LAPSE DATE"""
- .S PAGE=0 D HDR^ORLPSR
- .I '$D(^TMP("ORUNS",$J)) W !,"No lapsed orders found" Q
- .S PROV="" F S PROV=$O(^TMP("ORUNS",$J,PROV)) Q:PROV=""!STOP D
- ..S PNM="" F S PNM=$O(^TMP("ORUNS",$J,PROV,PNM)) S CNT=0 Q:PNM=""!STOP D
- ...S IEN=0 F S IEN=$O(^TMP("ORUNS",$J,PROV,PNM,IEN)) S CNT=CNT+1 Q:'IEN!STOP D
- ....I 'SUMONLY W $P(^(IEN),U),?25,$P(^(IEN),U,2),?50,$P(^(IEN),U,3),?75,$P(^(IEN),U,4),?81,$P(^(IEN),U,5),?91,$P(^(IEN),U,6),?104,$P(^(IEN),U,7),?118,$P(^(IEN),U,8),! D:$Y>(IOSL-4) HDR^ORLPSR Q:STOP
- ....S ^TMP("ORSTATS",$J,PROV,PNM)=CNT
- SPROV ;sorts for a single provider
- I SORT=2&($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"",?25,""ENTERED BY"",?50,""PATIENT"",?75,""SSN"",?81,""STATUS"",?91,""ORDER #"",?104,""ORDER DATE"",?118,""LAPSE DATE"""
- .D HDR^ORLPSR
- .S PROV=LONER I $D(^TMP("ORUNS",$J,PROV)) D
- ..S PNM="" F S PNM=$O(^TMP("ORUNS",$J,PROV,PNM)) S CNT=0 Q:PNM=""!STOP D
- ...S IEN=0 F S IEN=$O(^TMP("ORUNS",$J,PROV,PNM,IEN)) S CNT=CNT+1 Q:'IEN!STOP D
- ....I 'SUMONLY W $P(^(IEN),U),?25,$P(^(IEN),U,2),?50,$P(^(IEN),U,3),?75,$P(^(IEN),U,4),?81,$P(^(IEN),U,5),?91,$P(^(IEN),U,6),?104,$P(^(IEN),U,7),?118,$P(^(IEN),U,8),! D:$Y>(IOSL-4) HDR^ORLPSR Q:STOP
- ....S ^TMP("ORSTATS",$J,PROV,PNM)=CNT
- .I '$D(^TMP("ORUNS",$J,PROV)) W !!,"No lapsed orders found for "_LONER
- PAT ;loops thru the TMP global for output sort by patient
- I SORT=3&('$D(LONER)) D
- .I TYPE=1 S HDR="!!?30,""List of RELEASED but UNSIGNED orders by PATIENT"""
- .I TYPE=2 S HDR="!!?40,""List of LAPSED orders by PATIENT"""
- .I TYPE=3 S HDR="!!?30,""List of UNSIGNED/UNRELEASED orders by PATIENT"""
- .S HDR1="!!,""PATIENT"",?25,""SSN"",?30,""PROVIDER"",?55,""ENTERED BY"",?81,""STATUS"",?91,""ORDER #"",?104,""ORDER DATE"",?118,""LAPSE DATE"""
- .S PAGE=0 D HDR^ORLPSR
- .I '$D(^TMP("ORUNS",$J)) W !,"No lapsed orders found" Q
- .S PNM="" F S PNM=$O(^TMP("ORUNS",$J,PNM)) Q:PNM=""!STOP D
- ..S PROV="" F S PROV=$O(^TMP("ORUNS",$J,PNM,PROV)) S CNT=0 Q:PROV=""!STOP D
- ...S IEN=0 F S IEN=$O(^TMP("ORUNS",$J,PNM,PROV,IEN)) S CNT=CNT+1 Q:'IEN!STOP D
- ....I 'SUMONLY W $P(^(IEN),U),?25,$P(^(IEN),U,2),?30,$P(^(IEN),U,3),?55,$P(^(IEN),U,4),?81,$P(^(IEN),U,5),?91,$P(^(IEN),U,6),?104,$P(^(IEN),U,7),?118,$P(^(IEN),U,8),! D:$Y>(IOSL-4) HDR^ORLPSR Q:STOP
- ....S ^TMP("ORSTATS",$J,PNM,PROV)=CNT
- ....;I $E(IOST)="E",$Y>(IOSL-105) W @IOF,@HDR
- SPAT ;sorts for a single patient
- I SORT=3&($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="!!,""PATIENT"",?25,""SSN"",?30,""PROVIDER"",?55,""ENTERED BY"",?81,""STATUS"",?91,""ORDER #"",?104,""ORDER DATE"",?118,""LAPSE DATE"""
- .D HDR^ORLPSR
- .S PNM=LONER I $D(^TMP("ORUNS",$J,PNM)) D
- ..S PROV="" F S PROV=$O(^TMP("ORUNS",$J,PNM,PROV)) S CNT=0 Q:PROV=""!STOP D
- ...S IEN=0 F S IEN=$O(^TMP("ORUNS",$J,PNM,PROV,IEN)) S CNT=CNT+1 Q:'IEN!STOP D
- ....I 'SUMONLY W $P(^(IEN),U),?25,$P(^(IEN),U,2),?30,$P(^(IEN),U,3),?55,$P(^(IEN),U,4),?81,$P(^(IEN),U,5),?91,$P(^(IEN),U,6),?104,$P(^(IEN),U,7),?118,$P(^(IEN),U,8),! D:$Y>(IOSL-4) HDR^ORLPSR Q:STOP
- ....S ^TMP("ORSTATS",$J,PNM,PROV)=CNT
- .I '$D(^TMP("ORUNS",$J,PNM)) W !!,"No lapsed orders found for "_LONER
- WARD ;loops thru the TMP global for output sort by location
- I SORT=4&('$D(LONER)) D
- .I TYPE=1 S HDR="!!?30,""List of RELEASED but UNSIGNED orders by LOCATION"""
- .I TYPE=2 S HDR="!!?30,""List of LAPSED orders by LOCATION"""
- .I TYPE=3 S HDR="!!?30,""List of UNSIGNED/UNRELEASED orders by LOCATION"""
- .S HDR1="!!,""PROVIDER"",?25,""ENTERED BY"",?50,""PATIENT"",?75,""SSN"",?81,""STATUS"",?91,""ORDER #"",?104,""ORDER DATE"",?118,""LAPSE DATE"""
- .S PAGE=0 D HDR^ORLPSR
- .I '$D(^TMP("ORUNS",$J)) W !,"No lapsed orders found" Q
- .S LOC="" F S LOC=$O(^TMP("ORUNS",$J,LOC)) Q:LOC=""!STOP W:'SUMONLY "Location: ",LOC,! D
- ..S PROV="" F S PROV=$O(^TMP("ORUNS",$J,LOC,PROV)) S CNT=0 Q:PROV=""!STOP D
- ...S IEN=0 F S IEN=$O(^TMP("ORUNS",$J,LOC,PROV,IEN)) S CNT=CNT+1 Q:'IEN!STOP D
- ....I 'SUMONLY W $P(^TMP("ORUNS",$J,LOC,PROV,IEN),U,2),?25,$P(^(IEN),U,3),?50,$P(^(IEN),U,4),?75,$P(^(IEN),U,5),?81,$P(^(IEN),U,6),?91,$P(^(IEN),U,7),?104,$P(^(IEN),U,8),?118,$P(^(IEN),U,9),! D:$Y>(IOSL-4) HDR^ORLPSR Q:STOP
- ....S ^TMP("ORSTATS",$J,LOC,PROV)=CNT
- ..W !
- ;
- SWARD ;sorts for a single location
- I SORT=4&($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"",?25,""ENTERED BY"",?50,""PATIENT"",?75,""SSN"",?81,""STATUS"",?91,""ORDER #"",?104,""ORDER DATE"",?118,""LAPSE DATE"""
- .D HDR^ORLPSR
- .S LOC=LONER I $D(^TMP("ORUNS",$J,LOC)) D
- ..S PROV="" F S PROV=$O(^TMP("ORUNS",$J,LOC,PROV)) S CNT=0 Q:PROV=""!STOP D
- ...S IEN=0 F S IEN=$O(^TMP("ORUNS",$J,LOC,PROV,IEN)) S CNT=CNT+1 Q:'IEN!STOP D
- ....I 'SUMONLY W $P(^TMP("ORUNS",$J,LOC,PROV,IEN),U,2),?25,$P(^(IEN),U,3),?50,$P(^(IEN),U,4),?75,$P(^(IEN),U,5),?81,$P(^(IEN),U,6),?91,$P(^(IEN),U,7),?104,$P(^(IEN),U,8),?118,$P(^(IEN),U,9),! D:$Y>(IOSL-4) HDR^ORLPSR Q:STOP
- ....S ^TMP("ORSTATS",$J,LOC,PROV)=CNT
- .I '$D(^TMP("ORUNS",$J,LOC)) W !!,"No lapsed orders found for "_LONER
- I SORT=1 D SERV^ORLPSRB
- I SORT=5 D WHO^ORLPSRB
- I SORT=6 D DIV^ORLPSRB
- I 'STOP D STATS^ORLPSR
- EXIT K ^TMP("ORUNS",$J),^TMP("ORSTATS",$J)
- D ^%ZISC
- Q
- ORLPSRA ;SLC/RAF - Continuation of ORLPSR ; 3/31/08 6:24am
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**243**;Dec 17, 1997;Build 242
- +2 ;
- LOOP ;called from ORLPSR
- +1 ;goes thru the "ALPS" xref in 100 for order dates - called from ORLPSR
- +2 SET RPDT="""Report Date: "",$$FMTE^XLFDT($$NOW^XLFDT),"" Sort Range From: "",SDT,"" To: "",EDT"
- SET STOP=0
- +3 SET PAT=""
- FOR
- SET PAT=$ORDER(^OR(100,"ALPS",PAT))
- IF 'PAT!STOP
- QUIT
- Begin DoDot:1
- +4 ;Quit if test patient
- IF $PIECE(^DPT(+PAT,0),U,21)
- QUIT
- +5 SET DATE=0
- FOR
- SET DATE=$ORDER(^OR(100,"ALPS",PAT,DATE))
- IF 'DATE!STOP
- QUIT
- IF DATE>SDATE
- IF DATE<EDATE
- Begin DoDot:2
- +6 SET IEN=0
- FOR
- SET IEN=$ORDER(^OR(100,"ALPS",PAT,DATE,IEN))
- IF 'IEN!STOP
- QUIT
- Begin DoDot:3
- +7 SET SUB=0
- FOR
- SET SUB=$ORDER(^OR(100,"ALPS",PAT,DATE,IEN,SUB))
- IF 'SUB!STOP
- QUIT
- Begin DoDot:4
- +8 IF $DATA(^OR(100,IEN,8,SUB,0))
- Begin DoDot:5
- +9 ;W !,DATE
- +10 ;I TYPE=1 Q:+$P(^(0),U,15)=11
- +11 ;I TYPE=3 Q:+$P(^(0),U,15)'=11
- +12 NEW LTYPE
- SET LTYPE=$GET(^OR(100,"ALPS",PAT,DATE,IEN,SUB))
- +13 IF LTYPE="DELAYED ORDER"
- SET LTYPE="DO"
- +14 NEW LDATE
- SET LDATE=""
- +15 ;Reset values as delayed orders may not have these values yet
- SET (LOC,DIV)="**DELAYED ORDER/NOT ENTERED"
- +16 IF $DATA(^VA(200,+$PIECE(^OR(100,IEN,8,SUB,0),U,3),0))
- SET PROV=$$USER^ORLPSR(+$PIECE(^OR(100,IEN,8,SUB,0),U,3))
- +17 IF $DATA(^VA(200,+$PIECE(^OR(100,IEN,8,SUB,0),U,3),5))
- IF $LENGTH($PIECE(^(5),U))
- SET SER=$$SER^ORLPSR(+$PIECE(^VA(200,+$PIECE(^OR(100,IEN,8,SUB,0),U,3),5),U))
- +18 IF '$TEST
- SET SER="MISSING from file 200"
- +19 IF $DATA(^VA(200,+$PIECE(^OR(100,IEN,8,SUB,0),U,13)))
- SET WHO=$$USER^ORLPSR(+$PIECE(^OR(100,IEN,8,SUB,0),U,13))
- +20 ;If DCd nature is auto and text is auto dc set entered by to original entry person
- IF $GET(^OR(100,IEN,6))
- IF $PIECE(^(6),U)=9&($PIECE(^(6),U,5)="AUTO DC")
- SET WHO=$$USER^ORLPSR(+$PIECE(^OR(100,IEN,8,1,0),U,13))
- +21 SET DFN=+$PIECE(^OR(100,IEN,0),U,2)
- DO DEM^VADPT
- SET SSN=VA("BID")
- SET PNM=$EXTRACT(VADM(1),1,24)
- +22 IF $DATA(^OR(100,IEN,3))
- IF $PIECE(^(3),U,3)
- SET STATUS=$$STAT^ORLPSR(+$PIECE(^(3),U,3))
- +23 IF $DATA(^OR(100,IEN,0))
- IF $PIECE(^(0),U,10)
- SET LOC=$$LOC^ORLPSR(+$PIECE(^(0),U,10))
- +24 IF $DATA(^OR(100,IEN,0))
- IF $PIECE(^(0),U,10)
- SET DIV=$$DIV^ORLPSR(+$PIECE(^(0),U,10))
- +25 IF $DATA(^OR(100,IEN,8,SUB,0))
- IF $PIECE(^(0),U)
- SET WHEN=$$FMTE^XLFDT($PIECE($PIECE(^(0),U),"."))
- +26 IF $DATA(^OR(100,IEN,10))
- IF $PIECE(^(10),U)
- SET LDATE=$$FMTE^XLFDT($PIECE($PIECE(^(10),U),"."))
- +27 IF $LENGTH(LTYPE)
- SET STATUS=STATUS_"("_LTYPE_")"
- +28 IF SORT=1
- SET ^TMP("ORUNS",$JOB,SER,PROV,IEN)=SER_U_PROV_U_WHO_U_PNM_U_SSN_U_STATUS_U_IEN_U_WHEN_U_LDATE
- +29 IF SORT=2
- SET ^TMP("ORUNS",$JOB,PROV,PNM,IEN)=PROV_U_WHO_U_PNM_U_SSN_U_STATUS_U_IEN_U_WHEN_U_LDATE
- +30 IF SORT=3
- SET ^TMP("ORUNS",$JOB,PNM,PROV,IEN)=PNM_U_SSN_U_PROV_U_WHO_U_STATUS_U_IEN_U_WHEN_U_LDATE
- +31 IF SORT=4
- SET ^TMP("ORUNS",$JOB,LOC,PROV,IEN)=LOC_U_PROV_U_WHO_U_PNM_U_SSN_U_STATUS_U_IEN_U_WHEN_U_LDATE
- +32 IF SORT=5
- SET ^TMP("ORUNS",$JOB,WHO,PNM,IEN)=WHO_U_PROV_U_PNM_U_SSN_U_STATUS_U_IEN_U_WHEN_U_LDATE
- +33 IF SORT=6
- SET ^TMP("ORUNS",$JOB,DIV,LOC,PROV,IEN)=DIV_U_LOC_U_PROV_U_WHO_U_PNM_U_SSN_U_STATUS_U_IEN_U_WHEN_U_LDATE
- End DoDot:5
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- PROV ;loops thru the TMP global for output sort by provider
- +1 IF SORT=2&('$DATA(LONER))
- Begin DoDot:1
- +2 IF TYPE=1
- SET HDR="!!?30,""List of RELEASED but UNSIGNED orders by PROVIDER"""
- +3 IF TYPE=2
- SET HDR="!!?40,""List of LAPSED orders by PROVIDER"""
- +4 IF TYPE=3
- SET HDR="!!?30,""List of UNSIGNED/UNRELEASED orders by PROVIDER"""
- +5 SET HDR1="!!,""PROVIDER"",?25,""ENTERED BY"",?50,""PATIENT"",?75,""SSN"",?81,""STATUS"",?91,""ORDER #"",?104,""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 PROV=""
- FOR
- SET PROV=$ORDER(^TMP("ORUNS",$JOB,PROV))
- IF PROV=""!STOP
- QUIT
- Begin DoDot:2
- +9 SET PNM=""
- FOR
- SET PNM=$ORDER(^TMP("ORUNS",$JOB,PROV,PNM))
- SET CNT=0
- IF PNM=""!STOP
- QUIT
- Begin DoDot:3
- +10 SET IEN=0
- FOR
- SET IEN=$ORDER(^TMP("ORUNS",$JOB,PROV,PNM,IEN))
- SET CNT=CNT+1
- IF 'IEN!STOP
- QUIT
- Begin DoDot:4
- +11 IF 'SUMONLY
- WRITE $PIECE(^(IEN),U),?25,$PIECE(^(IEN),U,2),?50,$PIECE(^(IEN),U,3),?75,$PIECE(^(IEN),U,4),?81,$PIECE(^(IEN),U,5),?91,$PIECE(^(IEN),U,6),?104,$PIECE(^(IEN),U,7),?118,$PIECE(^(IEN),U,8),!
- IF $Y>(IOSL-4)
- DO HDR^ORLPSR
- IF STOP
- QUIT
- +12 SET ^TMP("ORSTATS",$JOB,PROV,PNM)=CNT
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- SPROV ;sorts for a single provider
- +1 IF SORT=2&($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"",?25,""ENTERED BY"",?50,""PATIENT"",?75,""SSN"",?81,""STATUS"",?91,""ORDER #"",?104,""ORDER DATE"",?118,""LAPSE DATE"""
- +6 DO HDR^ORLPSR
- +7 SET PROV=LONER
- IF $DATA(^TMP("ORUNS",$JOB,PROV))
- Begin DoDot:2
- +8 SET PNM=""
- FOR
- SET PNM=$ORDER(^TMP("ORUNS",$JOB,PROV,PNM))
- SET CNT=0
- IF PNM=""!STOP
- QUIT
- Begin DoDot:3
- +9 SET IEN=0
- FOR
- SET IEN=$ORDER(^TMP("ORUNS",$JOB,PROV,PNM,IEN))
- SET CNT=CNT+1
- IF 'IEN!STOP
- QUIT
- Begin DoDot:4
- +10 IF 'SUMONLY
- WRITE $PIECE(^(IEN),U),?25,$PIECE(^(IEN),U,2),?50,$PIECE(^(IEN),U,3),?75,$PIECE(^(IEN),U,4),?81,$PIECE(^(IEN),U,5),?91,$PIECE(^(IEN),U,6),?104,$PIECE(^(IEN),U,7),?118,$PIECE(^(IEN),U,8),!
- IF $Y>(IOSL-4)
- DO HDR^ORLPSR
- IF STOP
- QUIT
- +11 SET ^TMP("ORSTATS",$JOB,PROV,PNM)=CNT
- End DoDot:4
- End DoDot:3
- End DoDot:2
- +12 IF '$DATA(^TMP("ORUNS",$JOB,PROV))
- WRITE !!,"No lapsed orders found for "_LONER
- End DoDot:1
- PAT ;loops thru the TMP global for output sort by patient
- +1 IF SORT=3&('$DATA(LONER))
- Begin DoDot:1
- +2 IF TYPE=1
- SET HDR="!!?30,""List of RELEASED but UNSIGNED orders by PATIENT"""
- +3 IF TYPE=2
- SET HDR="!!?40,""List of LAPSED orders by PATIENT"""
- +4 IF TYPE=3
- SET HDR="!!?30,""List of UNSIGNED/UNRELEASED orders by PATIENT"""
- +5 SET HDR1="!!,""PATIENT"",?25,""SSN"",?30,""PROVIDER"",?55,""ENTERED BY"",?81,""STATUS"",?91,""ORDER #"",?104,""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 PNM=""
- FOR
- SET PNM=$ORDER(^TMP("ORUNS",$JOB,PNM))
- IF PNM=""!STOP
- QUIT
- Begin DoDot:2
- +9 SET PROV=""
- FOR
- SET PROV=$ORDER(^TMP("ORUNS",$JOB,PNM,PROV))
- SET CNT=0
- IF PROV=""!STOP
- QUIT
- Begin DoDot:3
- +10 SET IEN=0
- FOR
- SET IEN=$ORDER(^TMP("ORUNS",$JOB,PNM,PROV,IEN))
- SET CNT=CNT+1
- IF 'IEN!STOP
- QUIT
- Begin DoDot:4
- +11 IF 'SUMONLY
- WRITE $PIECE(^(IEN),U),?25,$PIECE(^(IEN),U,2),?30,$PIECE(^(IEN),U,3),?55,$PIECE(^(IEN),U,4),?81,$PIECE(^(IEN),U,5),?91,$PIECE(^(IEN),U,6),?104,$PIECE(^(IEN),U,7),?118,$PIECE(^(IEN),U,8),!
- IF $Y>(IOSL-4)
- DO HDR^ORLPSR
- IF STOP
- QUIT
- +12 SET ^TMP("ORSTATS",$JOB,PNM,PROV)=CNT
- +13 ;I $E(IOST)="E",$Y>(IOSL-105) W @IOF,@HDR
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- SPAT ;sorts for a single patient
- +1 IF SORT=3&($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="!!,""PATIENT"",?25,""SSN"",?30,""PROVIDER"",?55,""ENTERED BY"",?81,""STATUS"",?91,""ORDER #"",?104,""ORDER DATE"",?118,""LAPSE DATE"""
- +6 DO HDR^ORLPSR
- +7 SET PNM=LONER
- IF $DATA(^TMP("ORUNS",$JOB,PNM))
- Begin DoDot:2
- +8 SET PROV=""
- FOR
- SET PROV=$ORDER(^TMP("ORUNS",$JOB,PNM,PROV))
- SET CNT=0
- IF PROV=""!STOP
- QUIT
- Begin DoDot:3
- +9 SET IEN=0
- FOR
- SET IEN=$ORDER(^TMP("ORUNS",$JOB,PNM,PROV,IEN))
- SET CNT=CNT+1
- IF 'IEN!STOP
- QUIT
- Begin DoDot:4
- +10 IF 'SUMONLY
- WRITE $PIECE(^(IEN),U),?25,$PIECE(^(IEN),U,2),?30,$PIECE(^(IEN),U,3),?55,$PIECE(^(IEN),U,4),?81,$PIECE(^(IEN),U,5),?91,$PIECE(^(IEN),U,6),?104,$PIECE(^(IEN),U,7),?118,$PIECE(^(IEN),U,8),!
- IF $Y>(IOSL-4)
- DO HDR^ORLPSR
- IF STOP
- QUIT
- +11 SET ^TMP("ORSTATS",$JOB,PNM,PROV)=CNT
- End DoDot:4
- End DoDot:3
- End DoDot:2
- +12 IF '$DATA(^TMP("ORUNS",$JOB,PNM))
- WRITE !!,"No lapsed orders found for "_LONER
- End DoDot:1
- WARD ;loops thru the TMP global for output sort by location
- +1 IF SORT=4&('$DATA(LONER))
- Begin DoDot:1
- +2 IF TYPE=1
- SET HDR="!!?30,""List of RELEASED but UNSIGNED orders by LOCATION"""
- +3 IF TYPE=2
- SET HDR="!!?30,""List of LAPSED orders by LOCATION"""
- +4 IF TYPE=3
- SET HDR="!!?30,""List of UNSIGNED/UNRELEASED orders by LOCATION"""
- +5 SET HDR1="!!,""PROVIDER"",?25,""ENTERED BY"",?50,""PATIENT"",?75,""SSN"",?81,""STATUS"",?91,""ORDER #"",?104,""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 LOC=""
- FOR
- SET LOC=$ORDER(^TMP("ORUNS",$JOB,LOC))
- IF LOC=""!STOP
- QUIT
- IF 'SUMONLY
- WRITE "Location: ",LOC,!
- Begin DoDot:2
- +9 SET PROV=""
- FOR
- SET PROV=$ORDER(^TMP("ORUNS",$JOB,LOC,PROV))
- SET CNT=0
- IF PROV=""!STOP
- QUIT
- Begin DoDot:3
- +10 SET IEN=0
- FOR
- SET IEN=$ORDER(^TMP("ORUNS",$JOB,LOC,PROV,IEN))
- SET CNT=CNT+1
- IF 'IEN!STOP
- QUIT
- Begin DoDot:4
- +11 IF 'SUMONLY
- WRITE $PIECE(^TMP("ORUNS",$JOB,LOC,PROV,IEN),U,2),?25,$PIECE(^(IEN),U,3),?50,$PIECE(^(IEN),U,4),?75,$PIECE(^(IEN),U,5),?81,$PIECE(^(IEN),U,6),?91,$PIECE(^(IEN),U,7),?104,$PIECE(^(IEN),U,8),?118,$PIECE(^(IEN),
- U,9),!
- IF $Y>(IOSL-4)
- DO HDR^ORLPSR
- IF STOP
- QUIT
- +12 SET ^TMP("ORSTATS",$JOB,LOC,PROV)=CNT
- End DoDot:4
- End DoDot:3
- +13 WRITE !
- End DoDot:2
- End DoDot:1
- +14 ;
- SWARD ;sorts for a single location
- +1 IF SORT=4&($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"",?25,""ENTERED BY"",?50,""PATIENT"",?75,""SSN"",?81,""STATUS"",?91,""ORDER #"",?104,""ORDER DATE"",?118,""LAPSE DATE"""
- +6 DO HDR^ORLPSR
- +7 SET LOC=LONER
- IF $DATA(^TMP("ORUNS",$JOB,LOC))
- Begin DoDot:2
- +8 SET PROV=""
- FOR
- SET PROV=$ORDER(^TMP("ORUNS",$JOB,LOC,PROV))
- SET CNT=0
- IF PROV=""!STOP
- QUIT
- Begin DoDot:3
- +9 SET IEN=0
- FOR
- SET IEN=$ORDER(^TMP("ORUNS",$JOB,LOC,PROV,IEN))
- SET CNT=CNT+1
- IF 'IEN!STOP
- QUIT
- Begin DoDot:4
- +10 IF 'SUMONLY
- WRITE $PIECE(^TMP("ORUNS",$JOB,LOC,PROV,IEN),U,2),?25,$PIECE(^(IEN),U,3),?50,$PIECE(^(IEN),U,4),?75,$PIECE(^(IEN),U,5),?81,$PIECE(^(IEN),U,6),?91,$PIECE(^(IEN),U,7),?104,$PIECE(^(IEN),U,8),?118,$PIECE(^(I
- EN),U,9),!
- IF $Y>(IOSL-4)
- DO HDR^ORLPSR
- IF STOP
- QUIT
- +11 SET ^TMP("ORSTATS",$JOB,LOC,PROV)=CNT
- End DoDot:4
- End DoDot:3
- End DoDot:2
- +12 IF '$DATA(^TMP("ORUNS",$JOB,LOC))
- WRITE !!,"No lapsed orders found for "_LONER
- End DoDot:1
- +13 IF SORT=1
- DO SERV^ORLPSRB
- +14 IF SORT=5
- DO WHO^ORLPSRB
- +15 IF SORT=6
- DO DIV^ORLPSRB
- +16 IF 'STOP
- DO STATS^ORLPSR
- EXIT KILL ^TMP("ORUNS",$JOB),^TMP("ORSTATS",$JOB)
- +1 DO ^%ZISC
- +2 QUIT
