- 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
