LRCAPPHX ;DALOI/FHS - RESET AND RESUBMIT PCE WORKLOAD FOR EMPTY PCE NODES ;5/1/2001
;;5.2;LAB SERVICE;**278**;Sep 27, 1994
EN ;
L +^LRO("LRCAPPH","NITE"):1 I '$T W:'$D(LRQUIET) !!,$$CJ^XLFSTR("PCE API is currently running",80) G FIN
I '$D(LRQUIET) D
. W @IOF
. W !,$$CJ^XLFSTR(" Resend PCE CPT Workload ",IOM)
. W !,$$CJ^XLFSTR("Only orders that have NO recorded PCE workload will be rescanned",IOM)
N DIR,DIRUT,DTOUT,DUOUT,LRCE,LRCOUNT,LREND,LREND,LRNOD,LRSET,LRSN,X,Y
N LRDPF,LRDUZ,LRSDT,LREDT,LRTS,LRDLOC
DATE ;Get date range
W !
S DIR("A")="Enter Starting Date: "
S DIR(0)="DO^::EX" D ^DIR,RD G FIN:$G(LREND)
G FIN:Y<1
S LRSDT=Y,DIR("A")="Enter Stop/End Date: "
D ^DIR,RD G FIN:$G(LREND)
G FIN:Y<1
S LREDT=Y
SW ;Exchange dates if out of sequence
Q:$G(LRSDT)'?7N.E!($G(LREDT)'?7N.E)
I LRSDT>LREDT S X=LRSDT,LRSDT=LREDT,LREDT=X
S LRSDT=LRSDT-.0001,LRCOUNT=0
LOOP ;Check entries to determine if appropriate to resend
F S LRSDT=+$O(^LRO(69,LRSDT)) Q:LRSDT<1!(LRSDT>LREDT) D
. I '$D(LRQUIET) W !,$$FMTE^XLFDT(LRSDT),!
. S LRSN=0 F S LRSN=$O(^LRO(69,LRSDT,1,LRSN)) Q:LRSN<1 D
. . S (LRCE,LRSET)=0
. . S LRCE=$P($G(^LRO(69,LRSDT,1,LRSN,.1)),U) Q:'LRCE
. . I $L($G(^LRO(69,LRSDT,1,LRSN,"PCE")))>1 Q
. . D SET
. . I $G(LRSET) S ^LRO(69,"AA",LRCE,LRSDT_"|"_LRSN)="",LRCOUNT=$G(LRCOUNT)+1
. . I '$D(LRQUIET),'(LRCOUNT#20) W "."
G END
Q
SET ;Reset node if not canceled
S LRTS=0 F S LRTS=$O(^LRO(69,LRSDT,1,LRSN,2,LRTS)) Q:LRTS<1 D
. S LRNOD(1)=$G(^LRO(69,LRSDT,1,LRSN,2,LRTS,0))
. I $S('+LRNOD(1):1,$P(LRNOD(1),U,9)="CA":1,$P(LRNOD(1),U,11):1,1:0) Q
. S LRSET=1,$P(LRNOD(1),U,12)=""
. S ^LRO(69,LRSDT,1,LRSN,2,LRTS,0)=LRNOD(1)
Q
RD ;
S LREND=0
I $D(DUOUT)!($D(DTOUT))!($D(DIRUT)) S LREND=1
Q
END ;Indicate if accessions were reset and process ^LRO(69,"AA" data
I '$O(^LRO(69,"AA",0)) W:'$D(LRQUIET) !!?5,"No PCE Workload to process",!! G FIN
S LRINS=+$P($G(^XMB(1,1,"XUS")),U,17) G FIN:'LRINS
W:'$D(LRQUIET) !,$$CJ^XLFSTR("Processing PCE Workload",80)
I $G(^LRO(69,"AE"))'=DT D EN0^LRCAPPH3 S ^LRO(69,"AA")=DT
I $D(ZTQUEUED) S ZTREQ="@" K LRDBUG
I '$G(LRDBUG) K ^TMP("LRMOD",$J)
S LRDPRAC=+$P($G(^LAB(69.9,1,12)),U)
S LRDLOC=+$G(^LAB(69.9,1,.8))
I LRDPRAC D
. N DIC,X
. S DIC(0)="NZ",DIC=200,X="`"_LRDPRAC
. D ^DIC S LRDPRAC=$S(Y<1:0,$P($G(Y(0)),U,11):0,1:+Y)
. I $$GET^XUA4A72(LRDPRAC)<1 S LRDPRAC=0
S LROK=+$G(^LAB(69.9,1,.8)) G:'LROK FIN
I $P($G(^SC(LROK,0)),U)'["LAB DIV " G FIN
K LROK
S:'$D(^LAB(69.9,1,"NITE")) ^("NITE")=""
S LRWRKL=$S($P(^LAB(69.9,1,0),U,14):1,1:0)
I $D(XRTL) S XRTN="LRCAPPH" D T0^%ZOSV
S LRPKG=$O(^DIC(9.4,"C","LR",0))
S:'LRPKG LRPKG=$O(^DIC(9.4,"B","LAB SERVICE",0))
G:'LRPKG FIN
S LRVSIT=$P($G(^LAB(69.9,1,"VSIT")),U)
S X="PXAI" X ^%ZOSF("TEST") I '$T G FIN
S:'$G(LRNP) $P(^LAB(69.9,1,"NITE"),U,2)=$$NOW^XLFDT
S LRPCEON=$$PKGON^VSIT("PX")
S ^TMP("LRMOD",$J)=""
AA ;
W:'$D(LRQUIET) !,$$CJ^XLFSTR("Will Print Every 20th. Order Number Re-scanned",80)
S (LRCEX,LRCEXV,LRCOUNT,LREND,LROA)=0
F S LRCEX=$O(^LRO(69,"AA",LRCEX)) Q:LRCEX=""!(LREND) D
. K LRXCPT S LRCOUNT=LRCOUNT+1 I '$D(LRQUIET),'(LRCOUNT#20) W LRCEX_" "
. S (LROA,LRCC)=""
. F S LROA=$O(^LRO(69,"AA",LRCEX,LROA)) Q:LROA="" D
. . S LRCDT=+LROA,LRSN=+$P(LROA,"|",2)
. . I LRCDT,LRSN D LOOK
. . K:'$G(^LRO(69,"AA",LRCEX,LROA)) ^(LROA)
FIN L -^LRO("LRCAPPH","NITE")
W:'$D(LRQUIET) !,"END",!
K AFTER812,AC,ANS,CH1,CLN,CM,CX,D,D0,DDER
K DEF,DFN,DI,DIF,DIG,DIH,DISL,DIU,DIV,DQ
K EC,FPRI,J,LI,LL,LN,LV,N,PG
K LRVSITN,PXALOOK,PXASUB,PXJ,PXJJ,SDCNT,SDFLAG,SDT1
K SPEL,SUBL,T,TYPEI,Z1
D END0^LRCAPPH
K ^TMP("LRMOD",$J)
Q
LOOK ;Process only collected specimens
Q:'$D(^LRO(69,LRCDT,1,LRSN,0))#2 S NODE=^(0)
S LRDFN=+NODE Q:'$D(^LR(LRDFN,0))#2
S LRDPF=+$P(^(0),U,2),DFN=+$P(^(0),U,3)
Q:'DFN!(LRDPF'=2)
S LRDUZ=$S($P(NODE,U,2):$P(NODE,U,2),1:DUZ)
Q:'$D(^LRO(69,LRCDT,1,LRSN,1))#2 S NODE(1)=^(1)
Q:$P(NODE(1),U,4)'="C"
S LRNT=+NODE(1),LRIN=$S($P(NODE(1),U,8):$P(NODE(1),U,8),1:LRINS)
S LRCE=+$G(^LRO(69,LRCDT,1,LRSN,.1)) Q:'LRCE
D EN3^LRCAPPH1
Q
DQ ;Queue with START DATE(LRSDT) AND END DATE(LREDT) defined
;Recommended that this routine not be queued. User feedback
;can be very important. Screen displays are very helpful.
N LRQUIET
S LRQUIET=1
D SW
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRCAPPHX 4345 printed Sep 23, 2025@19:48:53 Page 2
LRCAPPHX ;DALOI/FHS - RESET AND RESUBMIT PCE WORKLOAD FOR EMPTY PCE NODES ;5/1/2001
+1 ;;5.2;LAB SERVICE;**278**;Sep 27, 1994
EN ;
+1 LOCK +^LRO("LRCAPPH","NITE"):1
IF '$TEST
if '$DATA(LRQUIET)
WRITE !!,$$CJ^XLFSTR("PCE API is currently running",80)
GOTO FIN
+2 IF '$DATA(LRQUIET)
Begin DoDot:1
+3 WRITE @IOF
+4 WRITE !,$$CJ^XLFSTR(" Resend PCE CPT Workload ",IOM)
+5 WRITE !,$$CJ^XLFSTR("Only orders that have NO recorded PCE workload will be rescanned",IOM)
End DoDot:1
+6 NEW DIR,DIRUT,DTOUT,DUOUT,LRCE,LRCOUNT,LREND,LREND,LRNOD,LRSET,LRSN,X,Y
+7 NEW LRDPF,LRDUZ,LRSDT,LREDT,LRTS,LRDLOC
DATE ;Get date range
+1 WRITE !
+2 SET DIR("A")="Enter Starting Date: "
+3 SET DIR(0)="DO^::EX"
DO ^DIR
DO RD
if $GET(LREND)
GOTO FIN
+4 if Y<1
GOTO FIN
+5 SET LRSDT=Y
SET DIR("A")="Enter Stop/End Date: "
+6 DO ^DIR
DO RD
if $GET(LREND)
GOTO FIN
+7 if Y<1
GOTO FIN
+8 SET LREDT=Y
SW ;Exchange dates if out of sequence
+1 if $GET(LRSDT)'?7N.E!($GET(LREDT)'?7N.E)
QUIT
+2 IF LRSDT>LREDT
SET X=LRSDT
SET LRSDT=LREDT
SET LREDT=X
+3 SET LRSDT=LRSDT-.0001
SET LRCOUNT=0
LOOP ;Check entries to determine if appropriate to resend
+1 FOR
SET LRSDT=+$ORDER(^LRO(69,LRSDT))
if LRSDT<1!(LRSDT>LREDT)
QUIT
Begin DoDot:1
+2 IF '$DATA(LRQUIET)
WRITE !,$$FMTE^XLFDT(LRSDT),!
+3 SET LRSN=0
FOR
SET LRSN=$ORDER(^LRO(69,LRSDT,1,LRSN))
if LRSN<1
QUIT
Begin DoDot:2
+4 SET (LRCE,LRSET)=0
+5 SET LRCE=$PIECE($GET(^LRO(69,LRSDT,1,LRSN,.1)),U)
if 'LRCE
QUIT
+6 IF $LENGTH($GET(^LRO(69,LRSDT,1,LRSN,"PCE")))>1
QUIT
+7 DO SET
+8 IF $GET(LRSET)
SET ^LRO(69,"AA",LRCE,LRSDT_"|"_LRSN)=""
SET LRCOUNT=$GET(LRCOUNT)+1
+9 IF '$DATA(LRQUIET)
IF '(LRCOUNT#20)
WRITE "."
End DoDot:2
End DoDot:1
+10 GOTO END
+11 QUIT
SET ;Reset node if not canceled
+1 SET LRTS=0
FOR
SET LRTS=$ORDER(^LRO(69,LRSDT,1,LRSN,2,LRTS))
if LRTS<1
QUIT
Begin DoDot:1
+2 SET LRNOD(1)=$GET(^LRO(69,LRSDT,1,LRSN,2,LRTS,0))
+3 IF $SELECT('+LRNOD(1):1,$PIECE(LRNOD(1),U,9)="CA":1,$PIECE(LRNOD(1),U,11):1,1:0)
QUIT
+4 SET LRSET=1
SET $PIECE(LRNOD(1),U,12)=""
+5 SET ^LRO(69,LRSDT,1,LRSN,2,LRTS,0)=LRNOD(1)
End DoDot:1
+6 QUIT
RD ;
+1 SET LREND=0
+2 IF $DATA(DUOUT)!($DATA(DTOUT))!($DATA(DIRUT))
SET LREND=1
+3 QUIT
END ;Indicate if accessions were reset and process ^LRO(69,"AA" data
+1 IF '$ORDER(^LRO(69,"AA",0))
if '$DATA(LRQUIET)
WRITE !!?5,"No PCE Workload to process",!!
GOTO FIN
+2 SET LRINS=+$PIECE($GET(^XMB(1,1,"XUS")),U,17)
if 'LRINS
GOTO FIN
+3 if '$DATA(LRQUIET)
WRITE !,$$CJ^XLFSTR("Processing PCE Workload",80)
+4 IF $GET(^LRO(69,"AE"))'=DT
DO EN0^LRCAPPH3
SET ^LRO(69,"AA")=DT
+5 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
KILL LRDBUG
+6 IF '$GET(LRDBUG)
KILL ^TMP("LRMOD",$JOB)
+7 SET LRDPRAC=+$PIECE($GET(^LAB(69.9,1,12)),U)
+8 SET LRDLOC=+$GET(^LAB(69.9,1,.8))
+9 IF LRDPRAC
Begin DoDot:1
+10 NEW DIC,X
+11 SET DIC(0)="NZ"
SET DIC=200
SET X="`"_LRDPRAC
+12 DO ^DIC
SET LRDPRAC=$SELECT(Y<1:0,$PIECE($GET(Y(0)),U,11):0,1:+Y)
+13 IF $$GET^XUA4A72(LRDPRAC)<1
SET LRDPRAC=0
End DoDot:1
+14 SET LROK=+$GET(^LAB(69.9,1,.8))
if 'LROK
GOTO FIN
+15 IF $PIECE($GET(^SC(LROK,0)),U)'["LAB DIV "
GOTO FIN
+16 KILL LROK
+17 if '$DATA(^LAB(69.9,1,"NITE"))
SET ^("NITE")=""
+18 SET LRWRKL=$SELECT($PIECE(^LAB(69.9,1,0),U,14):1,1:0)
+19 IF $DATA(XRTL)
SET XRTN="LRCAPPH"
DO T0^%ZOSV
+20 SET LRPKG=$ORDER(^DIC(9.4,"C","LR",0))
+21 if 'LRPKG
SET LRPKG=$ORDER(^DIC(9.4,"B","LAB SERVICE",0))
+22 if 'LRPKG
GOTO FIN
+23 SET LRVSIT=$PIECE($GET(^LAB(69.9,1,"VSIT")),U)
+24 SET X="PXAI"
XECUTE ^%ZOSF("TEST")
IF '$TEST
GOTO FIN
+25 if '$GET(LRNP)
SET $PIECE(^LAB(69.9,1,"NITE"),U,2)=$$NOW^XLFDT
+26 SET LRPCEON=$$PKGON^VSIT("PX")
+27 SET ^TMP("LRMOD",$JOB)=""
AA ;
+1 if '$DATA(LRQUIET)
WRITE !,$$CJ^XLFSTR("Will Print Every 20th. Order Number Re-scanned",80)
+2 SET (LRCEX,LRCEXV,LRCOUNT,LREND,LROA)=0
+3 FOR
SET LRCEX=$ORDER(^LRO(69,"AA",LRCEX))
if LRCEX=""!(LREND)
QUIT
Begin DoDot:1
+4 KILL LRXCPT
SET LRCOUNT=LRCOUNT+1
IF '$DATA(LRQUIET)
IF '(LRCOUNT#20)
WRITE LRCEX_" "
+5 SET (LROA,LRCC)=""
+6 FOR
SET LROA=$ORDER(^LRO(69,"AA",LRCEX,LROA))
if LROA=""
QUIT
Begin DoDot:2
+7 SET LRCDT=+LROA
SET LRSN=+$PIECE(LROA,"|",2)
+8 IF LRCDT
IF LRSN
DO LOOK
+9 if '$GET(^LRO(69,"AA",LRCEX,LROA))
KILL ^(LROA)
End DoDot:2
End DoDot:1
FIN LOCK -^LRO("LRCAPPH","NITE")
+1 if '$DATA(LRQUIET)
WRITE !,"END",!
+2 KILL AFTER812,AC,ANS,CH1,CLN,CM,CX,D,D0,DDER
+3 KILL DEF,DFN,DI,DIF,DIG,DIH,DISL,DIU,DIV,DQ
+4 KILL EC,FPRI,J,LI,LL,LN,LV,N,PG
+5 KILL LRVSITN,PXALOOK,PXASUB,PXJ,PXJJ,SDCNT,SDFLAG,SDT1
+6 KILL SPEL,SUBL,T,TYPEI,Z1
+7 DO END0^LRCAPPH
+8 KILL ^TMP("LRMOD",$JOB)
+9 QUIT
LOOK ;Process only collected specimens
+1 if '$DATA(^LRO(69,LRCDT,1,LRSN,0))#2
QUIT
SET NODE=^(0)
+2 SET LRDFN=+NODE
if '$DATA(^LR(LRDFN,0))#2
QUIT
+3 SET LRDPF=+$PIECE(^(0),U,2)
SET DFN=+$PIECE(^(0),U,3)
+4 if 'DFN!(LRDPF'=2)
QUIT
+5 SET LRDUZ=$SELECT($PIECE(NODE,U,2):$PIECE(NODE,U,2),1:DUZ)
+6 if '$DATA(^LRO(69,LRCDT,1,LRSN,1))#2
QUIT
SET NODE(1)=^(1)
+7 if $PIECE(NODE(1),U,4)'="C"
QUIT
+8 SET LRNT=+NODE(1)
SET LRIN=$SELECT($PIECE(NODE(1),U,8):$PIECE(NODE(1),U,8),1:LRINS)
+9 SET LRCE=+$GET(^LRO(69,LRCDT,1,LRSN,.1))
if 'LRCE
QUIT
+10 DO EN3^LRCAPPH1
+11 QUIT
DQ ;Queue with START DATE(LRSDT) AND END DATE(LREDT) defined
+1 ;Recommended that this routine not be queued. User feedback
+2 ;can be very important. Screen displays are very helpful.
+3 NEW LRQUIET
+4 SET LRQUIET=1
+5 DO SW
+6 QUIT
