source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRCAPPHX.m@ 836

Last change on this file since 836 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.1 KB
RevLine 
[613]1LRCAPPHX ;DALOI/FHS - RESET AND RESUBMIT PCE WORKLOAD FOR EMPTY PCE NODES ;5/1/2001
2 ;;5.2;LAB SERVICE;**278**;Sep 27, 1994
3EN ;
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
11DATE ;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
20SW ;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
24LOOP ;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
36SET ;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
43RD ;
44 S LREND=0
45 I $D(DUOUT)!($D(DTOUT))!($D(DIRUT)) S LREND=1
46 Q
47END ;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)=""
75AA ;
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)
85FIN 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
95LOOK ;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
107DQ ;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
Note: See TracBrowser for help on using the repository browser.