BPC7OGMM.m

BPC7OGMM ; IHS/OIT/MJL - Interim report rpc memo micro 5/20/97 18:52 ;

 ;;1.5;BPC;;MAY 26, 2005

 ;;

 ;

 ;5.2;LAB SERVICE;**187**;Sep 27, 1994

 ;

MI(LRDFN,IDT,MICROSUB,ALL,OUTCNT,FORMAT,DONE) ; EP from LR7OGM

 N MISUB,OK

 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

 I 'OK Q

 I $G(FORMAT) D

 .S ^TMP("BPC7OGX",$J,"OUTPUT",OUTCNT)="^MI^"_(9999999-IDT)

 .S OUTCNT=OUTCNT+1

 .S DONE=1

 D MIC(LRDFN,IDT,.OUTCNT)

 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("BPC7OG",$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("BPC7OGX",$J,"OUTPUT",OUTCNT)=LINE,OUTCNT=OUTCNT+1

 S ^TMP("BPC7OGX",$J,"OUTPUT",OUTCNT)="===============================================================================",OUTCNT=OUTCNT+1

 K ^TMP("LR",$J),^TMP("LRC",$J),^TMP("LRT",$J)

 Q

BPC7OGMM  ; IHS/OIT/MJL - Interim report rpc memo micro 5/20/97 18:52 ;

 +1       ;;1.5;BPC;;MAY 26, 2005

 +2       ;;

 +3       ;

 +4       ;5.2;LAB SERVICE;**187**;Sep 27, 1994

 +5       ;

MI(LRDFN,IDT,MICROSUB,ALL,OUTCNT,FORMAT,DONE) ; EP from LR7OGM

 +1        NEW MISUB,OK

 +2        SET OK=ALL

 +3        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 

 +4        IF 'OK

               QUIT 

 +5        IF $GET(FORMAT)

               Begin DoDot:1

 +6                SET ^TMP("BPC7OGX",$JOB,"OUTPUT",OUTCNT)="^MI^"_(9999999-IDT)

 +7                SET OUTCNT=OUTCNT+1

 +8                SET DONE=1

               End DoDot:1

 +9        DO MIC(LRDFN,IDT,.OUTCNT)

 +10       QUIT 

 +11      ;

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("BPC7OG",$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("BPC7OGX",$JOB,"OUTPUT",OUTCNT)=LINE

                   SET OUTCNT=OUTCNT+1

               End DoDot:1

 +14       SET ^TMP("BPC7OGX",$JOB,"OUTPUT",OUTCNT)="==============================================================================="

           SET OUTCNT=OUTCNT+1

 +15       KILL ^TMP("LR",$JOB),^TMP("LRC",$JOB),^TMP("LRT",$JOB)

 +16       QUIT