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