LRCAPPHX.m

LRCAPPHX ;DALOI/FHS - RESET AND RESUBMIT PCE WORKLOAD FOR EMPTY PCE NODES ;5/1/2001

 ;;5.2T9;LR;**1018**;Nov 17, 2004

 ;;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)

 ;----- BEGIN IHS MODIFICATIONS LR*5.2*1018

 ;I $G(^LRO(69,"AE"))'=DT D EN0^LRCAPPH3 S ^LRO(69,"AA")=DT

 ;COMMENT OUT UNTIL UPDATE TO CPT V6.0 IS COMPLETE

 ;----- END IHS MODIFICATIONS

 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 

LRCAPPHX  ;DALOI/FHS - RESET AND RESUBMIT PCE WORKLOAD FOR EMPTY PCE NODES ;5/1/2001

 +1       ;;5.2T9;LR;**1018**;Nov 17, 2004

 +2       ;;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       ;----- BEGIN IHS MODIFICATIONS LR*5.2*1018

 +5       ;I $G(^LRO(69,"AE"))'=DT D EN0^LRCAPPH3 S ^LRO(69,"AA")=DT

 +6       ;COMMENT OUT UNTIL UPDATE TO CPT V6.0 IS COMPLETE

 +7       ;----- END IHS MODIFICATIONS

 +8        IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

               KILL LRDBUG

 +9        IF '$GET(LRDBUG)

               KILL ^TMP("LRMOD",$JOB)

 +10       SET LRDPRAC=+$PIECE($GET(^LAB(69.9,1,12)),U)

 +11       SET LRDLOC=+$GET(^LAB(69.9,1,.8))

 +12       IF LRDPRAC

               Begin DoDot:1

 +13               NEW DIC,X

 +14               SET DIC(0)="NZ"

                   SET DIC=200

                   SET X="`"_LRDPRAC

 +15               DO ^DIC

                   SET LRDPRAC=$SELECT(Y<1:0,$PIECE($GET(Y(0)),U,11):0,1:+Y)

 +16               IF $$GET^XUA4A72(LRDPRAC)<1

                       SET LRDPRAC=0

               End DoDot:1

 +17       SET LROK=+$GET(^LAB(69.9,1,.8))

           IF 'LROK

               GOTO FIN

 +18       IF $PIECE($GET(^SC(LROK,0)),U)'["LAB DIV "

               GOTO FIN

 +19       KILL LROK

 +20       IF '$DATA(^LAB(69.9,1,"NITE"))

               SET ^("NITE")=""

 +21       SET LRWRKL=$SELECT($PIECE(^LAB(69.9,1,0),U,14):1,1:0)

 +22       IF $DATA(XRTL)

               SET XRTN="LRCAPPH"

               DO T0^%ZOSV

 +23       SET LRPKG=$ORDER(^DIC(9.4,"C","LR",0))

 +24       IF 'LRPKG

               SET LRPKG=$ORDER(^DIC(9.4,"B","LAB SERVICE",0))

 +25       IF 'LRPKG

               GOTO FIN

 +26       SET LRVSIT=$PIECE($GET(^LAB(69.9,1,"VSIT")),U)

 +27       SET X="PXAI"

           XECUTE ^%ZOSF("TEST")

           IF '$TEST

               GOTO FIN

 +28       IF '$GET(LRNP)

               SET $PIECE(^LAB(69.9,1,"NITE"),U,2)=$$NOW^XLFDT

 +29       SET LRPCEON=$$PKGON^VSIT("PX")

 +30       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