Routine: BPC7OGMC

BPC7OGMC ; IHS/OIT/MJL - Interim report rpc memo chem 5/20/97 19:03 ;

 ;;1.5;BPC;;MAY 26, 2005

;;

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

 ; sets lab data into ^TMP("BPC7OG",$J,"TP"

 ; ^TMP("BPC7OG",$J,"G")=dfn^pnm^lrdfn^age^sex^lrcw

 ; ^TMP("BPC7OG",$J,"TMP",test subscript in data)=zero node of test

 ; ^TMP("BPC7OG",$J,"TP",collect date/time)=zero node from data

 ; ^TMP("BPC7OG",$J,"TP",collect date/time,printorder)=test#^name^printname^^printcode^dataname^result^flag

 ; ^TMP("BPC7OG",$J,"TP",collect date/time,printorder,#)=interpretation

 ; ^TMP("BPC7OG",$J,"TP",collect date/time,"C",#)=comment

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

 N CDT,CHSUB,CMNT,INTP,LABSUB,PNODE,PORDER,SPEC,TCNT,TESTNUM,TESTSUB,ZERO

 S ZERO=^LR(LRDFN,"CH",IDT,0)

 I '$P(ZERO,U,3) Q

 S CDT=+ZERO,LABSUB="CH",TCNT=0,SPEC=$P(ZERO,U,5)

 S CHSUB=1 F  S CHSUB=$O(^LR(LRDFN,"CH",IDT,CHSUB)) Q:CHSUB=""  I ALL!$D(^TMP("BPC7OG",$J,"TMP",CHSUB)) D  Q

 .I FORMAT D

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

 ..S OUTCNT=OUTCNT+1

 ..S DONE=1

 .K ^TMP("BPC7OG",$J,"TP")

 .I ALL S TESTSUB=1 F  S TESTSUB=$O(^LR(LRDFN,"CH",IDT,TESTSUB)) Q:TESTSUB<1  S TESTNUM=$O(^LAB(60,"C","CH;"_TESTSUB_";1",0)) D CHSETUP

 .E  S TESTSUB=1 F  S TESTSUB=$O(^TMP("BPC7OG",$J,"TMP",TESTSUB)) Q:TESTSUB<1  S TESTNUM=+^(TESTSUB) D CHSETUP

 .I TCNT D

 ..S ^TMP("BPC7OG",$J,"TP",CDT)=ZERO

 ..S CMNT=0 F  S CMNT=+$O(^LR(LRDFN,LABSUB,IDT,1,CMNT)) Q:CMNT<1  S ^TMP("BPC7OG",$J,"TP",CDT,"C",CMNT)=^(CMNT,0) S TCNT=TCNT+1

 .I FORMAT D GRID^BPC7OGMG(.OUTCNT)

 .I 'FORMAT D PRINT^BPC7OGMP(.OUTCNT)

 .K ^TMP("BPC7OG",$J,"TP")

CHSETUP ; within scope of CH

 I 'TESTNUM Q

 Q:'$D(^LAB(60,TESTNUM,.1))  S PNODE=^(.1)

 Q:'$D(^LR(LRDFN,LABSUB,IDT,TESTSUB))  Q:'$L($P(^(TESTSUB),U))

 S PORDER=$P(PNODE,U,6),PORDER=$S(PORDER:PORDER,1:TESTSUB/1000000)

 F  Q:'$D(^TMP("BPC7OG",$J,"TP",CDT,PORDER))  Q:TESTNUM=+^(PORDER)  S PORDER=PORDER+1

 I $D(^TMP("BPC7OG",$J,"TP",CDT,PORDER)) Q

 S ^TMP("BPC7OG",$J,"TP",CDT,PORDER)=TESTNUM_U_$P(^LAB(60,TESTNUM,0),U)_U_$P(PNODE,U)_U_$P(PNODE,U,2)_U_$P(PNODE,U,3)_U_$P(^(0),U,5)_U_$P(^LR(LRDFN,LABSUB,IDT,TESTSUB),U)_U_$P(^(TESTSUB),U,2)

 S TCNT=TCNT+1

 I $D(^LAB(60,TESTNUM,1,SPEC,1,0)) D

 .S INTP=0 F  S INTP=+$O(^LAB(60,TESTNUM,1,SPEC,1,INTP)) Q:INTP<1  S ^TMP("BPC7OG",$J,"TP",CDT,PORDER,INTP)=^(INTP,0) S TCNT=TCNT+1

BPC7OGMC  ; IHS/OIT/MJL - Interim report rpc memo chem 5/20/97 19:03 ;

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

 +2       ;;

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

 +4       ;

 +5       ; sets lab data into ^TMP("BPC7OG",$J,"TP"

 +6       ; ^TMP("BPC7OG",$J,"G")=dfn^pnm^lrdfn^age^sex^lrcw

 +7       ; ^TMP("BPC7OG",$J,"TMP",test subscript in data)=zero node of test

 +8       ; ^TMP("BPC7OG",$J,"TP",collect date/time)=zero node from data

 +9       ; ^TMP("BPC7OG",$J,"TP",collect date/time,printorder)=test#^name^printname^^printcode^dataname^result^flag

 +10      ; ^TMP("BPC7OG",$J,"TP",collect date/time,printorder,#)=interpretation

 +11      ; ^TMP("BPC7OG",$J,"TP",collect date/time,"C",#)=comment

 +12      ;

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

 +1        NEW CDT,CHSUB,CMNT,INTP,LABSUB,PNODE,PORDER,SPEC,TCNT,TESTNUM,TESTSUB,ZERO

 +2        SET ZERO=^LR(LRDFN,"CH",IDT,0)

 +3        IF '$PIECE(ZERO,U,3)

               QUIT

 +4        SET CDT=+ZERO

           SET LABSUB="CH"

           SET TCNT=0

           SET SPEC=$PIECE(ZERO,U,5)

 +5        SET CHSUB=1

FOR

               SET CHSUB=$ORDER(^LR(LRDFN,"CH",IDT,CHSUB))

               IF CHSUB=""

                   QUIT

               IF ALL!$DATA(^TMP("BPC7OG",$JOB,"TMP",CHSUB))

                   Begin DoDot:1

 +6                    IF FORMAT

                           Begin DoDot:2

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

 +8                            SET OUTCNT=OUTCNT+1

 +9                            SET DONE=1

                           End DoDot:2

 +10                   KILL ^TMP("BPC7OG",$JOB,"TP")

 +11                   IF ALL

                           SET TESTSUB=1

FOR

                               SET TESTSUB=$ORDER(^LR(LRDFN,"CH",IDT,TESTSUB))

                               IF TESTSUB<1

                                   QUIT

                               SET TESTNUM=$ORDER(^LAB(60,"C","CH;"_TESTSUB_";1",0))

                               DO CHSETUP

 +12                  IF '$TEST

                           SET TESTSUB=1

FOR

                               SET TESTSUB=$ORDER(^TMP("BPC7OG",$JOB,"TMP",TESTSUB))

                               IF TESTSUB<1

                                   QUIT

                               SET TESTNUM=+^(TESTSUB)

                               DO CHSETUP

 +13                   IF TCNT

                           Begin DoDot:2

 +14                           SET ^TMP("BPC7OG",$JOB,"TP",CDT)=ZERO

 +15                           SET CMNT=0

FOR

                                   SET CMNT=+$ORDER(^LR(LRDFN,LABSUB,IDT,1,CMNT))

                                   IF CMNT<1

                                       QUIT

                                   SET ^TMP("BPC7OG",$JOB,"TP",CDT,"C",CMNT)=^(CMNT,0)

                                   SET TCNT=TCNT+1

                           End DoDot:2

 +16                   IF FORMAT

                           DO GRID^BPC7OGMG(.OUTCNT)

 +17                   IF 'FORMAT

                           DO PRINT^BPC7OGMP(.OUTCNT)

 +18                   KILL ^TMP("BPC7OG",$JOB,"TP")

                   End DoDot:1

                   QUIT

 +19       QUIT

 +20      ;

CHSETUP   ; within scope of CH

 +1        IF 'TESTNUM

               QUIT

 +2        IF '$DATA(^LAB(60,TESTNUM,.1))

               QUIT

           SET PNODE=^(.1)

 +3        IF '$DATA(^LR(LRDFN,LABSUB,IDT,TESTSUB))

               QUIT

           IF '$LENGTH($PIECE(^(TESTSUB),U))

               QUIT

 +4        SET PORDER=$PIECE(PNODE,U,6)

           SET PORDER=$SELECT(PORDER:PORDER,1:TESTSUB/1000000)

 +5        FOR

               IF '$DATA(^TMP("BPC7OG",$JOB,"TP",CDT,PORDER))

                   QUIT

               IF TESTNUM=+^(PORDER)

                   QUIT

               SET PORDER=PORDER+1

 +6        IF $DATA(^TMP("BPC7OG",$JOB,"TP",CDT,PORDER))

               QUIT

 +7        SET ^TMP("BPC7OG",$JOB,"TP",CDT,PORDER)=TESTNUM_U_$PIECE(^LAB(60,TESTNUM,0),U)_U_$PIECE(PNODE,U)_U_$PIECE(PNODE,U,2)_U_$PIECE(PNODE,U,3)_U_$PIECE(^(0),U,5)_U_$PIECE(^LR(LRDFN,LABSUB,IDT,TESTSUB),U)_U_$PIECE(^(TESTSUB),U,2)

 +8        SET TCNT=TCNT+1

 +9        IF $DATA(^LAB(60,TESTNUM,1,SPEC,1,0))

               Begin DoDot:1

 +10               SET INTP=0

FOR

                       SET INTP=+$ORDER(^LAB(60,TESTNUM,1,SPEC,1,INTP))

                       IF INTP<1

                           QUIT

                       SET ^TMP("BPC7OG",$JOB,"TP",CDT,PORDER,INTP)=^(INTP,0)

                       SET TCNT=TCNT+1

               End DoDot:1

 +11       QUIT

BPC7OGMC.m