LRMITRZ2.m

LRMITRZ2 ;AVAMC/REG,SLC/BA- MICRO TREND SHEET CONTINUED ; 2/19/87  8:14 AM ;

 ;;V~5.0~;LAB;;02/27/90 17:09

 ;from LRMITRZ1

XREF S LRDFN=0 F LRPAT=0:1 S LRDFN=$O(^UTILITY($J,"M",LRDFN)) Q:LRDFN=""!(LRDFN<1)  D CHECK

 S ^UTILITY($J,0)=LRPAT_U_"PATIENTS"

 F X=0:0 S X=$O(^UTILITY($J,"BG",X)) Q:X=""  S LRND=^LAB(61.2,X,0),^UTILITY($J,"B",$S($L($P(LRND,U,3)):$P(LRND,U,3),1:" ")_$E($P(LRND,U),1,28),X)=""

 D ^LRMITRZ3

 Q

CHECK S LRTYPE="SSP",LRBA="BAS" D TYPE

 I LRM("L")'="N" S LRTYPE="LOC",LRBA="BAL" D TYPE

 I LRM("D")'="N" S LRTYPE="DOC",LRBA="BAD" D TYPE

 I LRM("P")'="N" S LRTYPE="PAT",LRBA="BAP" D TYPE

 I LRM("C")'="N" S LRTYPE="COL",LRBA="BAC" D TYPE

 Q

TYPE S LRST=0 F I=0:0 S LRST=$O(^UTILITY($J,"M",LRDFN,LRTYPE,LRST)) Q:LRST=""  D SEQ

 Q

SEQ S LRT=$E(LRTYPE,1)_"T" S:'$D(^UTILITY($J,LRT,LRST)) ^UTILITY($J,LRT,LRST)=0 S ^UTILITY($J,LRT,LRST)=^UTILITY($J,LRT,LRST)+1

 S LRSEQ=0 F I=0:0 S LRSEQ=$O(^UTILITY($J,"M",LRDFN,LRTYPE,LRST,LRSEQ)) Q:LRSEQ=""  D BG

 Q

BG S LRBG=0 F I=0:0 S LRBG=$O(^UTILITY($J,LRSEQ,LRBG)) Q:LRBG=""  S:'$D(^UTILITY($J,"BG",LRBG)) ^(LRBG)=0 S LRT=$E(LRTYPE,1)_"TB" S:'$D(^UTILITY($J,LRT,LRST,LRBG)) ^(LRBG)=0 D NUM

 Q

NUM S LRNUM=0 F I=0:0 S LRNUM=$O(^UTILITY($J,LRSEQ,LRBG,LRNUM)) Q:LRNUM=""  S:LRTYPE="SSP" ^UTILITY($J,"BG",LRBG)=^UTILITY($J,"BG",LRBG)+1 S LRT=$E(LRTYPE,1)_"TB",^UTILITY($J,LRT,LRST,LRBG)=^UTILITY($J,LRT,LRST,LRBG)+1 D AB

 Q

AB S LRND=0 F I=0:0 S LRND=$O(^UTILITY($J,LRSEQ,LRBG,LRNUM,LRND)) Q:LRND=""  S C=1,LRYY=$P(^(LRND),U),S=$S(LRYY="S":1,1:0) S:'$D(^UTILITY($J,LRBA,LRBG,LRND)) ^(LRND)=0 S LRT=$E(LRTYPE,1)_"BA" D S

 Q

S S:'$D(^UTILITY($J,LRT,LRST,LRBG,LRND)) ^(LRND)=0 S LRNO=^UTILITY($J,LRBA,LRBG,LRND),^UTILITY($J,LRBA,LRBG,LRND)=+LRNO+C_U_($P(LRNO,U,2)+S)

 S LRNO=^UTILITY($J,LRT,LRST,LRBG,LRND),^UTILITY($J,LRT,LRST,LRBG,LRND)=+LRNO+C_U_($P(LRNO,U,2)+S)

 Q

LRMITRZ2  ;AVAMC/REG,SLC/BA- MICRO TREND SHEET CONTINUED ; 2/19/87  8:14 AM ;

 +1       ;;V~5.0~;LAB;;02/27/90 17:09

 +2       ;from LRMITRZ1

