| [613] | 1 | LRCAPML1 ;SLC/AM/DALISC/FHS/J0 - WKLD COST REP BY MAJ SCTN; 2/6/91@16:04
|
|---|
| 2 | ;;5.2;LAB SERVICE;;Sep 27, 1994
|
|---|
| 3 | EN ;
|
|---|
| 4 | D INITMAN^LRCAPMR1
|
|---|
| 5 | S LRGETIN=$S(LRIN:0,1:1)
|
|---|
| 6 | F D BUILD Q:(LREND)!('LRLOOP)!(LRBLDONE)
|
|---|
| 7 | Q
|
|---|
| 8 | BUILD ; BUILD DATA SUBSET IN ^TMP
|
|---|
| 9 | D GTIN
|
|---|
| 10 | I 'LRIN S LRBLDONE=1 Q
|
|---|
| 11 | D GENCOM^LRCAPMR1,CAPCOM^LRCAPMR1
|
|---|
| 12 | S (LRAPIGT,LRAPIGTU,LRCPIGT,LRCPIGTU)=0
|
|---|
| 13 | S LRCDT=LRCDTB-1
|
|---|
| 14 | F S LRCDT=$O(^LRO(64.1,LRIN,1,LRCDT)) Q:(LRCDT>LRCDTE)!(LRCDT<1) D
|
|---|
| 15 | . D DATCOM^LRCAPMR1
|
|---|
| 16 | . W:$E(IOST,1,2)="C-" "."
|
|---|
| 17 | . S LRCC=0
|
|---|
| 18 | . F S LRCC=$O(^LRO(64.1,LRIN,1,LRCDT,1,LRCC)) Q:(LRCC<1) D CC
|
|---|
| 19 | S LRGTOTS=$G(^TMP("LR-WL",$J,0))
|
|---|
| 20 | S $P(LRGTOTS,U)=$P(LRGTOTS,U)+LRAPIGT+LRCPIGT
|
|---|
| 21 | S $P(LRGTOTS,U,2)=$P(LRGTOTS,U,2)+LRAPIGTU+LRCPIGTU
|
|---|
| 22 | S ^TMP("LR-WL",$J,0)=LRGTOTS
|
|---|
| 23 | S LRGTOTS=$G(^TMP("LR-WL",$J,"DIV","AP",LRIN,0))
|
|---|
| 24 | S $P(LRGTOTS,U)=$P(LRGTOTS,U)+LRAPIGT
|
|---|
| 25 | S $P(LRGTOTS,U,2)=$P(LRGTOTS,U,2)+LRAPIGTU
|
|---|
| 26 | S ^TMP("LR-WL",$J,"DIV","AP",LRIN,0)=LRGTOTS
|
|---|
| 27 | S LRGTOTS=$G(^TMP("LR-WL",$J,"DIV","CP",LRIN,0))
|
|---|
| 28 | S $P(LRGTOTS,U)=$P(LRGTOTS,U)+LRCPIGT
|
|---|
| 29 | S $P(LRGTOTS,U,2)=$P(LRGTOTS,U,2)+LRCPIGTU
|
|---|
| 30 | S ^TMP("LR-WL",$J,"DIV","CP",LRIN,0)=LRGTOTS
|
|---|
| 31 | Q
|
|---|
| 32 | CC ;
|
|---|
| 33 | S LRCAPNAM=$$WKLDNAME^LRCAPU(LRCC)
|
|---|
| 34 | D BMPMANL^LRCAPMR1
|
|---|
| 35 | S LRCTM=$S(LRCTMB=0:"",1:LRCTMB-.001),LRFIRST=1
|
|---|
| 36 | F S LRCTM=$O(^LRO(64.1,LRIN,1,LRCDT,1,LRCC,1,LRCTM)) Q:(LRCTM>LRCTME)!(LRCTM="") D TM
|
|---|
| 37 | Q
|
|---|
| 38 | TM ;
|
|---|
| 39 | Q:'($D(^LRO(64.1,LRIN,1,LRCDT,1,LRCC,1,LRCTM,0))#2)
|
|---|
| 40 | S LRX=^(0)
|
|---|
| 41 | S LRMA=$P(LRX,U,7)
|
|---|
| 42 | I LRAA Q:'$D(LRAA(LRMA))
|
|---|
| 43 | S LRUC=+$P(LRX,U,3),LRLDIV=$P(LRX,U,6),LRLSS=$P(LRX,U,8),LRSPEC=+$P(LRX,U,14)
|
|---|
| 44 | S:'LRUC LRUC=1
|
|---|
| 45 | S LRUW=+$P($G(^LAM(LRCC,0)),U,10),LRFIRST=0 S LRUWSP=+$P($G(^LAM(LRCC,5,LRSPEC,0)),U,2) S:LRUWSP LRUW=LRUWSP_"*" K LRUWSP
|
|---|
| 46 | S LRWC=LRUC*LRUW
|
|---|
| 47 | ;
|
|---|
| 48 | ;
|
|---|
| 49 | I +LRMA D
|
|---|
| 50 | . S LRREC=$G(^LRO(68,LRMA,0))
|
|---|
| 51 | . S LRMAA=$S($P(LRREC,U,11)]"":$P(LRREC,U,11),1:LRNDFN)
|
|---|
| 52 | . S LRMAN=$S($P(LRREC,U)]"":$P(LRREC,U),1:LRNDFN)
|
|---|
| 53 | . S LRMAN(LRMAA)=LRMAN
|
|---|
| 54 | I '+LRMA S (LRMAA,LRMAN)=LRNDFN,LRMAN(LRMAA)=LRMAN
|
|---|
| 55 | I +LRLSS D
|
|---|
| 56 | . S LRREC=$G(^LRO(68,LRLSS,0))
|
|---|
| 57 | . S LRLSSA=$S($P(LRREC,U,11)]"":$P(LRREC,U,11),1:LRNDFN)
|
|---|
| 58 | . S LRLSSN=$S($P(LRREC,U)]"":$P(LRREC,U),1:LRNDFN)
|
|---|
| 59 | . S LRLSSN(LRLSSA)=LRLSSN
|
|---|
| 60 | I '+LRLSS S (LRLSSA,LRLSSN)=LRNDFN,LRLSSN(LRLSSA)=LRLSSN
|
|---|
| 61 | ;
|
|---|
| 62 | ;
|
|---|
| 63 | I $D(^TMP("LR-WL",$J,"DIV",LRLDIV,LRIN,LRMAA,LRLSSA,LRCAPNAM))#2 S LRX=^(LRCAPNAM),LRX1=LRUC+$P(LRX,"^"),LRX2=LRWC+$P(LRX,"^",2),^(LRCAPNAM)=LRX1_"^"_LRX2_"^"_LRUW_"^"_LRCAPNUM
|
|---|
| 64 | E S ^TMP("LR-WL",$J,"DIV",LRLDIV,LRIN,LRMAA,LRLSSA,LRCAPNAM)=LRUC_"^"_LRWC_"^"_LRUW_"^"_LRCAPNUM
|
|---|
| 65 | I LRLDIV="AP" S LRAPIGT=LRAPIGT+LRWC,LRAPIGTU=LRAPIGTU+LRUC
|
|---|
| 66 | E S LRCPIGT=LRCPIGT+LRWC,LRCPIGTU=LRCPIGTU+LRUC
|
|---|
| 67 | I $D(^TMP("LR-WL",$J,"DIV",LRLDIV,LRIN,LRMAA,LRLSSA,0))#2 S LRX1=+$P(^(0),"^")+LRWC,LRX2=+$P(^(0),"^",2)+LRUC,^(0)=LRX1_"^"_LRX2
|
|---|
| 68 | E S ^TMP("LR-WL",$J,"DIV",LRLDIV,LRIN,LRMAA,LRLSSA,0)=LRWC_"^"_LRUC
|
|---|
| 69 | I $D(^TMP("LR-WL",$J,"AA",LRMAA,LRLSSA,0))#2 S LRX1=+$P(^(0),"^")+LRWC,LRX2=+$P(^(0),"^",2)+LRUC,^(0)=LRX1_"^"_LRX2
|
|---|
| 70 | E S ^TMP("LR-WL",$J,"AA",LRMAA,LRLSSA,0)=LRWC_"^"_LRUC
|
|---|
| 71 | Q
|
|---|
| 72 | GTIN ;
|
|---|
| 73 | S:LRGETIN LRIN=+$O(^LRO(64.1,LRIN))
|
|---|
| 74 | S:LRIN LRINN=$S($D(^DIC(4,LRIN,0))#2:$P(^DIC(4,LRIN,0),U),1:LRNDFN)
|
|---|
| 75 | S LRGETIN=1
|
|---|
| 76 | Q
|
|---|
