LRMITSPC ; IHS/DIR/FJE - MICRO TREND PROCESS COUNT 23:16 ;
;;5.2;LR;**1013**;JUL 15, 2002
;
;;5.2;LAB SERVICE;;Sep 27, 1994
; from LRMITSPE
; returns counts of isolates and susceptibilities in ^TMP($J,n1,"C"
;
S LRTYPE="" F S LRTYPE=$O(^TMP($J,"PAT",LRTYPE)) Q:LRTYPE="" D
.S (LRCNT,LRPATN)=0 F S LRPATN=$O(^TMP($J,"PAT",LRTYPE,LRPATN)) Q:LRPATN<1 S LRCNT=LRCNT+1
.S ^TMP($J,LRTYPE)=LRCNT
S LRN1=0 F S LRN1=$O(^TMP($J,"M",LRN1)) Q:LRN1<1 D Q:LREND
.I LRN1#10=0,$$S^%ZTLOAD S (LREND,ZTSTOP)=1 Q
.S (LROCNTC,LROCNTM,LROCNTN)=0
.S LRMCAT="" F S LRMCAT=$O(^TMP($J,"M",LRN1,LRMCAT)) Q:LRMCAT="" D
..K ^TMP($J,"MP")
..S LRCNT=0,LRNN3="" F S LRNN3=$O(^TMP($J,"M",LRN1,LRMCAT,LRNN3)) Q:LRNN3="" S LRX=^(LRNN3),LRN3=-LRNN3 D
...S LRN2=+LRX,LRCDATE=$P(LRX,U,2),LRSUBN=$P(LRX,U,3),LRCNT=LRCNT+1
...; setup non tested data
...I '$D(^TMP($J,LRN3)) S $P(^TMP($J,LRN2,LRCDATE,LRSUBN),U,5)="N",LROCNTN=LROCNTN+1 Q
...I '$D(^TMP($J,"MP")) D SETUP Q
...I LRMERGE="N" D SETUP Q
...D CHECK
.S ^TMP($J,LRN1,"C")=LROCNTC_U_LROCNTM_U_LROCNTN
K ^TMP($J,"MP"),^("PAT"),LRANTIN,LRANTINM,LRANTIV,LRCDATE,LRCNT,LRMARRAY,LRMCAT,LRMCNT,LRMDONE,LRN1,LRN2,LRN3,LRNN3,LROCNTC,LROCNTM,LROCNTN,LROK,LRPATN,LRSUBN,LRTYPE,LRX
Q
CHECK ; check data for merges
S (LRMDONE,LRMCNT)=0 F S LRMCNT=$O(^TMP($J,"MP",LRMCNT)) Q:LRMCNT<1 D Q:LRMDONE
.K LRMARRAY S LROK=1,LRANTINM="" F S LRANTINM=$O(^TMP($J,LRN3,"A",LRANTINM)) Q:LRANTINM="" S LRANTIV=$P(^(LRANTINM),U) D Q:'LROK
..I '$D(^TMP($J,"MP",LRMCNT,LRANTINM)) S LRMARRAY(LRANTINM)=LRANTIV Q
..I LRANTIV'=^TMP($J,"MP",LRMCNT,LRANTINM) S LROK=0 Q
.I LROK S LRMDONE=1 D Q
..S LRANTINM=0 F S LRANTINM=$O(LRMARRAY(LRANTINM)) Q:LRANTINM<1 D ABCOUNT(LRN1,LRMCNT,LRANTINM,LRMARRAY(LRANTINM))
; setup merged data
I LRMDONE S $P(^TMP($J,LRN2,LRCDATE,LRSUBN),U,5)="M",LROCNTM=LROCNTM+1 Q
I 'LRMDONE D SETUP
Q
SETUP ; setup tested data
S $P(^TMP($J,LRN2,LRCDATE,LRSUBN),U,5)="T",LROCNTC=LROCNTC+1
S LRANTINM="" F S LRANTINM=$O(^TMP($J,LRN3,"A",LRANTINM)) Q:LRANTINM="" S LRANTIV=$P(^(LRANTINM),U) D
.D ABCOUNT(LRN1,LRCNT,LRANTINM,LRANTIV)
Q
ABCOUNT(N1,CNT,ABREV,AVALUE) ; count data, setup merge pattern
N LRX
S LRX=$G(^TMP($J,N1,"C",ABREV)),^(ABREV)=($P(LRX,U)+1)_U_($P(LRX,U,2)+$S(AVALUE["S":1,1:0))
S ^TMP($J,"MP",CNT,ABREV)=AVALUE
Q
LRMITSPC ; IHS/DIR/FJE - MICRO TREND PROCESS COUNT 23:16 ;
+1 ;;5.2;LR;**1013**;JUL 15, 2002
+2 ;
+3 ;;5.2;LAB SERVICE;;Sep 27, 1994
+4 ; from LRMITSPE
+5 ; returns counts of isolates and susceptibilities in ^TMP($J,n1,"C"
+6 ;
+7 SET LRTYPE=""
FOR
SET LRTYPE=$ORDER(^TMP($JOB,"PAT",LRTYPE))
IF LRTYPE=""
QUIT
Begin DoDot:1
+8 SET (LRCNT,LRPATN)=0
FOR
SET LRPATN=$ORDER(^TMP($JOB,"PAT",LRTYPE,LRPATN))
IF LRPATN<1
QUIT
SET LRCNT=LRCNT+1
+9 SET ^TMP($JOB,LRTYPE)=LRCNT
End DoDot:1
+10 SET LRN1=0
FOR
SET LRN1=$ORDER(^TMP($JOB,"M",LRN1))
IF LRN1<1
QUIT
Begin DoDot:1
+11 IF LRN1#10=0
IF $$S^%ZTLOAD
SET (LREND,ZTSTOP)=1
QUIT
+12 SET (LROCNTC,LROCNTM,LROCNTN)=0
+13 SET LRMCAT=""
FOR
SET LRMCAT=$ORDER(^TMP($JOB,"M",LRN1,LRMCAT))
IF LRMCAT=""
QUIT
Begin DoDot:2
+14 KILL ^TMP($JOB,"MP")
+15 SET LRCNT=0
SET LRNN3=""
FOR
SET LRNN3=$ORDER(^TMP($JOB,"M",LRN1,LRMCAT,LRNN3))
IF LRNN3=""
QUIT
SET LRX=^(LRNN3)
SET LRN3=-LRNN3
Begin DoDot:3
+16 SET LRN2=+LRX
SET LRCDATE=$PIECE(LRX,U,2)
SET LRSUBN=$PIECE(LRX,U,3)
SET LRCNT=LRCNT+1
+17 ; setup non tested data
+18 IF '$DATA(^TMP($JOB,LRN3))
SET $PIECE(^TMP($JOB,LRN2,LRCDATE,LRSUBN),U,5)="N"
SET LROCNTN=LROCNTN+1
QUIT
+19 IF '$DATA(^TMP($JOB,"MP"))
DO SETUP
QUIT
+20 IF LRMERGE="N"
DO SETUP
QUIT
+21 DO CHECK
End DoDot:3
End DoDot:2
+22 SET ^TMP($JOB,LRN1,"C")=LROCNTC_U_LROCNTM_U_LROCNTN
End DoDot:1
IF LREND
QUIT
+23 KILL ^TMP($JOB,"MP"),^("PAT"),LRANTIN,LRANTINM,LRANTIV,LRCDATE,LRCNT,LRMARRAY,LRMCAT,LRMCNT,LRMDONE,LRN1,LRN2,LRN3,LRNN3,LROCNTC,LROCNTM,LROCNTN,LROK,LRPATN,LRSUBN,LRTYPE,LRX
+24 QUIT
CHECK ; check data for merges
+1 SET (LRMDONE,LRMCNT)=0
FOR
SET LRMCNT=$ORDER(^TMP($JOB,"MP",LRMCNT))
IF LRMCNT<1
QUIT
Begin DoDot:1
+2 KILL LRMARRAY
SET LROK=1
SET LRANTINM=""
FOR
SET LRANTINM=$ORDER(^TMP($JOB,LRN3,"A",LRANTINM))
IF LRANTINM=""
QUIT
SET LRANTIV=$PIECE(^(LRANTINM),U)
Begin DoDot:2
+3 IF '$DATA(^TMP($JOB,"MP",LRMCNT,LRANTINM))
SET LRMARRAY(LRANTINM)=LRANTIV
QUIT
+4 IF LRANTIV'=^TMP($JOB,"MP",LRMCNT,LRANTINM)
SET LROK=0
QUIT
End DoDot:2
IF 'LROK
QUIT
+5 IF LROK
SET LRMDONE=1
Begin DoDot:2
+6 SET LRANTINM=0
FOR
SET LRANTINM=$ORDER(LRMARRAY(LRANTINM))
IF LRANTINM<1
QUIT
DO ABCOUNT(LRN1,LRMCNT,LRANTINM,LRMARRAY(LRANTINM))
End DoDot:2
QUIT
End DoDot:1
IF LRMDONE
QUIT
+7 ; setup merged data
+8 IF LRMDONE
SET $PIECE(^TMP($JOB,LRN2,LRCDATE,LRSUBN),U,5)="M"
SET LROCNTM=LROCNTM+1
QUIT
+9 IF 'LRMDONE
DO SETUP
+10 QUIT
SETUP ; setup tested data
+1 SET $PIECE(^TMP($JOB,LRN2,LRCDATE,LRSUBN),U,5)="T"
SET LROCNTC=LROCNTC+1
+2 SET LRANTINM=""
FOR
SET LRANTINM=$ORDER(^TMP($JOB,LRN3,"A",LRANTINM))
IF LRANTINM=""
QUIT
SET LRANTIV=$PIECE(^(LRANTINM),U)
Begin DoDot:1
+3 DO ABCOUNT(LRN1,LRCNT,LRANTINM,LRANTIV)
End DoDot:1
+4 QUIT
ABCOUNT(N1,CNT,ABREV,AVALUE) ; count data, setup merge pattern
+1 NEW LRX
+2 SET LRX=$GET(^TMP($JOB,N1,"C",ABREV))
SET ^(ABREV)=($PIECE(LRX,U)+1)_U_($PIECE(LRX,U,2)+$SELECT(AVALUE["S":1,1:0))
+3 SET ^TMP($JOB,"MP",CNT,ABREV)=AVALUE
+4 QUIT
