- BPC7OGMG ; IHS/OIT/MJL - Interim report rpc memo grid 5/22/97 14:23 ;
- ;;1.5;BPC;;MAY 26, 2005
- ;;
- ;;5.2;LAB SERVICE;**187**;Sep 27, 1994
- ;
- GRID(OUTCNT) ;EP from BPC7OGMC
- N ACC,AGE,CDT,CMNT,DATA,DOC,FLAG,IDT,INTP,LINE,LRCW,PORDER,PRNTCODE,RANGE,SEX,SPEC,SUB,TCNT,TESTNAME,TESTNUM
- N UNITS,VALUE,X,ZERO
- ; the variables AGE, SEX, LRCW, and X are used withing the lab's print codes and ref ranges
- S AGE=$P(^TMP("BPC7OG",$J,"G"),U,4),SEX=$P(^("G"),U,5),LRCW=$P(^("G"),U,6)
- S CDT=+$O(^TMP("BPC7OG",$J,"TP",0)) Q:'CDT
- S IDT=9999999-CDT
- S ZERO=$S($D(^TMP("BPC7OG",$J,"TP",CDT))#2:^(CDT),1:"")
- I '$P(ZERO,U,3) Q
- S SPEC=+$P(ZERO,U,5)
- S DOC=$$NAME^BPC7OGMP(+$P(ZERO,U,10))
- S ACC=$P(ZERO,U,6)
- S $P(^TMP("BPC7OGX",$J,"OUTPUT",1),U,4,6)=SPEC_U_$P($G(^LAB(61,SPEC,0)),U)_U_ACC_U_DOC
- S TCNT=0
- S PORDER=0 F S PORDER=$O(^TMP("BPC7OG",$J,"TP",CDT,PORDER)) Q:PORDER'>0 S DATA=^(PORDER) D
- .I $P(DATA,U,7)="" Q
- .S TCNT=TCNT+1
- .S TESTNUM=+DATA,TESTNAME=$P(DATA,U,2),PRNTCODE=$P(DATA,U,5),SUB=$P(DATA,U,6),FLAG=$P(DATA,U,8),X=$P(DATA,U,7)
- .I PRNTCODE="" S VALUE=$J(X,8)
- .E S @("VALUE="_PRNTCODE)
- .D URANGE^BPC7OGU(TESTNUM,SPEC,AGE,SEX,.UNITS,.RANGE)
- .I '$L(UNITS)!'$L(RANGE) D Q
- ..S ^TMP("BPC7OGX",$J,"OUTPUT",OUTCNT)=TESTNUM_U_TESTNAME_U_VALUE_U_FLAG
- ..S OUTCNT=OUTCNT+1
- .S ^TMP("BPC7OGX",$J,"OUTPUT",OUTCNT)=TESTNUM_U_TESTNAME_U_VALUE_U_FLAG_U_UNITS_U_RANGE
- .S OUTCNT=OUTCNT+1
- S $P(^TMP("BPC7OGX",$J,"OUTPUT",1),U)=TCNT
- S PORDER=0 F S PORDER=$O(^TMP("BPC7OG",$J,"TP",CDT,PORDER)) Q:PORDER'>0 S DATA=^(PORDER) D
- .I $O(^TMP("BPC7OG",$J,"TP",CDT,PORDER,0))>0 D
- ..S TESTNAME=$P(DATA,U,3)
- ..S INTP=0 F S INTP=+$O(^TMP("BPC7OG",$J,"TP",CDT,PORDER,INTP)) Q:INTP<1 S LINE=TESTNAME_" Eval: "_^(INTP) D
- ...S ^TMP("BPC7OGX",$J,"OUTPUT",OUTCNT)=LINE
- ...S OUTCNT=OUTCNT+1
- I $D(^TMP("BPC7OG",$J,"TP",CDT,"C")) D
- .S ^TMP("BPC7OGX",$J,"OUTPUT",OUTCNT)="Comment: "
- .S OUTCNT=OUTCNT+1
- .S CMNT=0 F S CMNT=+$O(^TMP("BPC7OG",$J,"TP",CDT,"C",CMNT)) Q:CMNT<1 S LINE=^(CMNT) D
- ..S ^TMP("BPC7OGX",$J,"OUTPUT",OUTCNT)=" "_LINE
- ..S OUTCNT=OUTCNT+1
- Q
- BPC7OGMG ; IHS/OIT/MJL - Interim report rpc memo grid 5/22/97 14:23 ;
- +1 ;;1.5;BPC;;MAY 26, 2005
- +2 ;;
- +3 ;;5.2;LAB SERVICE;**187**;Sep 27, 1994
- +4 ;
- GRID(OUTCNT) ;EP from BPC7OGMC
- +1 NEW ACC,AGE,CDT,CMNT,DATA,DOC,FLAG,IDT,INTP,LINE,LRCW,PORDER,PRNTCODE,RANGE,SEX,SPEC,SUB,TCNT,TESTNAME,TESTNUM
- +2 NEW UNITS,VALUE,X,ZERO
- +3 ; the variables AGE, SEX, LRCW, and X are used withing the lab's print codes and ref ranges
- +4 SET AGE=$PIECE(^TMP("BPC7OG",$JOB,"G"),U,4)
- SET SEX=$PIECE(^("G"),U,5)
- SET LRCW=$PIECE(^("G"),U,6)
- +5 SET CDT=+$ORDER(^TMP("BPC7OG",$JOB,"TP",0))
- IF 'CDT
- QUIT
- +6 SET IDT=9999999-CDT
- +7 SET ZERO=$SELECT($DATA(^TMP("BPC7OG",$JOB,"TP",CDT))#2:^(CDT),1:"")
- +8 IF '$PIECE(ZERO,U,3)
- QUIT
- +9 SET SPEC=+$PIECE(ZERO,U,5)
- +10 SET DOC=$$NAME^BPC7OGMP(+$PIECE(ZERO,U,10))
- +11 SET ACC=$PIECE(ZERO,U,6)
- +12 SET $PIECE(^TMP("BPC7OGX",$JOB,"OUTPUT",1),U,4,6)=SPEC_U_$PIECE($GET(^LAB(61,SPEC,0)),U)_U_ACC_U_DOC
- +13 SET TCNT=0
- +14 SET PORDER=0
- FOR
- SET PORDER=$ORDER(^TMP("BPC7OG",$JOB,"TP",CDT,PORDER))
- IF PORDER'>0
- QUIT
- SET DATA=^(PORDER)
- Begin DoDot:1
- +15 IF $PIECE(DATA,U,7)=""
- QUIT
- +16 SET TCNT=TCNT+1
- +17 SET TESTNUM=+DATA
- SET TESTNAME=$PIECE(DATA,U,2)
- SET PRNTCODE=$PIECE(DATA,U,5)
- SET SUB=$PIECE(DATA,U,6)
- SET FLAG=$PIECE(DATA,U,8)
- SET X=$PIECE(DATA,U,7)
- +18 IF PRNTCODE=""
- SET VALUE=$JUSTIFY(X,8)
- +19 IF '$TEST
- SET @("VALUE="_PRNTCODE)
- +20 DO URANGE^BPC7OGU(TESTNUM,SPEC,AGE,SEX,.UNITS,.RANGE)
- +21 IF '$LENGTH(UNITS)!'$LENGTH(RANGE)
- Begin DoDot:2
- +22 SET ^TMP("BPC7OGX",$JOB,"OUTPUT",OUTCNT)=TESTNUM_U_TESTNAME_U_VALUE_U_FLAG
- +23 SET OUTCNT=OUTCNT+1
- End DoDot:2
- QUIT
- +24 SET ^TMP("BPC7OGX",$JOB,"OUTPUT",OUTCNT)=TESTNUM_U_TESTNAME_U_VALUE_U_FLAG_U_UNITS_U_RANGE
- +25 SET OUTCNT=OUTCNT+1
- End DoDot:1
- +26 SET $PIECE(^TMP("BPC7OGX",$JOB,"OUTPUT",1),U)=TCNT
- +27 SET PORDER=0
- FOR
- SET PORDER=$ORDER(^TMP("BPC7OG",$JOB,"TP",CDT,PORDER))
- IF PORDER'>0
- QUIT
- SET DATA=^(PORDER)
- Begin DoDot:1
- +28 IF $ORDER(^TMP("BPC7OG",$JOB,"TP",CDT,PORDER,0))>0
- Begin DoDot:2
- +29 SET TESTNAME=$PIECE(DATA,U,3)
- +30 SET INTP=0
- FOR
- SET INTP=+$ORDER(^TMP("BPC7OG",$JOB,"TP",CDT,PORDER,INTP))
- IF INTP<1
- QUIT
- SET LINE=TESTNAME_" Eval: "_^(INTP)
- Begin DoDot:3
- +31 SET ^TMP("BPC7OGX",$JOB,"OUTPUT",OUTCNT)=LINE
- +32 SET OUTCNT=OUTCNT+1
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +33 IF $DATA(^TMP("BPC7OG",$JOB,"TP",CDT,"C"))
- Begin DoDot:1
- +34 SET ^TMP("BPC7OGX",$JOB,"OUTPUT",OUTCNT)="Comment: "
- +35 SET OUTCNT=OUTCNT+1
- +36 SET CMNT=0
- FOR
- SET CMNT=+$ORDER(^TMP("BPC7OG",$JOB,"TP",CDT,"C",CMNT))
- IF CMNT<1
- QUIT
- SET LINE=^(CMNT)
- Begin DoDot:2
- +37 SET ^TMP("BPC7OGX",$JOB,"OUTPUT",OUTCNT)=" "_LINE
- +38 SET OUTCNT=OUTCNT+1
- End DoDot:2
- End DoDot:1
- +39 QUIT
