source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LRCAPDSS.m@ 1169

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

initial load of FOIAVistA 6/30/08 version

File size: 3.0 KB
Line 
1LRCAPDSS ;DALISC/FHS-LAB WORKLOAD DSS EXTRACT (LMIP) ;5/2/91 09:03
2 ;;5.2;LAB SERVICE;**127,143,201,221**;Sep 27, 1994
3 ;ECX*3 compatible
4EN ;
5 ; Call with Start Date (LRSDT) End Date (LREDT) FileMan format
6 ; Calling routine should have already purged ^LRO(64.03)
7 S:$D(ZTQUEUED) ZTREQ="@"
8 I $S($G(LRSDT)'?7N:1,$G(LREDT)'?7N:1,1:0) Q
9 N X,I
10 L +^LRO(64.03):10 G:'$T END
11 I LRSDT>LREDT S X=LRSDT,LRSDT=LREDT,LREDT=X
12 S LRX1=(9999999-LRSDT),LRX2=(9999999-LREDT)-1
13 S LREDT0=LREDT,X1=LREDT,X2="+35" D C^%DTC S LREDT=X
14 S LRSDT0=LRSDT,LRSDT=LRSDT-".9999"
15 ;Q
16 S LRDPROV=$P($G(^LAB(69.9,1,12)),U) G END:'LRDPROV S $P(^("NITE"),U,6)=""
17 S:'$D(^LRO(64.03,0))#2 ^LRO(64.03,0)="WKLD LOG FILE^64.03^"
18 S LRNOW=$$NOW^XLFDT
19 S LRDSS0=^LRO(64.03,0),LRSNODE=$S($P(LRDSS0,U,3):$P(LRDSS0,U,3),1:1) F LRSNODE=LRSNODE:1 Q:'$D(^LRO(64.03,LRSNODE,0))
20 S ^LRO(64.03,LRSNODE,0)=LRSNODE,^(1,0)="^64.317DA^1^1",^(1,0)=LRNOW_U_LRSDT0_U_LREDT0_U_U_$G(DUZ)
21 S ^LRO(64.03,"B",LRNOW,LRSNODE,1)=""
22INST S LRSDTX=LRSDT,LRIN=0 F S LRIN=$O(^LRO(64.1,LRIN)) Q:LRIN<1 D
23 . S LRSDT=LRSDTX-.0001 F S LRSDT=$O(^LRO(64.1,LRIN,1,LRSDT)) Q:LRSDT<1!(LRSDT>LREDT) D
24 . . S LRCC=0 F S LRCC=$O(^LRO(64.1,LRIN,1,LRSDT,1,LRCC)) Q:LRCC<1 S LRCCX=$G(^LAM(LRCC,0)) D
25 . . . Q:$P($G(LRCCX),U,2)'?5N1"."4N.5N Q:$S($P(LRCCX,U,5):0,$P(LRCCX,U,16):0,+$P(LRCCX,".",2)=9999:0,$E($P(LRCCX,".",2))=8:0,1:1)
26 . . . S LRTM=0 F S LRTM=$O(^LRO(64.1,LRIN,1,LRSDT,1,LRCC,1,LRTM)) Q:LRTM'>0 I $D(^(LRTM,0)) D SET
27 S $P(^LRO(64.03,LRSNODE,1,1,0),U,4)=$$NOW^XLFDT
28END ;
29 L -^LRO(64.03) Q:$G(LRDBUG)
30 K DFN,LRAA,LRACCDT,LRACCN,LRCC,LRCCX,LRDSS,LRDSS0,LREDT,LRIDT,LRIN
31 K LRLOC,LRLOCN,LRLOCTY,LRODT,LRPROV,LRSDT,LRSDTX,LRSNODE,LRSPEC,LRSTR,LRTEST
32 K LRTIM,LRTM,LRTS,LRURG,LRX,LRN0,LRNX,X,LRMULT,LREDT0,LRSDT0,LRNOW,LRX1
33 K LRX2,X1,X2,LRPFILE
34 Q
35SET ;
36 S LRSTR=$G(^LRO(64.1,LRIN,1,LRSDT,1,LRCC,1,LRTM,0))
37 S LRPFILE=$P($P(LRSTR,U,10),";",2) Q:$S(LRPFILE="LRT(67,":0,LRPFILE="DPT(":0,LRPFILE="LRT(67.1,":0,1:1)
38 S LRIDT=$P(LRSTR,U,22)
39 I '$G(LRDBUG),$S(LRIDT>LRX1:1,LRIDT<LRX2:1,1:0) Q
40 S X=LRSTR,LRTEST=$P(X,U,2),LRMULT=$S($P(X,U,3):$P(X,U,3),1:1),LRAA=$P(X,U,7)
41 S LRACCN=$P(X,U,9),DFN=$P(X,U,10),LRACCDT=$P(X,U,11),LRODT=$P(X,U,12)
42 S LRSPEC=$P(X,U,14),LRLOCN=$P(X,U,15)
43 S LRTS=$P(X,U,17)
44 S LRLOCTY=$P(X,U,19),LRURG=$P(X,U,23)
45 S LRTIM=9999999-LRIDT D
46 . I $P($G(^LRO(68,LRAA,0)),U,21) S (LRLOC,LROCTY)="" Q
47 . S LRLOC=$P(X,U,21) S:LRLOC LRLOC=LRLOC_";SC("
48 S LRPROV=$P(X,U,16)
49 I 'LRLOC,LRPFILE="LRT(67,",$P(LRPROV,":",2) S LRLOC=$P(LRPROV,":",2)_";DIC(4,"
50 S:'LRPROV LRPROV=LRDPROV
51 S LRX=LRPROV_U_DFN_U_LRSDT_U_LRIN_U_LRLOCTY_U_LRAA_U_LRTEST_U_LRURG
52 S LRX=LRX_U_LRTS_U_LRCC_U_LRIDT_U_LRTIM_U_LRODT_U_LRLOC_U_LRACCN_U_LRSPEC
53 I LRMULT>0 F I=1:1:LRMULT D NEXT
54 Q
55NEXT S LRN0=^LRO(64.03,0),LRNX=$S($P(LRN0,U,3):$P(LRN0,U,3),1:1) F LRNX=LRNX:1 Q:'$D(^LRO(64.03,LRNX,0))
56 S $P(LRN0,U,3)=LRNX,$P(LRN0,U,4)=$P(LRN0,U,4)+1,^LRO(64.03,0)=LRN0
57 S ^LRO(64.03,LRNX,0)=LRNX_U_LRX
58 Q
59LOOP S LRDPROV=$P(^LAB(69.9,1,12),U),LRDBUG=1
60 S LRTM=0 F S LRTM=$O(^LRO(64.1,LRIN,1,LRSDT,1,LRCC,1,LRTM)) Q:LRTM<1 D SET
61 K LRDBUG
62 Q
Note: See TracBrowser for help on using the repository browser.