99 lines
3.6 KiB
Mathematica
99 lines
3.6 KiB
Mathematica
LRCAPMA1 ;SLC/AM/DALISC/FHS/J0 - WKLD REPORT BY MAJ SCTN; 2/6/91
|
|
;;5.2;LAB SERVICE;**105,119**;Sep 27, 1994
|
|
EN ;
|
|
D INITMAN^LRCAPMR1
|
|
S LRGETIN=$S(LRIN:0,1:1)
|
|
F D BUILD Q:(LREND)!('LRLOOP)!(LRBLDONE)
|
|
Q
|
|
BUILD ; BUILD DATA SUBSET IN ^TMP
|
|
D GTIN
|
|
I 'LRIN S LRBLDONE=1 Q
|
|
D GENCOM^LRCAPMR1,CAPCOM^LRCAPMR1
|
|
S (LRAPICGT,LRAPIIGT,LRAPIOGT,LRAPINGT)=0
|
|
S (LRCPICGT,LRCPIIGT,LRCPIOGT,LRCPINGT)=0
|
|
S LRCDT=LRCDTB-1
|
|
F S LRCDT=$O(^LRO(64.1,LRIN,1,LRCDT)) Q:(LRCDT>LRCDTE)!(LRCDT<1) D
|
|
. D DATCOM^LRCAPMR1
|
|
. W:$E(IOST,1,2)="C-" "."
|
|
. S LRCC=0
|
|
. F S LRCC=$O(^LRO(64.1,LRIN,1,LRCDT,1,LRCC)) Q:(LRCC<1) D CC
|
|
S LRGTOTS=$G(^TMP("LR-WL",$J,0))
|
|
S $P(LRGTOTS,U)=$P(LRGTOTS,U)+LRAPICGT+LRCPICGT
|
|
S $P(LRGTOTS,U,2)=$P(LRGTOTS,U,2)+LRAPIIGT+LRCPIIGT
|
|
S $P(LRGTOTS,U,3)=$P(LRGTOTS,U,3)+LRAPIOGT+LRCPIOGT
|
|
S $P(LRGTOTS,U,4)=$P(LRGTOTS,U,4)+LRAPINGT+LRCPINGT
|
|
S ^TMP("LR-WL",$J,0)=LRGTOTS
|
|
S LRGTOTS=$G(^TMP("LR-WL",$J,"DIV","AP",LRIN,0))
|
|
S $P(LRGTOTS,U)=$P(LRGTOTS,U)+LRAPICGT
|
|
S $P(LRGTOTS,U,2)=$P(LRGTOTS,U,2)+LRAPIIGT
|
|
S $P(LRGTOTS,U,3)=$P(LRGTOTS,U,3)+LRAPIOGT
|
|
S $P(LRGTOTS,U,4)=$P(LRGTOTS,U,4)+LRAPINGT
|
|
S ^TMP("LR-WL",$J,"DIV","AP",LRIN,0)=LRGTOTS
|
|
S LRGTOTS=$G(^TMP("LR-WL",$J,"DIV","CP",LRIN,0))
|
|
S $P(LRGTOTS,U)=$P(LRGTOTS,U)+LRCPICGT
|
|
S $P(LRGTOTS,U,2)=$P(LRGTOTS,U,2)+LRCPIIGT
|
|
S $P(LRGTOTS,U,3)=$P(LRGTOTS,U,3)+LRCPIOGT
|
|
S $P(LRGTOTS,U,4)=$P(LRGTOTS,U,4)+LRCPINGT
|
|
S ^TMP("LR-WL",$J,"DIV","CP",LRIN,0)=LRGTOTS
|
|
Q
|
|
CC ;
|
|
S LRCAPNAM=$$WKLDNAME^LRCAPU(LRCC)
|
|
D BMPMANL^LRCAPMR1
|
|
S LRCTM=$S(LRCTMB=0:"",1:LRCTMB-.001)
|
|
F S LRCTM=$O(^LRO(64.1,LRIN,1,LRCDT,1,LRCC,1,LRCTM)) Q:(LRCTM>LRCTME)!(LRCTM="") D TM
|
|
Q
|
|
TM ;
|
|
Q:'($D(^LRO(64.1,LRIN,1,LRCDT,1,LRCC,1,LRCTM,0))#2)
|
|
S LRX=^(0)
|
|
S LRMA=+$P(LRX,U,7)
|
|
I LRAA Q:'$D(LRAA(LRMA))
|
|
S LRUC=+$P(LRX,U,3),LRLDIV=$P(LRX,U,6),LRLSS=$P(LRX,U,8) S:LRLDIV="" LRLDIV="CP"
|
|
S:'LRUC LRUC=1
|
|
S LRTYP=$$CHKTYP(LRX) Q:'LRTYP
|
|
I +LRMA D
|
|
. S LRREC=$G(^LRO(68,LRMA,0))
|
|
. S LRMAA=$S($P(LRREC,U,11)]"":$P(LRREC,U,11),1:LRNDFN)
|
|
. S LRMAN=$S($P(LRREC,U)]"":$P(LRREC,U),1:LRNDFN)
|
|
. S LRMAN(LRMAA)=LRMAN
|
|
I '+LRMA S (LRMAA,LRMAN)=LRNDFN,LRMAN(LRMAA)=LRMAN
|
|
I +LRLSS D
|
|
. S LRREC=$G(^LRO(68,LRLSS,0))
|
|
. S LRLSSA=$S($P(LRREC,U,11)]"":$P(LRREC,U,11),1:LRNDFN)
|
|
. S LRLSSN=$S($P(LRREC,U)]"":$P(LRREC,U),1:LRNDFN)
|
|
. S LRLSSN(LRLSSA)=LRLSSN
|
|
I '+LRLSS S (LRLSSA,LRLSSN)=LRNDFN,LRLSSN(LRLSSA)=LRLSSN
|
|
I $D(^TMP("LR-WL",$J,"DIV",LRLDIV,LRIN,LRMAA,LRLSSA,LRCAPNAM))#2 D
|
|
. S $P(^(LRCAPNAM),U,LRTYP)=$P(^TMP("LR-WL",$J,"DIV",LRLDIV,LRIN,LRMAA,LRLSSA,LRCAPNAM),U,LRTYP)+LRUC
|
|
E D
|
|
. S $P(^TMP("LR-WL",$J,"DIV",LRLDIV,LRIN,LRMAA,LRLSSA,LRCAPNAM),U,LRTYP)=LRUC
|
|
. S $P(^TMP("LR-WL",$J,"DIV",LRLDIV,LRIN,LRMAA,LRLSSA,LRCAPNAM),U,5)=LRCAPNUM
|
|
I LRLDIV="AP" D
|
|
. S LRGT=$S(LRTYP=1:"LRAPICGT",LRTYP=2:"LRAPIIGT",LRTYP=3:"LRAPIOGT",1:"LRAPINGT")
|
|
. S @LRGT=@LRGT+LRUC
|
|
E D
|
|
. S LRGT=$S(LRTYP=1:"LRCPICGT",LRTYP=2:"LRCPIIGT",LRTYP=3:"LRCPIOGT",1:"LRCPINGT")
|
|
. S @LRGT=@LRGT+LRUC
|
|
I $D(^TMP("LR-WL",$J,"DIV",LRLDIV,LRIN,LRMAA,LRLSSA,0))#2 D
|
|
. S $P(^(0),U,LRTYP)=$P(^TMP("LR-WL",$J,"DIV",LRLDIV,LRIN,LRMAA,LRLSSA,0),U,LRTYP)+LRUC
|
|
E D
|
|
. S $P(^TMP("LR-WL",$J,"DIV",LRLDIV,LRIN,LRMAA,LRLSSA,0),U,LRTYP)=LRUC
|
|
I $D(^TMP("LR-WL",$J,"AA",LRMAA,LRLSSA,0))#2 D
|
|
. S $P(^(0),U,LRTYP)=$P(^TMP("LR-WL",$J,"AA",LRMAA,LRLSSA,0),U,LRTYP)+LRUC
|
|
E D
|
|
. S $P(^TMP("LR-WL",$J,"AA",LRMAA,LRLSSA,0),U,LRTYP)=LRUC
|
|
Q
|
|
GTIN ;
|
|
S:LRGETIN LRIN=+$O(^LRO(64.1,LRIN))
|
|
S:LRIN LRINN=$S($D(^DIC(4,LRIN,0))#2:$P(^DIC(4,LRIN,0),U),1:LRNDFN)
|
|
S LRGETIN=1
|
|
Q
|
|
CHKTYP(LRREC) ;
|
|
N LRFIL,LRLTYP
|
|
S LRFIL=$P(LRREC,U,10),LRFIL=$P(LRFIL,";",2)
|
|
S LRLTYP=$P(LRREC,U,19)
|
|
S:LRFIL="" LRFIL=" " S:LRLTYP="" LRLTYP=" "
|
|
Q:LRFIL="LAB(62.3," 1
|
|
Q:((LRFIL="DPT(")&("ORW"[LRLTYP)) 2
|
|
Q:LRFIL="DPT(" 3
|
|
Q 4
|