LR7OGMG ;DALOI/STAFF- Interim report rpc memo grid ;11/20/09 10:35
;;5.2;LAB SERVICE;**187,230,286,290,331,364,395,350**;Sep 27, 1994;Build 230
;
GRID(OUTCNT) ; from LR7OGMC
N ACC,AGE,CDT,CMNT,DATA,DOC,FLAG,IDT,INTP,LINE,LRCW,LRX,MPLS,PLS,PORDER,PRNTCODE,RANGE,SEX,SPEC,SUB,TCNT,TESTNAME,TESTNUM
N UNITS,VALUE,X,ZERO,INEXACT,DISPDATE
; the variables AGE, SEX, LRCW, and X are used withing the lab's print codes and ref ranges
K ^TMP("LRMPLS",$J)
S AGE=$P(^TMP("LR7OG",$J,"G"),U,4),SEX=$P(^("G"),U,5),LRCW=$P(^("G"),U,6)
S CDT=+$O(^TMP("LR7OG",$J,"TP",0)) Q:'CDT
S IDT=9999999-CDT
S ZERO=$S($D(^TMP("LR7OG",$J,"TP",CDT))#2:^(CDT),1:"")
S SPEC=+$P(ZERO,U,5)
S INEXACT=$P(ZERO,U,2),DISPDATE=$S(INEXACT:CDT\1,1:CDT)
S DOC=$$NAME^LR7OGMP(+$P(ZERO,U,10))
S ACC=$P(ZERO,U,6)
S $P(^TMP("LR7OGX",$J,"OUTPUT",1),U,4,6)=SPEC_U_$P($G(^LAB(61,SPEC,0)),U)_U_ACC_U_DOC
S $P(^TMP("LR7OGX",$J,"OUTPUT",1),U,10)=DISPDATE
S (TCNT,MPLS,PORDER,PLS)=0
S PLS=$O(^TMP("LRPLS",$J,0))
I $O(^TMP("LRPLS",$J,PLS)) S MPLS=1 ; multiple performing labs
F S PORDER=$O(^TMP("LR7OG",$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),UNITS=$P(DATA,U,9),RANGE=$P(DATA,U,10),PLS=$P(DATA,U,11)
. I MPLS,PLS S ^TMP("LRMPLS",$J,PLS,TESTNAME)=""
. I PRNTCODE="" S VALUE=$J(X,8)
. E S @("VALUE="_PRNTCODE)
. S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=TESTNUM_U_TESTNAME_U_VALUE_U_FLAG_U_UNITS_U_RANGE
. S OUTCNT=OUTCNT+1
S $P(^TMP("LR7OGX",$J,"OUTPUT",1),U)=TCNT ;TCNT must be correct to display all values
;
S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)="Report Released Date/Time: "_$$FMTE^XLFDT($P(ZERO,"^",3),"M"),OUTCNT=OUTCNT+1
S PORDER=0
F S PORDER=$O(^TMP("LR7OG",$J,"TP",CDT,PORDER)) Q:PORDER'>0 S DATA=^(PORDER) D
. I $O(^TMP("LR7OG",$J,"TP",CDT,PORDER,0))>0 D
. . S TESTNAME=$P(DATA,U,3)
. . S INTP=0
. . F S INTP=+$O(^TMP("LR7OG",$J,"TP",CDT,PORDER,INTP)) Q:INTP<1 D
. . . S LINE=TESTNAME_" Eval: "_^TMP("LR7OG",$J,"TP",CDT,PORDER,INTP)
. . . S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=LINE
. . . S OUTCNT=OUTCNT+1
;
I $D(^TMP("LR7OG",$J,"TP",CDT,"C")) D
. S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)="Comment: "
. S OUTCNT=OUTCNT+1,CMNT=0
. F S CMNT=+$O(^TMP("LR7OG",$J,"TP",CDT,"C",CMNT)) Q:CMNT<1 S LINE=^(CMNT) D
. . S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=" "_LINE
. . S OUTCNT=OUTCNT+1
;
; Display reporting lab
I $$GET^XPAR("DIV^PKG","LR REPORTS FACILITY PRINT",1,"Q")#2 D
. S LRX=+$G(^LR(LRDFN,"CH",IDT,"RF"))
. I LRX D RL(LRX)
;
D PLS
;
Q
;
;
RL(LRX) ; Set reporting lab into TMP global
; Call with LRX = IEN of entry in file #4
;
N LINE
S LINE=$$PLSADDR^LR7OSUM2(LRX)
D SETLINE^LR7OGMP(" ",.OUTCNT)
D SETLINE^LR7OGMP("Reporting Lab: "_$P(LINE,"^"),.OUTCNT)
D SETLINE^LR7OGMP(" "_$P(LINE,"^",2),.OUTCNT)
D SETLINE^LR7OGMP(" ",.OUTCNT)
Q
;
;
PLS ; List performing laboratories
; If multiple performing labs then list tests associated with each lab.
;
N CNT,LINE,LLEN,LRPLS,TESTNAME,X
S (CNT,LRPLS)=0
F S LRPLS=$O(^TMP("LRPLS",$J,LRPLS)) Q:LRPLS<1 D
. I CNT S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=" ",OUTCNT=OUTCNT+1
. I $D(^TMP("LRMPLS",$J,LRPLS)) D
. . S TESTNAME="",LINE="For test(s): ",LLEN=13
. . F S TESTNAME=$O(^TMP("LRMPLS",$J,LRPLS,TESTNAME)) Q:TESTNAME="" D
. . . S X=$L(TESTNAME)
. . . I (LLEN+X)>240 S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=LINE,OUTCNT=OUTCNT+1,LINE="",LLEN=0
. . . S LINE=LINE_$S(LLEN>13:", ",1:"")_TESTNAME,LLEN=LLEN+X+$S(LLEN>13:2,1:0)
. . I LINE'="" S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=LINE,OUTCNT=OUTCNT+1
. S LINE=$$PLSADDR^LR7OSUM2(LRPLS)
. S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)="Performing Lab: "_$P(LINE,"^"),OUTCNT=OUTCNT+1,CNT=CNT+1
. S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=" "_$P(LINE,"^",2),OUTCNT=OUTCNT+1
;
K ^TMP("LRPLS",$J),^TMP("LRMPLS",$J)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLR7OGMG 3995 printed Dec 13, 2024@02:05:10 Page 2
LR7OGMG ;DALOI/STAFF- Interim report rpc memo grid ;11/20/09 10:35
+1 ;;5.2;LAB SERVICE;**187,230,286,290,331,364,395,350**;Sep 27, 1994;Build 230
+2 ;
GRID(OUTCNT) ; from LR7OGMC
+1 NEW ACC,AGE,CDT,CMNT,DATA,DOC,FLAG,IDT,INTP,LINE,LRCW,LRX,MPLS,PLS,PORDER,PRNTCODE,RANGE,SEX,SPEC,SUB,TCNT,TESTNAME,TESTNUM
+2 NEW UNITS,VALUE,X,ZERO,INEXACT,DISPDATE
+3 ; the variables AGE, SEX, LRCW, and X are used withing the lab's print codes and ref ranges
+4 KILL ^TMP("LRMPLS",$JOB)
+5 SET AGE=$PIECE(^TMP("LR7OG",$JOB,"G"),U,4)
SET SEX=$PIECE(^("G"),U,5)
SET LRCW=$PIECE(^("G"),U,6)
+6 SET CDT=+$ORDER(^TMP("LR7OG",$JOB,"TP",0))
if 'CDT
QUIT
+7 SET IDT=9999999-CDT
+8 SET ZERO=$SELECT($DATA(^TMP("LR7OG",$JOB,"TP",CDT))#2:^(CDT),1:"")
+9 SET SPEC=+$PIECE(ZERO,U,5)
+10 SET INEXACT=$PIECE(ZERO,U,2)
SET DISPDATE=$SELECT(INEXACT:CDT\1,1:CDT)
+11 SET DOC=$$NAME^LR7OGMP(+$PIECE(ZERO,U,10))
+12 SET ACC=$PIECE(ZERO,U,6)
+13 SET $PIECE(^TMP("LR7OGX",$JOB,"OUTPUT",1),U,4,6)=SPEC_U_$PIECE($GET(^LAB(61,SPEC,0)),U)_U_ACC_U_DOC
+14 SET $PIECE(^TMP("LR7OGX",$JOB,"OUTPUT",1),U,10)=DISPDATE
+15 SET (TCNT,MPLS,PORDER,PLS)=0
+16 SET PLS=$ORDER(^TMP("LRPLS",$JOB,0))
+17 ; multiple performing labs
IF $ORDER(^TMP("LRPLS",$JOB,PLS))
SET MPLS=1
+18 FOR
SET PORDER=$ORDER(^TMP("LR7OG",$JOB,"TP",CDT,PORDER))
if PORDER'>0
QUIT
SET DATA=^(PORDER)
Begin DoDot:1
+19 IF $PIECE(DATA,U,7)=""
QUIT
+20 SET TCNT=TCNT+1
+21 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)
SET UNITS=$PIECE(DATA,U,9)
SET RANGE=$PIECE(DATA,U,10)
SET PLS=$PIECE(DATA,U,11)
+22 IF MPLS
IF PLS
SET ^TMP("LRMPLS",$JOB,PLS,TESTNAME)=""
+23 IF PRNTCODE=""
SET VALUE=$JUSTIFY(X,8)
+24 IF '$TEST
SET @("VALUE="_PRNTCODE)
+25 SET ^TMP("LR7OGX",$JOB,"OUTPUT",OUTCNT)=TESTNUM_U_TESTNAME_U_VALUE_U_FLAG_U_UNITS_U_RANGE
+26 SET OUTCNT=OUTCNT+1
End DoDot:1
+27 ;TCNT must be correct to display all values
SET $PIECE(^TMP("LR7OGX",$JOB,"OUTPUT",1),U)=TCNT
+28 ;
+29 SET ^TMP("LR7OGX",$JOB,"OUTPUT",OUTCNT)="Report Released Date/Time: "_$$FMTE^XLFDT($PIECE(ZERO,"^",3),"M")
SET OUTCNT=OUTCNT+1
+30 SET PORDER=0
+31 FOR
SET PORDER=$ORDER(^TMP("LR7OG",$JOB,"TP",CDT,PORDER))
if PORDER'>0
QUIT
SET DATA=^(PORDER)
Begin DoDot:1
+32 IF $ORDER(^TMP("LR7OG",$JOB,"TP",CDT,PORDER,0))>0
Begin DoDot:2
+33 SET TESTNAME=$PIECE(DATA,U,3)
+34 SET INTP=0
+35 FOR
SET INTP=+$ORDER(^TMP("LR7OG",$JOB,"TP",CDT,PORDER,INTP))
if INTP<1
QUIT
Begin DoDot:3
+36 SET LINE=TESTNAME_" Eval: "_^TMP("LR7OG",$JOB,"TP",CDT,PORDER,INTP)
+37 SET ^TMP("LR7OGX",$JOB,"OUTPUT",OUTCNT)=LINE
+38 SET OUTCNT=OUTCNT+1
End DoDot:3
End DoDot:2
End DoDot:1
+39 ;
+40 IF $DATA(^TMP("LR7OG",$JOB,"TP",CDT,"C"))
Begin DoDot:1
+41 SET ^TMP("LR7OGX",$JOB,"OUTPUT",OUTCNT)="Comment: "
+42 SET OUTCNT=OUTCNT+1
SET CMNT=0
+43 FOR
SET CMNT=+$ORDER(^TMP("LR7OG",$JOB,"TP",CDT,"C",CMNT))
if CMNT<1
QUIT
SET LINE=^(CMNT)
Begin DoDot:2
+44 SET ^TMP("LR7OGX",$JOB,"OUTPUT",OUTCNT)=" "_LINE
+45 SET OUTCNT=OUTCNT+1
End DoDot:2
End DoDot:1
+46 ;
+47 ; Display reporting lab
+48 IF $$GET^XPAR("DIV^PKG","LR REPORTS FACILITY PRINT",1,"Q")#2
Begin DoDot:1
+49 SET LRX=+$GET(^LR(LRDFN,"CH",IDT,"RF"))
+50 IF LRX
DO RL(LRX)
End DoDot:1
+51 ;
+52 DO PLS
+53 ;
+54 QUIT
+55 ;
+56 ;
RL(LRX) ; Set reporting lab into TMP global
+1 ; Call with LRX = IEN of entry in file #4
+2 ;
+3 NEW LINE
+4 SET LINE=$$PLSADDR^LR7OSUM2(LRX)
+5 DO SETLINE^LR7OGMP(" ",.OUTCNT)
+6 DO SETLINE^LR7OGMP("Reporting Lab: "_$PIECE(LINE,"^"),.OUTCNT)
+7 DO SETLINE^LR7OGMP(" "_$PIECE(LINE,"^",2),.OUTCNT)
+8 DO SETLINE^LR7OGMP(" ",.OUTCNT)
+9 QUIT
+10 ;
+11 ;
PLS ; List performing laboratories
+1 ; If multiple performing labs then list tests associated with each lab.
+2 ;
+3 NEW CNT,LINE,LLEN,LRPLS,TESTNAME,X
+4 SET (CNT,LRPLS)=0
+5 FOR
SET LRPLS=$ORDER(^TMP("LRPLS",$JOB,LRPLS))
if LRPLS<1
QUIT
Begin DoDot:1
+6 IF CNT
SET ^TMP("LR7OGX",$JOB,"OUTPUT",OUTCNT)=" "
SET OUTCNT=OUTCNT+1
+7 IF $DATA(^TMP("LRMPLS",$JOB,LRPLS))
Begin DoDot:2
+8 SET TESTNAME=""
SET LINE="For test(s): "
SET LLEN=13
+9 FOR
SET TESTNAME=$ORDER(^TMP("LRMPLS",$JOB,LRPLS,TESTNAME))
if TESTNAME=""
QUIT
Begin DoDot:3
+10 SET X=$LENGTH(TESTNAME)
+11 IF (LLEN+X)>240
SET ^TMP("LR7OGX",$JOB,"OUTPUT",OUTCNT)=LINE
SET OUTCNT=OUTCNT+1
SET LINE=""
SET LLEN=0
+12 SET LINE=LINE_$SELECT(LLEN>13:", ",1:"")_TESTNAME
SET LLEN=LLEN+X+$SELECT(LLEN>13:2,1:0)
End DoDot:3
+13 IF LINE'=""
SET ^TMP("LR7OGX",$JOB,"OUTPUT",OUTCNT)=LINE
SET OUTCNT=OUTCNT+1
End DoDot:2
+14 SET LINE=$$PLSADDR^LR7OSUM2(LRPLS)
+15 SET ^TMP("LR7OGX",$JOB,"OUTPUT",OUTCNT)="Performing Lab: "_$PIECE(LINE,"^")
SET OUTCNT=OUTCNT+1
SET CNT=CNT+1
+16 SET ^TMP("LR7OGX",$JOB,"OUTPUT",OUTCNT)=" "_$PIECE(LINE,"^",2)
SET OUTCNT=OUTCNT+1
End DoDot:1
+17 ;
+18 KILL ^TMP("LRPLS",$JOB),^TMP("LRMPLS",$JOB)
+19 QUIT
