LR7OGMP ;DALOI/STAFF- Interim report rpc memo print ;11/20/09 10:36
;;5.2;LAB SERVICE;**187,246,282,286,344,395,350**;Sep 27, 1994;Build 230
;
PRINT(OUTCNT) ; from LR7OGMC
N ACC,AGE,CDT,CMNT,DATA,DOC,FLAG,HIGH,IDT,INTP,LINE,LOW,LRCW,LRDRL,LREAL,LRX,PORDER,PRNTCODE,RANGE,REFHIGH,REFLOW,SEX,SITE,SPEC,SUB,TESTNUM
N TESTSPEC,THER,THERHIGH,THERLOW,UNITS,VALUE,X,ZERO
;
; the variables AGE, SEX, LRCW, and X are used within the lab's print codes and ref ranges
S AGE=$P(^TMP("LR7OG",$J,"G"),U,4),SEX=$P(^("G"),U,5),LRCW=$P(^("G"),U,6)
;
; Flag to determine if reporting laboratory is printed on report
S LRDRL=$$GET^XPAR("DIV^PKG","LR REPORTS FACILITY PRINT",1,"Q")#2
;
S CDT=0
F S CDT=$O(^TMP("LR7OG",$J,"TP",CDT)) Q:CDT="" D
. S IDT=9999999-CDT
. S ZERO=$S($D(^TMP("LR7OG",$J,"TP",CDT))#2:^(CDT),1:"")
. S SPEC=+$P(ZERO,U,5)
. S DOC=$$NAME(+$P(ZERO,U,10)),LREAL=+$P(ZERO,U,2)
. D SETLINE("",.OUTCNT)
. I LRDRL D RL
. S LINE="Report Released Date/Time: "
. I $P(ZERO,"^",3) S LINE=LINE_$$FMTE^XLFDT($P(ZERO,"^",3),"M")
. D SETLINE(LINE,.OUTCNT)
. D SETLINE("Provider: "_DOC,.OUTCNT)
. S LINE=" Specimen: "_$P($G(^LAB(61,SPEC,0),"<no specimen on file>"),U)_"."
. S ACC=$P(ZERO,U,6)
. S LINE=$$SETSTR^VALM1(" "_ACC,LINE,30,1+$L(ACC))
. D SETLINE(LINE,.OUTCNT)
. D SETLINE(" Specimen Collection Date: "_$$LRUDT^LR7OSUM6(CDT,LREAL),.OUTCNT)
. D SETLINE(" Test name Result units Ref. range Site Code",.OUTCNT)
. S PORDER=0
. F S PORDER=$O(^TMP("LR7OG",$J,"TP",CDT,PORDER)) Q:PORDER'>0 S DATA=^(PORDER) D
. . I $P(DATA,U,7)="" Q
. . S TESTNUM=+DATA,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),SITE=$P(DATA,U,11)
. . S LOW=$P(RANGE,"-"),HIGH=$P(RANGE,"-",2),THER=$P(DATA,U,12)
. . I $L($P(DATA,U,2))>28,$P(DATA,U,3)'="" S LINE=$P(DATA,U,3)
. . E S LINE=$E($P(DATA,U,2),1,28)
. . S LINE=$$SETSTR^VALM1("",LINE,28,0)
. . I PRNTCODE="" S LINE=LINE_$J(X,8)
. . E S @("VALUE="_PRNTCODE),LINE=LINE_VALUE
. . S LINE=LINE_" "_FLAG
. . I $L(LINE)>38 D SETLINE(LINE,.OUTCNT) S LINE=""
. . I UNITS'="" S LINE=$$SETSTR^VALM1(" "_UNITS,LINE,39,2+$L(UNITS))
. . S LRX=RANGE
. . I LRX'="" S LINE=$$SETSTR^VALM1(LRX,LINE,52,$L(LRX))
. . I $L(LINE)>67,SITE D SETLINE(LINE,.OUTCNT) S LINE=""
. . I SITE S LINE=$$SETSTR^VALM1(" ["_SITE_"]",LINE,68,3+$L(SITE))
. . I LINE'="" D SETLINE(LINE,.OUTCNT)
. . I $O(^TMP("LR7OG",$J,"TP",CDT,PORDER,0))>0 D
. . . S INTP=0
. . . F S INTP=+$O(^TMP("LR7OG",$J,"TP",CDT,PORDER,INTP)) Q:INTP<1 D SETLINE(" Eval: "_^(INTP),.OUTCNT)
. I $D(^TMP("LR7OG",$J,"TP",CDT,"C")) D
. . S LINE="Comment: "
. . S CMNT=0
. . F S CMNT=+$O(^TMP("LR7OG",$J,"TP",CDT,"C",CMNT)) Q:CMNT<1 S LINE=LINE_^(CMNT) D
. . . D SETLINE(LINE,.OUTCNT)
. . . I $O(^TMP("LR7OG",$J,"TP",CDT,"C",CMNT)) S LINE=" "
. D SETLINE("===============================================================================",.OUTCNT)
D SETLINE(" ",.OUTCNT)
Q
;
;
SETLINE(LINE,CNT) ;
S ^TMP("LR7OGX",$J,"OUTPUT",CNT)=LINE
S CNT=CNT+1
Q
;
;
NAME(X) ; $$(#) -> name
N LRDOC
D DOC^LRX
Q LRDOC
;
;
DD(Y) ; $$(date/time) -> date/time format
D DD^LRX
Q Y
;
;
RL ; Display reporting lab
N LRX
S LRX=+$G(^LR(LRDFN,"CH",IDT,"RF"))
I LRX D RL^LR7OGMG(LRX)
Q
;
;
PFAC ; Print header with name of facility generating report.
N LRI,LRPF
D PFAC^LRRP1(DUZ(2),0,1,.LRPF)
I $D(LRPF) D
. S LRI=0
. F S LRI=$O(LRPF(LRI)) Q:'LRI D SETLINE(LRPF(LRI),.OUTCNT)
D SETLINE("As of: "_$$HTE^XLFDT($H,"1M"),.OUTCNT)
D SETLINE(" ",.OUTCNT)
Q
;
;
PLS ; List performing laboratories
;
N LINE,LRPLS,X
D SETLINE("Performing Lab Sites",.OUTCNT)
S LRPLS=0
F S LRPLS=$O(^TMP("LRPLS",$J,LRPLS)) Q:LRPLS<1 D
. S LRPLS(0)=$$PLSADDR^LR7OSUM2(LRPLS)
. S LINE=$$LJ^XLFSTR("["_LRPLS_"] ",8)_$P(LRPLS(0),"^")
. D SETLINE(LINE,.OUTCNT)
. S LINE=$$REPEAT^XLFSTR(" ",8)_$P(LRPLS(0),"^",2)
. D SETLINE(LINE,.OUTCNT)
;
D SETLINE("===============================================================================",.OUTCNT)
;
K ^TMP("LRPLS",$J),^TMP("LRPLS-ADDR",$J)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLR7OGMP 4221 printed Dec 13, 2024@02:05:12 Page 2
LR7OGMP ;DALOI/STAFF- Interim report rpc memo print ;11/20/09 10:36
+1 ;;5.2;LAB SERVICE;**187,246,282,286,344,395,350**;Sep 27, 1994;Build 230
+2 ;
PRINT(OUTCNT) ; from LR7OGMC
+1 NEW ACC,AGE,CDT,CMNT,DATA,DOC,FLAG,HIGH,IDT,INTP,LINE,LOW,LRCW,LRDRL,LREAL,LRX,PORDER,PRNTCODE,RANGE,REFHIGH,REFLOW,SEX,SITE,SPEC,SUB,TESTNUM
+2 NEW TESTSPEC,THER,THERHIGH,THERLOW,UNITS,VALUE,X,ZERO
+3 ;
+4 ; the variables AGE, SEX, LRCW, and X are used within the lab's print codes and ref ranges
+5 SET AGE=$PIECE(^TMP("LR7OG",$JOB,"G"),U,4)
SET SEX=$PIECE(^("G"),U,5)
SET LRCW=$PIECE(^("G"),U,6)
+6 ;
+7 ; Flag to determine if reporting laboratory is printed on report
+8 SET LRDRL=$$GET^XPAR("DIV^PKG","LR REPORTS FACILITY PRINT",1,"Q")#2
+9 ;
+10 SET CDT=0
+11 FOR
SET CDT=$ORDER(^TMP("LR7OG",$JOB,"TP",CDT))
if CDT=""
QUIT
Begin DoDot:1
+12 SET IDT=9999999-CDT
+13 SET ZERO=$SELECT($DATA(^TMP("LR7OG",$JOB,"TP",CDT))#2:^(CDT),1:"")
+14 SET SPEC=+$PIECE(ZERO,U,5)
+15 SET DOC=$$NAME(+$PIECE(ZERO,U,10))
SET LREAL=+$PIECE(ZERO,U,2)
+16 DO SETLINE("",.OUTCNT)
+17 IF LRDRL
DO RL
+18 SET LINE="Report Released Date/Time: "
+19 IF $PIECE(ZERO,"^",3)
SET LINE=LINE_$$FMTE^XLFDT($PIECE(ZERO,"^",3),"M")
+20 DO SETLINE(LINE,.OUTCNT)
+21 DO SETLINE("Provider: "_DOC,.OUTCNT)
+22 SET LINE=" Specimen: "_$PIECE($GET(^LAB(61,SPEC,0),"<no specimen on file>"),U)_"."
+23 SET ACC=$PIECE(ZERO,U,6)
+24 SET LINE=$$SETSTR^VALM1(" "_ACC,LINE,30,1+$LENGTH(ACC))
+25 DO SETLINE(LINE,.OUTCNT)
+26 DO SETLINE(" Specimen Collection Date: "_$$LRUDT^LR7OSUM6(CDT,LREAL),.OUTCNT)
+27 DO SETLINE(" Test name Result units Ref. range Site Code",.OUTCNT)
+28 SET PORDER=0
+29 FOR
SET PORDER=$ORDER(^TMP("LR7OG",$JOB,"TP",CDT,PORDER))
if PORDER'>0
QUIT
SET DATA=^(PORDER)
Begin DoDot:2
+30 IF $PIECE(DATA,U,7)=""
QUIT
+31 SET TESTNUM=+DATA
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 SITE=$PIECE(DATA,U,11)
+32 SET LOW=$PIECE(RANGE,"-")
SET HIGH=$PIECE(RANGE,"-",2)
SET THER=$PIECE(DATA,U,12)
+33 IF $LENGTH($PIECE(DATA,U,2))>28
IF $PIECE(DATA,U,3)'=""
SET LINE=$PIECE(DATA,U,3)
+34 IF '$TEST
SET LINE=$EXTRACT($PIECE(DATA,U,2),1,28)
+35 SET LINE=$$SETSTR^VALM1("",LINE,28,0)
+36 IF PRNTCODE=""
SET LINE=LINE_$JUSTIFY(X,8)
+37 IF '$TEST
SET @("VALUE="_PRNTCODE)
SET LINE=LINE_VALUE
+38 SET LINE=LINE_" "_FLAG
+39 IF $LENGTH(LINE)>38
DO SETLINE(LINE,.OUTCNT)
SET LINE=""
+40 IF UNITS'=""
SET LINE=$$SETSTR^VALM1(" "_UNITS,LINE,39,2+$LENGTH(UNITS))
+41 SET LRX=RANGE
+42 IF LRX'=""
SET LINE=$$SETSTR^VALM1(LRX,LINE,52,$LENGTH(LRX))
+43 IF $LENGTH(LINE)>67
IF SITE
DO SETLINE(LINE,.OUTCNT)
SET LINE=""
+44 IF SITE
SET LINE=$$SETSTR^VALM1(" ["_SITE_"]",LINE,68,3+$LENGTH(SITE))
+45 IF LINE'=""
DO SETLINE(LINE,.OUTCNT)
+46 IF $ORDER(^TMP("LR7OG",$JOB,"TP",CDT,PORDER,0))>0
Begin DoDot:3
+47 SET INTP=0
+48 FOR
SET INTP=+$ORDER(^TMP("LR7OG",$JOB,"TP",CDT,PORDER,INTP))
if INTP<1
QUIT
DO SETLINE(" Eval: "_^(INTP),.OUTCNT)
End DoDot:3
End DoDot:2
+49 IF $DATA(^TMP("LR7OG",$JOB,"TP",CDT,"C"))
Begin DoDot:2
+50 SET LINE="Comment: "
+51 SET CMNT=0
+52 FOR
SET CMNT=+$ORDER(^TMP("LR7OG",$JOB,"TP",CDT,"C",CMNT))
if CMNT<1
QUIT
SET LINE=LINE_^(CMNT)
Begin DoDot:3
+53 DO SETLINE(LINE,.OUTCNT)
+54 IF $ORDER(^TMP("LR7OG",$JOB,"TP",CDT,"C",CMNT))
SET LINE=" "
End DoDot:3
End DoDot:2
+55 DO SETLINE("===============================================================================",.OUTCNT)
End DoDot:1
+56 DO SETLINE(" ",.OUTCNT)
+57 QUIT
+58 ;
+59 ;
SETLINE(LINE,CNT) ;
+1 SET ^TMP("LR7OGX",$JOB,"OUTPUT",CNT)=LINE
+2 SET CNT=CNT+1
+3 QUIT
+4 ;
+5 ;
NAME(X) ; $$(#) -> name
+1 NEW LRDOC
+2 DO DOC^LRX
+3 QUIT LRDOC
+4 ;
+5 ;
DD(Y) ; $$(date/time) -> date/time format
+1 DO DD^LRX
+2 QUIT Y
+3 ;
+4 ;
RL ; Display reporting lab
+1 NEW LRX
+2 SET LRX=+$GET(^LR(LRDFN,"CH",IDT,"RF"))
+3 IF LRX
DO RL^LR7OGMG(LRX)
+4 QUIT
+5 ;
+6 ;
PFAC ; Print header with name of facility generating report.
+1 NEW LRI,LRPF
+2 DO PFAC^LRRP1(DUZ(2),0,1,.LRPF)
+3 IF $DATA(LRPF)
Begin DoDot:1
+4 SET LRI=0
+5 FOR
SET LRI=$ORDER(LRPF(LRI))
if 'LRI
QUIT
DO SETLINE(LRPF(LRI),.OUTCNT)
End DoDot:1
+6 DO SETLINE("As of: "_$$HTE^XLFDT($HOROLOG,"1M"),.OUTCNT)
+7 DO SETLINE(" ",.OUTCNT)
+8 QUIT
+9 ;
+10 ;
PLS ; List performing laboratories
+1 ;
+2 NEW LINE,LRPLS,X
+3 DO SETLINE("Performing Lab Sites",.OUTCNT)
+4 SET LRPLS=0
+5 FOR
SET LRPLS=$ORDER(^TMP("LRPLS",$JOB,LRPLS))
if LRPLS<1
QUIT
Begin DoDot:1
+6 SET LRPLS(0)=$$PLSADDR^LR7OSUM2(LRPLS)
+7 SET LINE=$$LJ^XLFSTR("["_LRPLS_"] ",8)_$PIECE(LRPLS(0),"^")
+8 DO SETLINE(LINE,.OUTCNT)
+9 SET LINE=$$REPEAT^XLFSTR(" ",8)_$PIECE(LRPLS(0),"^",2)
+10 DO SETLINE(LINE,.OUTCNT)
End DoDot:1
+11 ;
+12 DO SETLINE("===============================================================================",.OUTCNT)
+13 ;
+14 KILL ^TMP("LRPLS",$JOB),^TMP("LRPLS-ADDR",$JOB)
+15 QUIT
