Routine: BLR7OGMM

BLR7OGMM ;VA/SLC/STAFF- Interim report rpc memo micro ; 22-Oct-2013 09:22 ; MKK

 ;;5.2;LAB SERVICE;**1031,1033**;NOV 1, 1997

 ;;Cloned from LR70GMM

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)

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")

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)

BLR7OGMM  ;VA/SLC/STAFF- Interim report rpc memo micro ; 22-Oct-2013 09:22 ; MKK

 +1       ;;5.2;LAB SERVICE;**1031,1033**;NOV 1, 1997

 +2       ;

 +3       ;;Cloned from LR70GMM

 +4       ;

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

BLR7OGMM.m