LR7OGMM ;SLC/STAFF- Interim report rpc memo micro ;7/16/09 16:06
;;5.2;LAB SERVICE;**187,312,364,395**;Sep 27, 1994;Build 27
;
MI(LRDFN,IDT,MICROSUB,ALL,OUTCNT,FORMAT,DONE,SKIP) ; from LR7OGM
N MISUB,OK,ZERO,INEXACT,DISPDATE,XDT,UID,ACC,AREA,ACDT
I '$D(^LR(LRDFN,"MI",IDT)) Q
S UID=$P($G(^LR(LRDFN,"MI",IDT,"ORU")),"^")
I UID'="" S UID=$$CHECKUID^LRWU4(UID)
I 'UID,'$P($G(^LR(LRDFN,"MI",IDT,0)),"^",3) S SKIP=1 Q
S AREA=$P(UID,"^",2),ACDT=$P(UID,"^",3),NUM=$P(UID,"^",4)
S OK=ALL
I 'OK S MISUB=0 F S MISUB=+$O(MICROSUB(MISUB)) Q:MISUB<1 I $D(^LR(LRDFN,"MI",IDT,MISUB)) S OK=1 Q
D ACC
I 'OK Q
I $G(FORMAT) D
. S XDT=9999999-IDT
. S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)="^MI^"_XDT D
.. ; determine if collection time is "inexact" and put the
.. ; collection day/time that is to be displayed in piece 10
.. S ZERO=$G(^LR(LRDFN,"MI",IDT,0)) Q:ZERO=""
.. S INEXACT=$P(ZERO,U,2),DISPDATE=$S(INEXACT:XDT\1,1:XDT),$P(^TMP("LR7OGX",$J,"OUTPUT",OUTCNT),U,10)=DISPDATE
. S OUTCNT=OUTCNT+1,DONE=1
D MIC(LRDFN,IDT,.OUTCNT)
Q
;
ACC ;Look for data from Accession file
N ANODE,MICROEC,NO,TESTNUM
K ^TMP("LR7OG",$J,"ACC")
I '$D(^LRO(68,+AREA,1,+ACDT,1,+NUM)) Q
S TESTNUM=0 F S TESTNUM=$O(^LRO(68,+AREA,1,+ACDT,1,+NUM,4,TESTNUM)) Q:'TESTNUM S ANODE=^(TESTNUM,0) D
. I 'ALL S MICROEC=+$P(^LAB(60,TESTNUM,0),"^",14),MICROEC=$G(^LAB(62.07,MICROEC,.1)),NO=0 D Q:'$D(MICROSUB(+NO))
.. I MICROEC["11.5" S NO=1 ;Matching done of fields in DR string from Execute Code field in file 62.07
.. I MICROEC["11.6" S NO=2
.. I MICROEC["15" S NO=5
.. I MICROEC["19" S NO=8
.. I MICROEC["23" S NO=11
.. I MICROEC["34" S NO=16
. S ^TMP("LR7OG",$J,"ACC",TESTNUM)=ANODE
I $O(^TMP("LR7OG",$J,"ACC",0)) S OK=1
K ^TMP("LR7OG",$J,"ACC")
Q
MIC(LRDFN,LRIDT,OUTCNT) ;
N AGE,GCNT,GIOM,LINE,LREND,LRONESPC,LRONETST,NUM,SEX
S GCNT=0,GIOM=80,LREND=0,LRONESPC="",LRONETST=0
S AGE=$P(^TMP("LR7OG",$J,"G"),U,5),SEX=$P(^("G"),U,6)
; new variables used by LR7OSMZ0
N %,A,A8,AB,B,B1,B2,B3,C,CCNT,DIC,DZ,I,IA,II,INC,J,K,LR1PASS,LR2ORMOR,LRAA,LRABCNT,LRACC,LRACNT,LRAD,LRADM,LRADX,LRAFS,LRAMT,LRAN,LRAO,LRAX
N LRBN,LRBRR,LRBUG,LRCMNT,LRCOMTAB,LRCS,LRDCOM,LRDOC,LRDRTM1,LRDRTM2,LREF,LRFLAG,LRFMT,LRGRM,LRIFN,LRINT,LRJ02,LRLABKY,LRLLT,LRMYC,LRNS,LRNUM
N LRORG,LRPAR,LRPATLOC,LRPC,LRPG,LRPRE,LRPRINT,LRQU,LRRC,LRRES,LRSB,LRSBC1,LRSBC2,LRSET,LRSIC1,LRSIC2,LRSET,LRSIC1,LRSIC2,LRSPEC,LRSSD,LRST
N LRTA,LRTB,LRTBA,LRTBC,LRTBS,LRTK,LRTS,LRTSTS,LRTUS,LRUS,LRWRD,LRWRDVEW,N,S1,SP,X,X1,Y,Y1
K DIC,LR1PASS,LRBUG,LRDCOM,LRINT,LRRES,LRTS K ^TMP("LR",$J),^TMP("LRC",$J),^TMP("LRT",$J)
D EN1^LR7OSMZ0
I '$O(^TMP("LRC",$J,0)) Q
S NUM=0 F S NUM=$O(^TMP("LRC",$J,NUM)) Q:NUM<1 S LINE=^(NUM,0) D
. S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=LINE,OUTCNT=OUTCNT+1
S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)="===============================================================================",OUTCNT=OUTCNT+1
S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=" ",OUTCNT=OUTCNT+1
K ^TMP("LR",$J),^TMP("LRC",$J),^TMP("LRT",$J)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLR7OGMM 3037 printed Oct 16, 2024@18:05:57 Page 2
LR7OGMM ;SLC/STAFF- Interim report rpc memo micro ;7/16/09 16:06
+1 ;;5.2;LAB SERVICE;**187,312,364,395**;Sep 27, 1994;Build 27
+2 ;
MI(LRDFN,IDT,MICROSUB,ALL,OUTCNT,FORMAT,DONE,SKIP) ; from LR7OGM
+1 NEW MISUB,OK,ZERO,INEXACT,DISPDATE,XDT,UID,ACC,AREA,ACDT
+2 IF '$DATA(^LR(LRDFN,"MI",IDT))
QUIT
+3 SET UID=$PIECE($GET(^LR(LRDFN,"MI",IDT,"ORU")),"^")
+4 IF UID'=""
SET UID=$$CHECKUID^LRWU4(UID)
+5 IF 'UID
IF '$PIECE($GET(^LR(LRDFN,"MI",IDT,0)),"^",3)
SET SKIP=1
QUIT
+6 SET AREA=$PIECE(UID,"^",2)
SET ACDT=$PIECE(UID,"^",3)
SET NUM=$PIECE(UID,"^",4)
+7 SET OK=ALL
+8 IF 'OK
SET MISUB=0
FOR
SET MISUB=+$ORDER(MICROSUB(MISUB))
if MISUB<1
QUIT
IF $DATA(^LR(LRDFN,"MI",IDT,MISUB))
SET OK=1
QUIT
+9 DO ACC
+10 IF 'OK
QUIT
+11 IF $GET(FORMAT)
Begin DoDot:1
+12 SET XDT=9999999-IDT
+13 SET ^TMP("LR7OGX",$JOB,"OUTPUT",OUTCNT)="^MI^"_XDT
Begin DoDot:2
+14 ; determine if collection time is "inexact" and put the
+15 ; collection day/time that is to be displayed in piece 10
+16 SET ZERO=$GET(^LR(LRDFN,"MI",IDT,0))
if ZERO=""
QUIT
+17 SET INEXACT=$PIECE(ZERO,U,2)
SET DISPDATE=$SELECT(INEXACT:XDT\1,1:XDT)
SET $PIECE(^TMP("LR7OGX",$JOB,"OUTPUT",OUTCNT),U,10)=DISPDATE
End DoDot:2
+18 SET OUTCNT=OUTCNT+1
SET DONE=1
End DoDot:1
+19 DO MIC(LRDFN,IDT,.OUTCNT)
+20 QUIT
+21 ;
ACC ;Look for data from Accession file
+1 NEW ANODE,MICROEC,NO,TESTNUM
+2 KILL ^TMP("LR7OG",$JOB,"ACC")
+3 IF '$DATA(^LRO(68,+AREA,1,+ACDT,1,+NUM))
QUIT
+4 SET TESTNUM=0
FOR
SET TESTNUM=$ORDER(^LRO(68,+AREA,1,+ACDT,1,+NUM,4,TESTNUM))
if 'TESTNUM
QUIT
SET ANODE=^(TESTNUM,0)
Begin DoDot:1
+5 IF 'ALL
SET MICROEC=+$PIECE(^LAB(60,TESTNUM,0),"^",14)
SET MICROEC=$GET(^LAB(62.07,MICROEC,.1))
SET NO=0
Begin DoDot:2
+6 ;Matching done of fields in DR string from Execute Code field in file 62.07
IF MICROEC["11.5"
SET NO=1
+7 IF MICROEC["11.6"
SET NO=2
+8 IF MICROEC["15"
SET NO=5
+9 IF MICROEC["19"
SET NO=8
+10 IF MICROEC["23"
SET NO=11
+11 IF MICROEC["34"
SET NO=16
End DoDot:2
if '$DATA(MICROSUB(+NO))
QUIT
+12 SET ^TMP("LR7OG",$JOB,"ACC",TESTNUM)=ANODE
End DoDot:1
+13 IF $ORDER(^TMP("LR7OG",$JOB,"ACC",0))
SET OK=1
+14 KILL ^TMP("LR7OG",$JOB,"ACC")
+15 QUIT
MIC(LRDFN,LRIDT,OUTCNT) ;
+1 NEW AGE,GCNT,GIOM,LINE,LREND,LRONESPC,LRONETST,NUM,SEX
+2 SET GCNT=0
SET GIOM=80
SET LREND=0
SET LRONESPC=""
SET LRONETST=0
+3 SET AGE=$PIECE(^TMP("LR7OG",$JOB,"G"),U,5)
SET SEX=$PIECE(^("G"),U,6)
+4 ; new variables used by LR7OSMZ0
+5 NEW %,A,A8,AB,B,B1,B2,B3,C,CCNT,DIC,DZ,I,IA,II,INC,J,K,LR1PASS,LR2ORMOR,LRAA,LRABCNT,LRACC,LRACNT,LRAD,LRADM,LRADX,LRAFS,LRAMT,LRAN,LRAO,LRAX
+6 NEW LRBN,LRBRR,LRBUG,LRCMNT,LRCOMTAB,LRCS,LRDCOM,LRDOC,LRDRTM1,LRDRTM2,LREF,LRFLAG,LRFMT,LRGRM,LRIFN,LRINT,LRJ02,LRLABKY,LRLLT,LRMYC,LRNS,LRNUM
+7 NEW LRORG,LRPAR,LRPATLOC,LRPC,LRPG,LRPRE,LRPRINT,LRQU,LRRC,LRRES,LRSB,LRSBC1,LRSBC2,LRSET,LRSIC1,LRSIC2,LRSET,LRSIC1,LRSIC2,LRSPEC,LRSSD,LRST
+8 NEW LRTA,LRTB,LRTBA,LRTBC,LRTBS,LRTK,LRTS,LRTSTS,LRTUS,LRUS,LRWRD,LRWRDVEW,N,S1,SP,X,X1,Y,Y1
+9 KILL DIC,LR1PASS,LRBUG,LRDCOM,LRINT,LRRES,LRTS
KILL ^TMP("LR",$JOB),^TMP("LRC",$JOB),^TMP("LRT",$JOB)
+10 DO EN1^LR7OSMZ0
+11 IF '$ORDER(^TMP("LRC",$JOB,0))
QUIT
+12 SET NUM=0
FOR
SET NUM=$ORDER(^TMP("LRC",$JOB,NUM))
if NUM<1
QUIT
SET LINE=^(NUM,0)
Begin DoDot:1
+13 SET ^TMP("LR7OGX",$JOB,"OUTPUT",OUTCNT)=LINE
SET OUTCNT=OUTCNT+1
End DoDot:1
+14 SET ^TMP("LR7OGX",$JOB,"OUTPUT",OUTCNT)="==============================================================================="
SET OUTCNT=OUTCNT+1
+15 SET ^TMP("LR7OGX",$JOB,"OUTPUT",OUTCNT)=" "
SET OUTCNT=OUTCNT+1
+16 KILL ^TMP("LR",$JOB),^TMP("LRC",$JOB),^TMP("LRT",$JOB)
+17 QUIT
