- LRMITSPC ;SLC/STAFF - MICRO TREND PROCESS COUNT ;10/17/92 23:16
- ;;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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRMITSPC 2314 printed Feb 18, 2025@23:43:26 Page 2
- LRMITSPC ;SLC/STAFF - MICRO TREND PROCESS COUNT ;10/17/92 23:16
- +1 ;;5.2;LAB SERVICE;;Sep 27, 1994
- +2 ; from LRMITSPE
- +3 ; returns counts of isolates and susceptibilities in ^TMP($J,n1,"C"
- +4 ;
- +5 SET LRTYPE=""
- FOR
- SET LRTYPE=$ORDER(^TMP($JOB,"PAT",LRTYPE))
- if LRTYPE=""
- QUIT
- Begin DoDot:1
- +6 SET (LRCNT,LRPATN)=0
- FOR
- SET LRPATN=$ORDER(^TMP($JOB,"PAT",LRTYPE,LRPATN))
- if LRPATN<1
- QUIT
- SET LRCNT=LRCNT+1
- +7 SET ^TMP($JOB,LRTYPE)=LRCNT
- End DoDot:1
- +8 SET LRN1=0
- FOR
- SET LRN1=$ORDER(^TMP($JOB,"M",LRN1))
- if LRN1<1
- QUIT
- Begin DoDot:1
- +9 IF LRN1#10=0
- IF $$S^%ZTLOAD
- SET (LREND,ZTSTOP)=1
- QUIT
- +10 SET (LROCNTC,LROCNTM,LROCNTN)=0
- +11 SET LRMCAT=""
- FOR
- SET LRMCAT=$ORDER(^TMP($JOB,"M",LRN1,LRMCAT))
- if LRMCAT=""
- QUIT
- Begin DoDot:2
- +12 KILL ^TMP($JOB,"MP")
- +13 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
- +14 SET LRN2=+LRX
- SET LRCDATE=$PIECE(LRX,U,2)
- SET LRSUBN=$PIECE(LRX,U,3)
- SET LRCNT=LRCNT+1
- +15 ; setup non tested data
- +16 IF '$DATA(^TMP($JOB,LRN3))
- SET $PIECE(^TMP($JOB,LRN2,LRCDATE,LRSUBN),U,5)="N"
- SET LROCNTN=LROCNTN+1
- QUIT
- +17 IF '$DATA(^TMP($JOB,"MP"))
- DO SETUP
- QUIT
- +18 IF LRMERGE="N"
- DO SETUP
- QUIT
- +19 DO CHECK
- End DoDot:3
- End DoDot:2
- +20 SET ^TMP($JOB,LRN1,"C")=LROCNTC_U_LROCNTM_U_LROCNTN
- End DoDot:1
- if LREND
- QUIT
- +21 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
- +22 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