XREF       SET LRDFN=0

           FOR LRPAT=0:1

               SET LRDFN=$ORDER(^UTILITY($JOB,"M",LRDFN))

               IF LRDFN=""!(LRDFN<1)

                   QUIT 

               DO CHECK

 +1        SET ^UTILITY($JOB,0)=LRPAT_U_"PATIENTS"

 +2        FOR X=0:0

               SET X=$ORDER(^UTILITY($JOB,"BG",X))

               IF X=""

                   QUIT 

               SET LRND=^LAB(61.2,X,0)

               SET ^UTILITY($JOB,"B",$SELECT($LENGTH($PIECE(LRND,U,3)):$PIECE(LRND,U,3),1:" ")_$EXTRACT($PIECE(LRND,U),1,28),X)=""

 +3        DO ^LRMITRZ3

 +4        QUIT 

CHECK      SET LRTYPE="SSP"

           SET LRBA="BAS"

           DO TYPE

 +1        IF LRM("L")'="N"

               SET LRTYPE="LOC"

               SET LRBA="BAL"

               DO TYPE

 +2        IF LRM("D")'="N"

               SET LRTYPE="DOC"

               SET LRBA="BAD"

               DO TYPE

 +3        IF LRM("P")'="N"

               SET LRTYPE="PAT"

               SET LRBA="BAP"

               DO TYPE

 +4        IF LRM("C")'="N"

               SET LRTYPE="COL"

               SET LRBA="BAC"

               DO TYPE

 +5        QUIT 

TYPE       SET LRST=0

           FOR I=0:0

               SET LRST=$ORDER(^UTILITY($JOB,"M",LRDFN,LRTYPE,LRST))

               IF LRST=""

                   QUIT 

               DO SEQ

 +1        QUIT 

SEQ        SET LRT=$EXTRACT(LRTYPE,1)_"T"

           IF '$DATA(^UTILITY($JOB,LRT,LRST))

               SET ^UTILITY($JOB,LRT,LRST)=0

           SET ^UTILITY($JOB,LRT,LRST)=^UTILITY($JOB,LRT,LRST)+1

 +1        SET LRSEQ=0

           FOR I=0:0

               SET LRSEQ=$ORDER(^UTILITY($JOB,"M",LRDFN,LRTYPE,LRST,LRSEQ))

               IF LRSEQ=""

                   QUIT 

               DO BG

 +2        QUIT 

BG         SET LRBG=0

           FOR I=0:0

               SET LRBG=$ORDER(^UTILITY($JOB,LRSEQ,LRBG))

               IF LRBG=""

                   QUIT 

               IF '$DATA(^UTILITY($JOB,"BG",LRBG))

                   SET ^(LRBG)=0

               SET LRT=$EXTRACT(LRTYPE,1)_"TB"

               IF '$DATA(^UTILITY($JOB,LRT,LRST,LRBG))

                   SET ^(LRBG)=0

               DO NUM

 +1        QUIT 

NUM        SET LRNUM=0

           FOR I=0:0

               SET LRNUM=$ORDER(^UTILITY($JOB,LRSEQ,LRBG,LRNUM))

               IF LRNUM=""

                   QUIT 

               IF LRTYPE="SSP"

                   SET ^UTILITY($JOB,"BG",LRBG)=^UTILITY($JOB,"BG",LRBG)+1

               SET LRT=$EXTRACT(LRTYPE,1)_"TB"

               SET ^UTILITY($JOB,LRT,LRST,LRBG)=^UTILITY($JOB,LRT,LRST,LRBG)+1

               DO AB

 +1        QUIT 

AB         SET LRND=0

           FOR I=0:0

               SET LRND=$ORDER(^UTILITY($JOB,LRSEQ,LRBG,LRNUM,LRND))

               IF LRND=""

                   QUIT 

               SET C=1

               SET LRYY=$PIECE(^(LRND),U)

               SET S=$SELECT(LRYY="S":1,1:0)

               IF '$DATA(^UTILITY($JOB,LRBA,LRBG,LRND))

                   SET ^(LRND)=0

               SET LRT=$EXTRACT(LRTYPE,1)_"BA"

               DO S

 +1        QUIT 

S          IF '$DATA(^UTILITY($JOB,LRT,LRST,LRBG,LRND))

               SET ^(LRND)=0

           SET LRNO=^UTILITY($JOB,LRBA,LRBG,LRND)

           SET ^UTILITY($JOB,LRBA,LRBG,LRND)=+LRNO+C_U_($PIECE(LRNO,U,2)+S)

 +1        SET LRNO=^UTILITY($JOB,LRT,LRST,LRBG,LRND)

           SET ^UTILITY($JOB,LRT,LRST,LRBG,LRND)=+LRNO+C_U_($PIECE(LRNO,U,2)+S)

 +2        QUIT