| 1 | LRCAPPHX ;DALOI/FHS - RESET AND RESUBMIT PCE WORKLOAD FOR EMPTY PCE NODES ;5/1/2001
|
|---|
| 2 | ;;5.2;LAB SERVICE;**278**;Sep 27, 1994
|
|---|
| 3 | EN ;
|
|---|
| 4 | L +^LRO("LRCAPPH","NITE"):1 I '$T W:'$D(LRQUIET) !!,$$CJ^XLFSTR("PCE API is currently running",80) G FIN
|
|---|
| 5 | I '$D(LRQUIET) D
|
|---|
| 6 | . W @IOF
|
|---|
| 7 | . W !,$$CJ^XLFSTR(" Resend PCE CPT Workload ",IOM)
|
|---|
| 8 | . W !,$$CJ^XLFSTR("Only orders that have NO recorded PCE workload will be rescanned",IOM)
|
|---|
| 9 | N DIR,DIRUT,DTOUT,DUOUT,LRCE,LRCOUNT,LREND,LREND,LRNOD,LRSET,LRSN,X,Y
|
|---|
| 10 | N LRDPF,LRDUZ,LRSDT,LREDT,LRTS,LRDLOC
|
|---|
| 11 | DATE ;Get date range
|
|---|
| 12 | W !
|
|---|
| 13 | S DIR("A")="Enter Starting Date: "
|
|---|
| 14 | S DIR(0)="DO^::EX" D ^DIR,RD G FIN:$G(LREND)
|
|---|
| 15 | G FIN:Y<1
|
|---|
| 16 | S LRSDT=Y,DIR("A")="Enter Stop/End Date: "
|
|---|
| 17 | D ^DIR,RD G FIN:$G(LREND)
|
|---|
| 18 | G FIN:Y<1
|
|---|
| 19 | S LREDT=Y
|
|---|
| 20 | SW ;Exchange dates if out of sequence
|
|---|
| 21 | Q:$G(LRSDT)'?7N.E!($G(LREDT)'?7N.E)
|
|---|
| 22 | I LRSDT>LREDT S X=LRSDT,LRSDT=LREDT,LREDT=X
|
|---|
| 23 | S LRSDT=LRSDT-.0001,LRCOUNT=0
|
|---|
| 24 | LOOP ;Check entries to determine if appropriate to resend
|
|---|
| 25 | F S LRSDT=+$O(^LRO(69,LRSDT)) Q:LRSDT<1!(LRSDT>LREDT) D
|
|---|
| 26 | . I '$D(LRQUIET) W !,$$FMTE^XLFDT(LRSDT),!
|
|---|
| 27 | . S LRSN=0 F S LRSN=$O(^LRO(69,LRSDT,1,LRSN)) Q:LRSN<1 D
|
|---|
| 28 | . . S (LRCE,LRSET)=0
|
|---|
| 29 | . . S LRCE=$P($G(^LRO(69,LRSDT,1,LRSN,.1)),U) Q:'LRCE
|
|---|
| 30 | . . I $L($G(^LRO(69,LRSDT,1,LRSN,"PCE")))>1 Q
|
|---|
| 31 | . . D SET
|
|---|
| 32 | . . I $G(LRSET) S ^LRO(69,"AA",LRCE,LRSDT_"|"_LRSN)="",LRCOUNT=$G(LRCOUNT)+1
|
|---|
| 33 | . . I '$D(LRQUIET),'(LRCOUNT#20) W "."
|
|---|
| 34 | G END
|
|---|
| 35 | Q
|
|---|
| 36 | SET ;Reset node if not canceled
|
|---|
| 37 | S LRTS=0 F S LRTS=$O(^LRO(69,LRSDT,1,LRSN,2,LRTS)) Q:LRTS<1 D
|
|---|
| 38 | . S LRNOD(1)=$G(^LRO(69,LRSDT,1,LRSN,2,LRTS,0))
|
|---|
| 39 | . I $S('+LRNOD(1):1,$P(LRNOD(1),U,9)="CA":1,$P(LRNOD(1),U,11):1,1:0) Q
|
|---|
| 40 | . S LRSET=1,$P(LRNOD(1),U,12)=""
|
|---|
| 41 | . S ^LRO(69,LRSDT,1,LRSN,2,LRTS,0)=LRNOD(1)
|
|---|
| 42 | Q
|
|---|
| 43 | RD ;
|
|---|
| 44 | S LREND=0
|
|---|
| 45 | I $D(DUOUT)!($D(DTOUT))!($D(DIRUT)) S LREND=1
|
|---|
| 46 | Q
|
|---|
| 47 | END ;Indicate if accessions were reset and process ^LRO(69,"AA" data
|
|---|
| 48 | I '$O(^LRO(69,"AA",0)) W:'$D(LRQUIET) !!?5,"No PCE Workload to process",!! G FIN
|
|---|
| 49 | S LRINS=+$P($G(^XMB(1,1,"XUS")),U,17) G FIN:'LRINS
|
|---|
| 50 | W:'$D(LRQUIET) !,$$CJ^XLFSTR("Processing PCE Workload",80)
|
|---|
| 51 | I $G(^LRO(69,"AE"))'=DT D EN0^LRCAPPH3 S ^LRO(69,"AA")=DT
|
|---|
| 52 | I $D(ZTQUEUED) S ZTREQ="@" K LRDBUG
|
|---|
| 53 | I '$G(LRDBUG) K ^TMP("LRMOD",$J)
|
|---|
| 54 | S LRDPRAC=+$P($G(^LAB(69.9,1,12)),U)
|
|---|
| 55 | S LRDLOC=+$G(^LAB(69.9,1,.8))
|
|---|
| 56 | I LRDPRAC D
|
|---|
| 57 | . N DIC,X
|
|---|
| 58 | . S DIC(0)="NZ",DIC=200,X="`"_LRDPRAC
|
|---|
| 59 | . D ^DIC S LRDPRAC=$S(Y<1:0,$P($G(Y(0)),U,11):0,1:+Y)
|
|---|
| 60 | . I $$GET^XUA4A72(LRDPRAC)<1 S LRDPRAC=0
|
|---|
| 61 | S LROK=+$G(^LAB(69.9,1,.8)) G:'LROK FIN
|
|---|
| 62 | I $P($G(^SC(LROK,0)),U)'["LAB DIV " G FIN
|
|---|
| 63 | K LROK
|
|---|
| 64 | S:'$D(^LAB(69.9,1,"NITE")) ^("NITE")=""
|
|---|
| 65 | S LRWRKL=$S($P(^LAB(69.9,1,0),U,14):1,1:0)
|
|---|
| 66 | I $D(XRTL) S XRTN="LRCAPPH" D T0^%ZOSV
|
|---|
| 67 | S LRPKG=$O(^DIC(9.4,"C","LR",0))
|
|---|
| 68 | S:'LRPKG LRPKG=$O(^DIC(9.4,"B","LAB SERVICE",0))
|
|---|
| 69 | G:'LRPKG FIN
|
|---|
| 70 | S LRVSIT=$P($G(^LAB(69.9,1,"VSIT")),U)
|
|---|
| 71 | S X="PXAI" X ^%ZOSF("TEST") I '$T G FIN
|
|---|
| 72 | S:'$G(LRNP) $P(^LAB(69.9,1,"NITE"),U,2)=$$NOW^XLFDT
|
|---|
| 73 | S LRPCEON=$$PKGON^VSIT("PX")
|
|---|
| 74 | S ^TMP("LRMOD",$J)=""
|
|---|
| 75 | AA ;
|
|---|
| 76 | W:'$D(LRQUIET) !,$$CJ^XLFSTR("Will Print Every 20th. Order Number Re-scanned",80)
|
|---|
| 77 | S (LRCEX,LRCEXV,LRCOUNT,LREND,LROA)=0
|
|---|
| 78 | F S LRCEX=$O(^LRO(69,"AA",LRCEX)) Q:LRCEX=""!(LREND) D
|
|---|
| 79 | . K LRXCPT S LRCOUNT=LRCOUNT+1 I '$D(LRQUIET),'(LRCOUNT#20) W LRCEX_" "
|
|---|
| 80 | . S (LROA,LRCC)=""
|
|---|
| 81 | . F S LROA=$O(^LRO(69,"AA",LRCEX,LROA)) Q:LROA="" D
|
|---|
| 82 | . . S LRCDT=+LROA,LRSN=+$P(LROA,"|",2)
|
|---|
| 83 | . . I LRCDT,LRSN D LOOK
|
|---|
| 84 | . . K:'$G(^LRO(69,"AA",LRCEX,LROA)) ^(LROA)
|
|---|
| 85 | FIN L -^LRO("LRCAPPH","NITE")
|
|---|
| 86 | W:'$D(LRQUIET) !,"END",!
|
|---|
| 87 | K AFTER812,AC,ANS,CH1,CLN,CM,CX,D,D0,DDER
|
|---|
| 88 | K DEF,DFN,DI,DIF,DIG,DIH,DISL,DIU,DIV,DQ
|
|---|
| 89 | K EC,FPRI,J,LI,LL,LN,LV,N,PG
|
|---|
| 90 | K LRVSITN,PXALOOK,PXASUB,PXJ,PXJJ,SDCNT,SDFLAG,SDT1
|
|---|
| 91 | K SPEL,SUBL,T,TYPEI,Z1
|
|---|
| 92 | D END0^LRCAPPH
|
|---|
| 93 | K ^TMP("LRMOD",$J)
|
|---|
| 94 | Q
|
|---|
| 95 | LOOK ;Process only collected specimens
|
|---|
| 96 | Q:'$D(^LRO(69,LRCDT,1,LRSN,0))#2 S NODE=^(0)
|
|---|
| 97 | S LRDFN=+NODE Q:'$D(^LR(LRDFN,0))#2
|
|---|
| 98 | S LRDPF=+$P(^(0),U,2),DFN=+$P(^(0),U,3)
|
|---|
| 99 | Q:'DFN!(LRDPF'=2)
|
|---|
| 100 | S LRDUZ=$S($P(NODE,U,2):$P(NODE,U,2),1:DUZ)
|
|---|
| 101 | Q:'$D(^LRO(69,LRCDT,1,LRSN,1))#2 S NODE(1)=^(1)
|
|---|
| 102 | Q:$P(NODE(1),U,4)'="C"
|
|---|
| 103 | S LRNT=+NODE(1),LRIN=$S($P(NODE(1),U,8):$P(NODE(1),U,8),1:LRINS)
|
|---|
| 104 | S LRCE=+$G(^LRO(69,LRCDT,1,LRSN,.1)) Q:'LRCE
|
|---|
| 105 | D EN3^LRCAPPH1
|
|---|
| 106 | Q
|
|---|
| 107 | DQ ;Queue with START DATE(LRSDT) AND END DATE(LREDT) defined
|
|---|
| 108 | ;Recommended that this routine not be queued. User feedback
|
|---|
| 109 | ;can be very important. Screen displays are very helpful.
|
|---|
| 110 | N LRQUIET
|
|---|
| 111 | S LRQUIET=1
|
|---|
| 112 | D SW
|
|---|
| 113 | Q
|
|---|
