LRBEBA5 ;DALOI/JAH/FHS - PENDING PANEL ROLLUP TO PCE ;11/26/2005
;;5.2;LAB SERVICE;**291,337**;Sep 27, 1994;Build 2
;
EN ;Entry point from LRNIGHT
;check rollup date
N LRBEROLL,LRBERLDT,DATX,YY,MM,STARTDT,ENDDT,NEWDT,TOTPAN
S LRBEROLL=0,LRBERLDT=$P(^LAB(69.9,1,"VSIT"),U,2)
S YY=$E(LRBERLDT,1,3),MM=+$E(LRBERLDT,4,5)
S MM=$S(MM=1:12,1:MM-1) S YY=$S(MM=12:YY-1,1:YY) I $L(MM)=1 S MM="0"_MM
S STARTDT=YY_MM_"01",ENDDT=YY_MM_"31"_".999999"
S DATX=$O(^LRO(69,"APP",0))
I DATX<STARTDT S STARTDT=DATX-1
I LRBERLDT=DT S LRBEROLL=1
I (LRBERLDT<DT) I DATX<ENDDT S LRBEROLL=1
I LRBEROLL D
.K ^TMP("LRROLLUP",$J)
.S ^TMP("LRROLLUP",$J,0)=$$NOW^XLFDT_"^"
.D START
.D NEWDT
.S ^TMP("LRROLLUP",$J,0)=^TMP("LRROLLUP",$J,0)_$$NOW^XLFDT()
.D MAILRPT
Q
;
START ;Loop thru pending panel xref in file #69
N LINE,LRXDT,LRODT,LRSN,LRTN
S LINE=100,TOTPAN=0
S LRXDT=STARTDT F S LRXDT=$O(^LRO(69,"APP",LRXDT)) Q:'LRXDT Q:LRXDT>ENDDT D
.S LRODT=0 F S LRODT=$O(^LRO(69,"APP",LRXDT,LRODT)) Q:'LRODT D
..S LRSN=0 F S LRSN=$O(^LRO(69,"APP",LRXDT,LRODT,LRSN)) Q:'LRSN D
...S LRTN=0 F S LRTN=$O(^LRO(69,"APP",LRXDT,LRODT,LRSN,LRTN)) Q:'LRTN D
....D SET
....I $D(LRBEY)>1 D BAWRK^LRBEBA(LRODT,LRSN,LRTN,.LRBEY,.LRTEST,"","",LRBEROLL)
....I $D(LRBECPT)>1 D SETRPT
....D CLEAN
Q
;
SET ;Setup background variables for call to BAWRK^LRBEBA
N LRBET,LRBEIEN,LRFDA,I,NX,XX
S LRBEIEN=LRSN_","_LRODT_","
S LRDFN=$$GET1^DIQ(69.01,LRBEIEN,.01,"I")
S LRORDER=$$GET1^DIQ(69.01,LRBEIEN,9.5,"I")
S LRBEIEN=LRTN_","_LRSN_","_LRODT_","
I $$GET1^DIQ(69.03,LRBEIEN,8,"I")="CA" D Q
.;clear 'pending panel' xref of not performed panel
.S LRFDA(1,69.03,LRBEIEN,22.1)=0
.D FILE^DIE("KS","LRFDA(1)","ERR")
S LRBETST=$$GET1^DIQ(69.03,LRBEIEN,.01,"I")
I LRBETST="" K ^LRO(69,"APP",LRXDT,LRODT,LRSN,LRTN) Q
S LRAD=+$$GET1^DIQ(69.03,LRBEIEN,2,"I")
S LRAA=+$$GET1^DIQ(69.03,LRBEIEN,3,"I")
S LRAN=+$$GET1^DIQ(69.03,LRBEIEN,4,"I")
S LRUID=$$GET1^DIQ(69.03,LRBEIEN,13,"I")
S LRBECDT=$$GET1^DIQ(69.03,LRBEIEN,22,"I")
S LRBEDFN=$$GET1^DIQ(63,LRDFN,.03,"I")
S LRSS=$$GET1^DIQ(68,LRAA,.02,"I")
I $G(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRBETST,0))="" K ^LRO(69,"APP",LRXDT,LRODT,LRSN,LRTN) Q
S LRIDT=$P($G(^LRO(68,LRAA,1,LRAD,1,LRAN,3)),U,5)
S I=$O(^LRO(68,LRAA,1,LRAD,1,LRAN,5,0))
I I S X=^LRO(68,LRAA,1,LRAD,1,LRAN,5,I,0),LRSPEC=$P(X,U,1),LRSAMP=$P(X,U,2)
S NX=0 F S NX=$O(^LAB(60,LRBETST,2,NX)) Q:'NX D
.S LRBET=+^LAB(60,LRBETST,2,NX,0)
.S XX=$P($P(^LAB(60,LRBET,0),U,5),";",2)
.;if null XX, possibly another panel
.I 'XX D ARRS(LRBET,LRBETST) Q
.S LRSB(XX)=$G(^LR(LRDFN,LRSS,LRIDT,XX))
.I LRSB(XX)="" K LRSB(XX) Q
.I "pending^canc"[$P(LRSB(XX),U,1) K LRSB(XX) Q
.I $P(LRSB(XX),U,13) K LRSB(XX) Q
.S LRBEY(LRBETST,XX)=""
I $D(LRBEY)>1 D
.S LRTEST(1)=LRBETST_U_^LAB(60,LRBETST,0),LRTEST(1,"P")=LRBETST_U_$$NLT^LRVER1(LRBETST)
Q
;
ARRS(XTEST,PTEST) ;
N NX,X,XX
S NX=0 F S NX=$O(^LAB(60,XTEST,2,NX)) Q:'NX D
.S X=+^LAB(60,XTEST,2,NX,0)
.S XX=$P($P(^LAB(60,X,0),U,5),";",2)
.Q:'XX
.S LRSB(XX)=$G(^LR(LRDFN,LRSS,LRIDT,XX))
.I LRSB(XX)="" K LRSB(XX) Q
.I "pending^canc"[$P(LRSB(XX),U,1) K LRSB(XX) Q
.I $P(LRSB(XX),U,13) K LRSB(XX) Q
.S LRBEY(PTEST,XX)=""
Q
;
CLEAN ;Clean-up variables
K DFN,LRBEY,LRTEST,LRSB,LRBECPT,LRDFN,LRBEDFN,LRORDER
K LRBETST,LRBEVST,LRAA,LRAN,LRAD,LRUID,LRBECDT,LRSS,LRIDT,LRSAMP,LRSPEC
Q
;
SETRPT ;Set veriables into ^TMP( for report
N SETLN,X,C,N,T,TNM,XCODE,LRPCE,LRBETST,LRBETSTN
S TOTPAN=TOTPAN+1
S SETLN="S LINE=LINE+1,^TMP(""LRROLLUP"",$J,LINE,0)=X"
S LRPCE=$P(^LRO(69,LRODT,1,LRSN,"PCE"),U,1)
Q:LRPCE=""
S LRBETST=$P(LRTEST(1),U,1)
S LRBETSTN=$P(^LAB(60,LRBETST,0),U,1),LRBETSTN="["_LRBETST_"] "_$E(LRBETSTN,1,30)
S X=$$SETSTR^VALM1(LRORDER,"",1,10),X=$$SETSTR^VALM1(LRUID,X,12,10)
S X=$$SETSTR^VALM1(LRPCE,X,26,10),X=$$SETSTR^VALM1(LRBETSTN,X,40,38) X SETLN
S T=0,N=0 F S T=$O(LRBECPT(T)) Q:'T D
. S N=N+1,TNM="["_T_"] "
. I N=1 S X=$$SETSTR^VALM1("CPT Code(s) passed to PCE:","",12,28)
. I N>1 S X=""
. S C=$O(LRBECPT(T,1,0)),XCODE=$P($$CPT^ICPTCOD(C),U,2,3),XCODE=$TR(XCODE,"^"," "),XCODE=$E(XCODE,1,30)
. S XCODE=TNM_XCODE,X=$$SETSTR^VALM1(XCODE,X,40,38) X SETLN
S X=" " X SETLN
Q
;
NEWDT ;Set new roll-up date
N DD,MM,MM2,X1,X,YY
Q:'$G(LRBERLDT)
S MM=+$E(LRBERLDT,4,5) S MM2=$S(MM=12:1,1:MM+1) S:$L(MM2)=1 MM2="0"_MM2
S DD=$E(LRBERLDT,6,7) S YY=$E(LRBERLDT,1,3) S:+MM2=1 YY=YY+1
S NEWDT=YY_MM2_DD
S X1=NEWDT,X=+$E(NEWDT,4,5),X=$S("^1^3^5^7^8^10^12^"[(U_X_U):31,X'=2:30,$E(X1,1,3)#4:28,1:29)
I $E(X1,6,7)'<X S $E(NEWDT,6,7)=X-1
S $P(^LAB(69.9,1,"VSIT"),U,2)=NEWDT
Q
;
MAILRPT ;Set intro & send rollup report to mail group
N XMY,XMSUB,XMDUZ,XMTEXT,XMZ,X,X1,Y,SETLN,LINE,DASH
S ENDDT=$P(ENDDT,".",1),X=ENDDT D
.S X1=X,X=+$E(X,4,5),X=$S("^1^3^5^7^8^10^12^"[(U_X_U):31,X'=2:30,$E(X1,1,3)#4:28,1:29)
.I $E(X1,6,7)>X S $E(ENDDT,6,7)=X
S LINE=0,SETLN="S LINE=LINE+1,^TMP(""LRROLLUP"",$J,LINE,0)=X"
S $P(DASH,"-",78)=""
S X=" " X SETLN
S X="Normally, panel tests flagged as 'AMA/Billable' should be reported to PCE" X SETLN
S X="using the CPT Code of the panel. In order for the panel CPT Code to be" X SETLN
S X="sent to PCE, a verified result must be present for each 'required' atomic" X SETLN
S X="test comprising the panel." X SETLN
S X=" " X SETLN
S X="This report provides a listing of AMA/Billable panel tests that were pending" X SETLN
S X="completion on the Lab Roll-up Date. The Sample Collection Date for the" X SETLN
S X="panel test fell within the date range indicated by Start Date and End Date." X SETLN
S X="One or more of the 'required' atomic tests comprising the panel were still" X SETLN
S X="pending on the Lab Roll-up Date. Therefore, those atomic tests that had" X SETLN
S X="been verified have now been sent to PCE. If other atomic tests from the" X SETLN
S X="panels listed are verified later, each will be sent to PCE using the CPT" X SETLN
S X="Code for the atomic test." X SETLN
S X=" " X SETLN
S X=" " X SETLN
S Y=LRBERLDT D DD^%DT S LRBERLDT=Y
S X="Lab Roll-up Date : "_LRBERLDT X SETLN
S Y=NEWDT D DD^%DT S NEWDT=Y
S X="Next Lab Roll-up Date : "_NEWDT X SETLN
S Y=STARTDT D DD^%DT S STARTDT=Y
S X="Start Date : "_STARTDT X SETLN
S Y=ENDDT D DD^%DT S ENDDT=Y
S X="End Date : "_ENDDT X SETLN
S X="Total # Panels : "_TOTPAN X SETLN
S X=" " X SETLN
S X=" " X SETLN
S X=$$SETSTR^VALM1("Unique","",12,10),X=$$SETSTR^VALM1("PCE",X,26,10) X SETLN
S X=$$SETSTR^VALM1("Order #","",1,10),X=$$SETSTR^VALM1("Identifier",X,12,10),X=$$SETSTR^VALM1("Encounter",X,26,10)
S X=$$SETSTR^VALM1("Panel Test",X,40,38) X SETLN
S X=$$SETSTR^VALM1(DASH,"",1,78) X SETLN
S Y=DT D DD^%DT S XMSUB="Report on Roll-up to PCE for "_Y
S XMDUZ=.5
S XMY("G.LMI")=""
S XMTEXT="^TMP(""LRROLLUP"",$J,"
D ^XMD
K ^TMP("LRROLLUP",$J)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRBEBA5 6970 printed Dec 13, 2024@02:10:01 Page 2
LRBEBA5 ;DALOI/JAH/FHS - PENDING PANEL ROLLUP TO PCE ;11/26/2005
+1 ;;5.2;LAB SERVICE;**291,337**;Sep 27, 1994;Build 2
+2 ;
EN ;Entry point from LRNIGHT
+1 ;check rollup date
+2 NEW LRBEROLL,LRBERLDT,DATX,YY,MM,STARTDT,ENDDT,NEWDT,TOTPAN
+3 SET LRBEROLL=0
SET LRBERLDT=$PIECE(^LAB(69.9,1,"VSIT"),U,2)
+4 SET YY=$EXTRACT(LRBERLDT,1,3)
SET MM=+$EXTRACT(LRBERLDT,4,5)
+5 SET MM=$SELECT(MM=1:12,1:MM-1)
SET YY=$SELECT(MM=12:YY-1,1:YY)
IF $LENGTH(MM)=1
SET MM="0"_MM
+6 SET STARTDT=YY_MM_"01"
SET ENDDT=YY_MM_"31"_".999999"
+7 SET DATX=$ORDER(^LRO(69,"APP",0))
+8 IF DATX<STARTDT
SET STARTDT=DATX-1
+9 IF LRBERLDT=DT
SET LRBEROLL=1
+10 IF (LRBERLDT<DT)
IF DATX<ENDDT
SET LRBEROLL=1
+11 IF LRBEROLL
Begin DoDot:1
+12 KILL ^TMP("LRROLLUP",$JOB)
+13 SET ^TMP("LRROLLUP",$JOB,0)=$$NOW^XLFDT_"^"
+14 DO START
+15 DO NEWDT
+16 SET ^TMP("LRROLLUP",$JOB,0)=^TMP("LRROLLUP",$JOB,0)_$$NOW^XLFDT()
+17 DO MAILRPT
End DoDot:1
+18 QUIT
+19 ;
START ;Loop thru pending panel xref in file #69
+1 NEW LINE,LRXDT,LRODT,LRSN,LRTN
+2 SET LINE=100
SET TOTPAN=0
+3 SET LRXDT=STARTDT
FOR
SET LRXDT=$ORDER(^LRO(69,"APP",LRXDT))
if 'LRXDT
QUIT
if LRXDT>ENDDT
QUIT
Begin DoDot:1
+4 SET LRODT=0
FOR
SET LRODT=$ORDER(^LRO(69,"APP",LRXDT,LRODT))
if 'LRODT
QUIT
Begin DoDot:2
+5 SET LRSN=0
FOR
SET LRSN=$ORDER(^LRO(69,"APP",LRXDT,LRODT,LRSN))
if 'LRSN
QUIT
Begin DoDot:3
+6 SET LRTN=0
FOR
SET LRTN=$ORDER(^LRO(69,"APP",LRXDT,LRODT,LRSN,LRTN))
if 'LRTN
QUIT
Begin DoDot:4
+7 DO SET
+8 IF $DATA(LRBEY)>1
DO BAWRK^LRBEBA(LRODT,LRSN,LRTN,.LRBEY,.LRTEST,"","",LRBEROLL)
+9 IF $DATA(LRBECPT)>1
DO SETRPT
+10 DO CLEAN
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+11 QUIT
+12 ;
SET ;Setup background variables for call to BAWRK^LRBEBA
+1 NEW LRBET,LRBEIEN,LRFDA,I,NX,XX
+2 SET LRBEIEN=LRSN_","_LRODT_","
+3 SET LRDFN=$$GET1^DIQ(69.01,LRBEIEN,.01,"I")
+4 SET LRORDER=$$GET1^DIQ(69.01,LRBEIEN,9.5,"I")
+5 SET LRBEIEN=LRTN_","_LRSN_","_LRODT_","
+6 IF $$GET1^DIQ(69.03,LRBEIEN,8,"I")="CA"
Begin DoDot:1
+7 ;clear 'pending panel' xref of not performed panel
+8 SET LRFDA(1,69.03,LRBEIEN,22.1)=0
+9 DO FILE^DIE("KS","LRFDA(1)","ERR")
End DoDot:1
QUIT
+10 SET LRBETST=$$GET1^DIQ(69.03,LRBEIEN,.01,"I")
+11 IF LRBETST=""
KILL ^LRO(69,"APP",LRXDT,LRODT,LRSN,LRTN)
QUIT
+12 SET LRAD=+$$GET1^DIQ(69.03,LRBEIEN,2,"I")
+13 SET LRAA=+$$GET1^DIQ(69.03,LRBEIEN,3,"I")
+14 SET LRAN=+$$GET1^DIQ(69.03,LRBEIEN,4,"I")
+15 SET LRUID=$$GET1^DIQ(69.03,LRBEIEN,13,"I")
+16 SET LRBECDT=$$GET1^DIQ(69.03,LRBEIEN,22,"I")
+17 SET LRBEDFN=$$GET1^DIQ(63,LRDFN,.03,"I")
+18 SET LRSS=$$GET1^DIQ(68,LRAA,.02,"I")
+19 IF $GET(^LRO(68,LRAA,1,LRAD,1,LRAN,4,LRBETST,0))=""
KILL ^LRO(69,"APP",LRXDT,LRODT,LRSN,LRTN)
QUIT
+20 SET LRIDT=$PIECE($GET(^LRO(68,LRAA,1,LRAD,1,LRAN,3)),U,5)
+21 SET I=$ORDER(^LRO(68,LRAA,1,LRAD,1,LRAN,5,0))
+22 IF I
SET X=^LRO(68,LRAA,1,LRAD,1,LRAN,5,I,0)
SET LRSPEC=$PIECE(X,U,1)
SET LRSAMP=$PIECE(X,U,2)
+23 SET NX=0
FOR
SET NX=$ORDER(^LAB(60,LRBETST,2,NX))
if 'NX
QUIT
Begin DoDot:1
+24 SET LRBET=+^LAB(60,LRBETST,2,NX,0)
+25 SET XX=$PIECE($PIECE(^LAB(60,LRBET,0),U,5),";",2)
+26 ;if null XX, possibly another panel
+27 IF 'XX
DO ARRS(LRBET,LRBETST)
QUIT
+28 SET LRSB(XX)=$GET(^LR(LRDFN,LRSS,LRIDT,XX))
+29 IF LRSB(XX)=""
KILL LRSB(XX)
QUIT
+30 IF "pending^canc"[$PIECE(LRSB(XX),U,1)
KILL LRSB(XX)
QUIT
+31 IF $PIECE(LRSB(XX),U,13)
KILL LRSB(XX)
QUIT
+32 SET LRBEY(LRBETST,XX)=""
End DoDot:1
+33 IF $DATA(LRBEY)>1
Begin DoDot:1
+34 SET LRTEST(1)=LRBETST_U_^LAB(60,LRBETST,0)
SET LRTEST(1,"P")=LRBETST_U_$$NLT^LRVER1(LRBETST)
End DoDot:1
+35 QUIT
+36 ;
ARRS(XTEST,PTEST) ;
+1 NEW NX,X,XX
+2 SET NX=0
FOR
SET NX=$ORDER(^LAB(60,XTEST,2,NX))
if 'NX
QUIT
Begin DoDot:1
+3 SET X=+^LAB(60,XTEST,2,NX,0)
+4 SET XX=$PIECE($PIECE(^LAB(60,X,0),U,5),";",2)
+5 if 'XX
QUIT
+6 SET LRSB(XX)=$GET(^LR(LRDFN,LRSS,LRIDT,XX))
+7 IF LRSB(XX)=""
KILL LRSB(XX)
QUIT
+8 IF "pending^canc"[$PIECE(LRSB(XX),U,1)
KILL LRSB(XX)
QUIT
+9 IF $PIECE(LRSB(XX),U,13)
KILL LRSB(XX)
QUIT
+10 SET LRBEY(PTEST,XX)=""
End DoDot:1
+11 QUIT
+12 ;
CLEAN ;Clean-up variables
+1 KILL DFN,LRBEY,LRTEST,LRSB,LRBECPT,LRDFN,LRBEDFN,LRORDER
+2 KILL LRBETST,LRBEVST,LRAA,LRAN,LRAD,LRUID,LRBECDT,LRSS,LRIDT,LRSAMP,LRSPEC
+3 QUIT
+4 ;
SETRPT ;Set veriables into ^TMP( for report
+1 NEW SETLN,X,C,N,T,TNM,XCODE,LRPCE,LRBETST,LRBETSTN
+2 SET TOTPAN=TOTPAN+1
+3 SET SETLN="S LINE=LINE+1,^TMP(""LRROLLUP"",$J,LINE,0)=X"
+4 SET LRPCE=$PIECE(^LRO(69,LRODT,1,LRSN,"PCE"),U,1)
+5 if LRPCE=""
QUIT
+6 SET LRBETST=$PIECE(LRTEST(1),U,1)
+7 SET LRBETSTN=$PIECE(^LAB(60,LRBETST,0),U,1)
SET LRBETSTN="["_LRBETST_"] "_$EXTRACT(LRBETSTN,1,30)
+8 SET X=$$SETSTR^VALM1(LRORDER,"",1,10)
SET X=$$SETSTR^VALM1(LRUID,X,12,10)
+9 SET X=$$SETSTR^VALM1(LRPCE,X,26,10)
SET X=$$SETSTR^VALM1(LRBETSTN,X,40,38)
XECUTE SETLN
+10 SET T=0
SET N=0
FOR
SET T=$ORDER(LRBECPT(T))
if 'T
QUIT
Begin DoDot:1
+11 SET N=N+1
SET TNM="["_T_"] "
+12 IF N=1
SET X=$$SETSTR^VALM1("CPT Code(s) passed to PCE:","",12,28)
+13 IF N>1
SET X=""
+14 SET C=$ORDER(LRBECPT(T,1,0))
SET XCODE=$PIECE($$CPT^ICPTCOD(C),U,2,3)
SET XCODE=$TRANSLATE(XCODE,"^"," ")
SET XCODE=$EXTRACT(XCODE,1,30)
+15 SET XCODE=TNM_XCODE
SET X=$$SETSTR^VALM1(XCODE,X,40,38)
XECUTE SETLN
End DoDot:1
+16 SET X=" "
XECUTE SETLN
+17 QUIT
+18 ;
NEWDT ;Set new roll-up date
+1 NEW DD,MM,MM2,X1,X,YY
+2 if '$GET(LRBERLDT)
QUIT
+3 SET MM=+$EXTRACT(LRBERLDT,4,5)
SET MM2=$SELECT(MM=12:1,1:MM+1)
if $LENGTH(MM2)=1
SET MM2="0"_MM2
+4 SET DD=$EXTRACT(LRBERLDT,6,7)
SET YY=$EXTRACT(LRBERLDT,1,3)
if +MM2=1
SET YY=YY+1
+5 SET NEWDT=YY_MM2_DD
+6 SET X1=NEWDT
SET X=+$EXTRACT(NEWDT,4,5)
SET X=$SELECT("^1^3^5^7^8^10^12^"[(U_X_U):31,X'=2:30,$EXTRACT(X1,1,3)#4:28,1:29)
+7 IF $EXTRACT(X1,6,7)'<X
SET $EXTRACT(NEWDT,6,7)=X-1
+8 SET $PIECE(^LAB(69.9,1,"VSIT"),U,2)=NEWDT
+9 QUIT
+10 ;
MAILRPT ;Set intro & send rollup report to mail group
+1 NEW XMY,XMSUB,XMDUZ,XMTEXT,XMZ,X,X1,Y,SETLN,LINE,DASH
+2 SET ENDDT=$PIECE(ENDDT,".",1)
SET X=ENDDT
Begin DoDot:1
+3 SET X1=X
SET X=+$EXTRACT(X,4,5)
SET X=$SELECT("^1^3^5^7^8^10^12^"[(U_X_U):31,X'=2:30,$EXTRACT(X1,1,3)#4:28,1:29)
+4 IF $EXTRACT(X1,6,7)>X
SET $EXTRACT(ENDDT,6,7)=X
End DoDot:1
+5 SET LINE=0
SET SETLN="S LINE=LINE+1,^TMP(""LRROLLUP"",$J,LINE,0)=X"
+6 SET $PIECE(DASH,"-",78)=""
+7 SET X=" "
XECUTE SETLN
+8 SET X="Normally, panel tests flagged as 'AMA/Billable' should be reported to PCE"
XECUTE SETLN
+9 SET X="using the CPT Code of the panel. In order for the panel CPT Code to be"
XECUTE SETLN
+10 SET X="sent to PCE, a verified result must be present for each 'required' atomic"
XECUTE SETLN
+11 SET X="test comprising the panel."
XECUTE SETLN
+12 SET X=" "
XECUTE SETLN
+13 SET X="This report provides a listing of AMA/Billable panel tests that were pending"
XECUTE SETLN
+14 SET X="completion on the Lab Roll-up Date. The Sample Collection Date for the"
XECUTE SETLN
+15 SET X="panel test fell within the date range indicated by Start Date and End Date."
XECUTE SETLN
+16 SET X="One or more of the 'required' atomic tests comprising the panel were still"
XECUTE SETLN
+17 SET X="pending on the Lab Roll-up Date. Therefore, those atomic tests that had"
XECUTE SETLN
+18 SET X="been verified have now been sent to PCE. If other atomic tests from the"
XECUTE SETLN
+19 SET X="panels listed are verified later, each will be sent to PCE using the CPT"
XECUTE SETLN
+20 SET X="Code for the atomic test."
XECUTE SETLN
+21 SET X=" "
XECUTE SETLN
+22 SET X=" "
XECUTE SETLN
+23 SET Y=LRBERLDT
DO DD^%DT
SET LRBERLDT=Y
+24 SET X="Lab Roll-up Date : "_LRBERLDT
XECUTE SETLN
+25 SET Y=NEWDT
DO DD^%DT
SET NEWDT=Y
+26 SET X="Next Lab Roll-up Date : "_NEWDT
XECUTE SETLN
+27 SET Y=STARTDT
DO DD^%DT
SET STARTDT=Y
+28 SET X="Start Date : "_STARTDT
XECUTE SETLN
+29 SET Y=ENDDT
DO DD^%DT
SET ENDDT=Y
+30 SET X="End Date : "_ENDDT
XECUTE SETLN
+31 SET X="Total # Panels : "_TOTPAN
XECUTE SETLN
+32 SET X=" "
XECUTE SETLN
+33 SET X=" "
XECUTE SETLN
+34 SET X=$$SETSTR^VALM1("Unique","",12,10)
SET X=$$SETSTR^VALM1("PCE",X,26,10)
XECUTE SETLN
+35 SET X=$$SETSTR^VALM1("Order #","",1,10)
SET X=$$SETSTR^VALM1("Identifier",X,12,10)
SET X=$$SETSTR^VALM1("Encounter",X,26,10)
+36 SET X=$$SETSTR^VALM1("Panel Test",X,40,38)
XECUTE SETLN
+37 SET X=$$SETSTR^VALM1(DASH,"",1,78)
XECUTE SETLN
+38 SET Y=DT
DO DD^%DT
SET XMSUB="Report on Roll-up to PCE for "_Y
+39 SET XMDUZ=.5
+40 SET XMY("G.LMI")=""
+41 SET XMTEXT="^TMP(""LRROLLUP"",$J,"
+42 DO ^XMD
+43 KILL ^TMP("LRROLLUP",$JOB)
+44 QUIT
