LR7OGG ;DALOI/STAFF- Interim report rpc grid ;02/11/11 15:09
;;5.2;LAB SERVICE;**187,290,364,350**;Sep 27, 1994;Build 230
;
TEST ; test use only
N CNT,I
K ^TMP("LR7OGX",$J)
S ^TMP("LR7OGX",$J,"INPUT",1)="2^2970202^2920202"
S CNT=1
;F I=1:1:10 I $D(^LAB(60,I,0)) S CNT=CNT+1,^TMP("LR7OGX",$J,"INPUT",CNT)=I
F I=7,173,9,1 I $D(^LAB(60,I,0)) S CNT=CNT+1,^TMP("LR7OGX",$J,"INPUT",CNT)=I
D GRIDDATA
S I=0 F S I=$O(^TMP("LR7OGX",$J,"OUTPUT",I)) Q:I<1 W !,^(I)
K ^TMP("LR7OGX",$J)
Q
;
GRID(ROOT,DFN,DATE1,DATE2,SPEC,TESTS) ; from ORWLRR
N CNT,NUM
K ^TMP("LR7OGX",$J,"INPUT"),^("OUTPUT")
S ROOT=$NA(^TMP("LR7OGX",$J,"OUTPUT"))
S ^TMP("LR7OGX",$J,"INPUT",1)=DFN_U_DATE1_U_DATE2_U_+SPEC
S CNT=1,NUM=0 F S NUM=$O(TESTS(NUM)) Q:NUM<1 D
.S CNT=CNT+1
.S ^TMP("LR7OGX",$J,"INPUT",CNT)=+TESTS(NUM)
D GRIDDATA
Q
;
;
GRIDDATA ;
; input format
; ^TMP("LR7OGX",$J,"INPUT",1)=dfn^start date^end date^spec^all tests
; ^TMP("LR7OGX",$J,"INPUT",#)=test# (tests displayed in this order)
; (these tests should, be atomic, subscript - ch, type - both or output)
;
S ^TMP("LR7OGX",$J,"OUTPUT",1)="0^0^0^1"
N ABCNT,ABDCNT,ABLINE,ABTCNT,ABTLINE,ADCNT,ADSEQ,AGE,ATCNT,ATSEQ,CDT,CHSUB,COMCNT,COMMENT,DATACNT,DATESEQ,DFN,DISPDATE,EDATE,EDT,FLAG,I,IDT,INEXACT
N LINE,LRCW,LRDFN,LRPROV,LRX,LRY,NUM,ONLYSPEC,OUTCNT,PNM,PRNTCODE,RESULT,SDATE,SEX,SPEC,SPECNAME,TESTNAME,TESTNUM,TESTSEQ,TESTZERO,X,ZERO
F I="LR7OG","LRPLS","LRPLS-ADDR" K ^TMP(I,$J)
S DFN=+^TMP("LR7OGX",$J,"INPUT",1),SDATE=+$P(^(1),U,2),EDATE=+$P(^(1),U,3),ONLYSPEC=+$P(^(1),U,4)
D DEMO^LR7OGU(DFN,.LRDFN,.PNM,.AGE,.SEX)
Q:'DFN Q:'SDATE Q:'EDATE Q:'LRDFN
S (COMCNT,OUTCNT)=1,(ADCNT,ADSEQ,ATCNT,ATSEQ,DATACNT,DATESEQ,TESTSEQ)=0
S NUM=1
F S NUM=$O(^TMP("LR7OGX",$J,"INPUT",NUM)) Q:NUM<1 S TESTNUM=+^(NUM) D
. S TESTZERO=$G(^LAB(60,TESTNUM,0))
. S CHSUB=$P($P(TESTZERO,U,5),";",2)
. I 'CHSUB Q
. S TESTNAME=$P($G(^LAB(60,TESTNUM,.1)),U),PRNTCODE=$P($G(^(.1)),U,3)
. I TESTNAME="" S TESTNAME=$P(TESTZERO,U)
. S TESTSEQ=TESTSEQ+1
. S LINE=TESTSEQ_U_TESTNUM_U_TESTNAME_U_PRNTCODE
. S ^TMP("LR7OG",$J,"TEST",CHSUB)=LINE
. S OUTCNT=OUTCNT+1
. S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=LINE
S ^TMP("LR7OGX",$J,"OUTPUT",1)=TESTSEQ
S EDATE=EDATE\1
S IDT=9999999-SDATE,EDT=9999999-EDATE
F S IDT=$O(^LR(LRDFN,"CH",IDT)) Q:IDT<1 Q:IDT>EDT D
. S ZERO=^LR(LRDFN,"CH",IDT,0)
. I '$P(ZERO,U,3) Q
. S CDT=+ZERO,INEXACT=$P(ZERO,U,2),SPEC=+$P(ZERO,U,5),SPECNAME=$P($G(^LAB(61,SPEC,0)),U),COMMENT="**" ;COMMENT=$S($O(^LR(LRDFN,"CH",IDT,1,0)):"**",1:"")
. I ONLYSPEC,SPEC'=ONLYSPEC Q
. S LRPROV=$P(ZERO,"^",10)
. S CHSUB=1
. F S CHSUB=$O(^LR(LRDFN,"CH",IDT,CHSUB)) Q:CHSUB="" D
. . I '$D(^TMP("LR7OG",$J,"TEST",CHSUB)) Q
. . I '$D(^TMP("LR7OG",$J,"DATE",IDT)) S ^(IDT)="" D
. . . S DATESEQ=DATESEQ+1,OUTCNT=OUTCNT+1,DISPDATE=$S(INEXACT:CDT\1,1:CDT)
. . . S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=DATESEQ_U_CDT_U_SPEC_U_SPECNAME_U_COMMENT_U_DISPDATE
. . S LRX=$$TSTRES^LRRPU(LRDFN,"CH",IDT,CHSUB,"")
. . S RESULT=$P(LRX,"^"),FLAG=$P(LRX,U,2)
. . S PRNTCODE=$P(^TMP("LR7OG",$J,"TEST",CHSUB),U,4)
. . I PRNTCODE'="" S X=RESULT,LRCW=8 S @("RESULT="_PRNTCODE)
. . E S RESULT=$J(RESULT,8)
. . S RESULT=$$STRIP^LR7OGU(RESULT)
. . I FLAG'="" D
. . . S ABTLINE=^TMP("LR7OG",$J,"TEST",CHSUB)
. . . I '$D(^TMP("LR7OG",$J,"ABTSEQ",+ABTLINE)) S ^(+ABTLINE)=U_$P(ABTLINE,U,2,3)
. . . I '$D(^TMP("LR7OG",$J,"ABDSEQ",IDT)) S ^(IDT)=U_CDT_U_SPEC_U_SPECNAME_U_COMMENT
. . . S ^TMP("LR7OG",$J,"ABDATA",IDT,+ABTLINE)=RESULT_U_FLAG
. . S TESTSEQ=+^TMP("LR7OG",$J,"TEST",CHSUB)
. . S DATACNT=DATACNT+1
. . S ^TMP("LR7OG",$J,"DATA",DATACNT)=DATESEQ_U_TESTSEQ_U_RESULT_U_FLAG
. . D TESTSPEC(CHSUB,SPEC,SPECNAME,AGE,SEX)
. . I $P(LRX,"^",6) S ^TMP("LRPLS",$J,$P(LRX,"^",6),$P(^TMP("LR7OG",$J,"TEST",CHSUB),"^",3))=""
. I '$D(^TMP("LR7OG",$J,"DATE",IDT)) Q
. S ^TMP("LR7OG",$J,"COMMENT",COMCNT)=$P($$FMTE^XLFDT(CDT),":",1,2)_" ** Comments:",COMCNT=COMCNT+1
. I $D(^LR(LRDFN,"CH",IDT,1)) D
. . S NUM=0
. . F S NUM=$O(^LR(LRDFN,"CH",IDT,1,NUM)) Q:NUM<1 S LINE=$G(^(NUM,0)),^TMP("LR7OG",$J,"COMMENT",COMCNT)=LINE,COMCNT=COMCNT+1
. . S ^TMP("LR7OG",$J,"COMMENT",COMCNT)=" ",COMCNT=COMCNT+1
. S LRY=$$NAME^XUSER(LRPROV,"G")
. S ^TMP("LR7OG",$J,"COMMENT",COMCNT)="Ordering Provider: "_LRY,COMCNT=COMCNT+1
. D RRDT($P(ZERO,"^",3),.COMCNT)
. D PLS
S $P(^TMP("LR7OGX",$J,"OUTPUT",1),U,2,3)=DATESEQ_U_DATACNT
S DATACNT=0
F S DATACNT=$O(^TMP("LR7OG",$J,"DATA",DATACNT)) Q:DATACNT<1 S LINE=^(DATACNT) D
. S OUTCNT=OUTCNT+1,^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=LINE
S OUTCNT=OUTCNT+1,ABLINE=OUTCNT
S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)="0^0^0"
;
S (ABTCNT,ATSEQ)=0
F S ATSEQ=$O(^TMP("LR7OG",$J,"ABTSEQ",ATSEQ)) Q:ATSEQ<1 D
. S ABTCNT=ABTCNT+1
. S $P(^TMP("LR7OG",$J,"ABTSEQ",ATSEQ),U)=ABTCNT
. S OUTCNT=OUTCNT+1
. S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=^TMP("LR7OG",$J,"ABTSEQ",ATSEQ)
;
S (ABDCNT,ADSEQ)=0
F S ADSEQ=$O(^TMP("LR7OG",$J,"ABDSEQ",ADSEQ)) Q:ADSEQ<1 D
. S ABDCNT=ABDCNT+1
. S $P(^TMP("LR7OG",$J,"ABDSEQ",ADSEQ),U)=ABDCNT
. S OUTCNT=OUTCNT+1
. S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=^TMP("LR7OG",$J,"ABDSEQ",ADSEQ)
;
S (ABCNT,ADSEQ)=0
F S ADSEQ=$O(^TMP("LR7OG",$J,"ABDATA",ADSEQ)) Q:ADSEQ<1 D
. S ADCNT=+^TMP("LR7OG",$J,"ABDSEQ",ADSEQ)
. S ATSEQ=0
. F S ATSEQ=$O(^TMP("LR7OG",$J,"ABDATA",ADSEQ,ATSEQ)) Q:ATSEQ<1 D
. . S ATCNT=+^TMP("LR7OG",$J,"ABTSEQ",ATSEQ)
. . S ABCNT=ABCNT+1
. . S OUTCNT=OUTCNT+1
. . S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=ADCNT_U_ATCNT_U_^TMP("LR7OG",$J,"ABDATA",ADSEQ,ATSEQ)
;
S ^TMP("LR7OGX",$J,"OUTPUT",ABLINE)=ABTCNT_U_ABDCNT_U_ABCNT
S $P(^TMP("LR7OGX",$J,"OUTPUT",1),U,4)=OUTCNT
S TESTSEQ=0
F S TESTSEQ=$O(^TMP("LR7OG",$J,"TESTSPEC",TESTSEQ)) Q:TESTSEQ<1 D
. S SPEC=0
. F S SPEC=$O(^TMP("LR7OG",$J,"TESTSPEC",TESTSEQ,SPEC)) Q:SPEC<1 S LINE=^(SPEC) D
. . S OUTCNT=OUTCNT+1
. . S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=LINE
S $P(^TMP("LR7OGX",$J,"OUTPUT",1),U,5)=OUTCNT
;
S NUM=0
F S NUM=$O(^TMP("LR7OG",$J,"COMMENT",NUM)) Q:NUM<1 S LINE=^(NUM) D
. S OUTCNT=OUTCNT+1
. S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=LINE
;
F I="LR7OG","LRPLS","LRPLS-ADDR" K ^TMP(I,$J)
Q
;
;
TESTSPEC(CHSUB,SPEC,SPECNAME,AGE,SEX) ;
N RANGE,TESTNAME,TESTNUM,TESTSEQ,UNITS
S TESTSEQ=+$P(^TMP("LR7OG",$J,"TEST",CHSUB),U),TESTNUM=+$P(^(CHSUB),U,2),TESTNAME=$P(^(CHSUB),U,3)
I $D(^TMP("LR7OG",$J,"TESTSPEC",TESTSEQ,SPEC)) Q
D URANGE^LR7OGU(TESTNUM,SPEC,AGE,SEX,.UNITS,.RANGE)
S ^TMP("LR7OG",$J,"TESTSPEC",TESTSEQ,SPEC)=TESTNUM_U_SPECNAME_U_SPEC_U_UNITS_U_$P(RANGE," - ")_U_$P($P(RANGE," - ",2)," (")
Q
;
;
RRDT(LRDT,COMCNT) ; Display report released date/time
; Call with LRDT = Date/time report released (completed) in FileMan d/t format
; CNT = Current comment line counter (pass by reference)
N LRY
;
I LRDT S LRY=$$FMTE^XLFDT(LRDT,"M")
E S LRY=""
S ^TMP("LR7OG",$J,"COMMENT",COMCNT)="Report Released Date/Time: "_LRY,COMCNT=COMCNT+1
Q
;
;
PLS ; List reporting and performing laboratories
; If multiple performing labs then list tests associated with each lab.
;
;ZEXCEPT: COMCNT,IDT,LRDFN
;
N LINE,LLEN,LRPLS,LRX,MPLS,PLS,TESTNAME,X
;
; Reporting Laboratory
I $$GET^XPAR("DIV^PKG","LR REPORTS FACILITY PRINT",1,"Q")#2 D
. S LRX=+$G(^LR(LRDFN,"CH",IDT,"RF"))
. I LRX<1 Q
. S LINE=$$PLSADDR^LR7OSUM2(LRX)
. S ^TMP("LR7OG",$J,"COMMENT",COMCNT)=" ",COMCNT=COMCNT+1
. S ^TMP("LR7OG",$J,"COMMENT",COMCNT)="Reporting Lab: "_$P(LINE,"^"),COMCNT=COMCNT+1
. S ^TMP("LR7OG",$J,"COMMENT",COMCNT)=" "_$P(LINE,"^",2),COMCNT=COMCNT+1
;
S PLS=$O(^TMP("LRPLS",$J,0)),MPLS=0
I $O(^TMP("LRPLS",$J,PLS)) S MPLS=1 ; multiple performing labs
S LRPLS=0
F S LRPLS=$O(^TMP("LRPLS",$J,LRPLS)) Q:LRPLS<1 D
. S ^TMP("LR7OG",$J,"COMMENT",COMCNT)=" ",COMCNT=COMCNT+1
. I MPLS D
. . S TESTNAME="",LINE="For test(s): ",LLEN=13
. . F S TESTNAME=$O(^TMP("LRPLS",$J,LRPLS,TESTNAME)) Q:TESTNAME="" D
. . . S X=$L(TESTNAME)
. . . I (LLEN+X)>240 S ^TMP("LR7OG",$J,"COMMENT",COMCNT)=LINE,COMCNT=COMCNT+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("LR7OG",$J,"COMMENT",COMCNT)=LINE,COMCNT=COMCNT+1
. S LINE=$$PLSADDR^LR7OSUM2(LRPLS)
. S ^TMP("LR7OG",$J,"COMMENT",COMCNT)="Performing Lab: "_$P(LINE,"^"),COMCNT=COMCNT+1
. S ^TMP("LR7OG",$J,"COMMENT",COMCNT)=" "_$P(LINE,"^",2),COMCNT=COMCNT+1
;
S ^TMP("LR7OG",$J,"COMMENT",COMCNT)=" ",COMCNT=COMCNT+1
;
K ^TMP("LRPLS",$J)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLR7OGG 8625 printed Apr 09, 2024@21:15:53 Page 2
LR7OGG ;DALOI/STAFF- Interim report rpc grid ;02/11/11 15:09
+1 ;;5.2;LAB SERVICE;**187,290,364,350**;Sep 27, 1994;Build 230
+2 ;
TEST ; test use only
+1 NEW CNT,I
+2 KILL ^TMP("LR7OGX",$JOB)
+3 SET ^TMP("LR7OGX",$JOB,"INPUT",1)="2^2970202^2920202"
+4 SET CNT=1
+5 ;F I=1:1:10 I $D(^LAB(60,I,0)) S CNT=CNT+1,^TMP("LR7OGX",$J,"INPUT",CNT)=I
+6 FOR I=7,173,9,1
IF $DATA(^LAB(60,I,0))
SET CNT=CNT+1
SET ^TMP("LR7OGX",$JOB,"INPUT",CNT)=I
+7 DO GRIDDATA
+8 SET I=0
FOR
SET I=$ORDER(^TMP("LR7OGX",$JOB,"OUTPUT",I))
if I<1
QUIT
WRITE !,^(I)
+9 KILL ^TMP("LR7OGX",$JOB)
+10 QUIT
+11 ;
GRID(ROOT,DFN,DATE1,DATE2,SPEC,TESTS) ; from ORWLRR
+1 NEW CNT,NUM
+2 KILL ^TMP("LR7OGX",$JOB,"INPUT"),^("OUTPUT")
+3 SET ROOT=$NAME(^TMP("LR7OGX",$JOB,"OUTPUT"))
+4 SET ^TMP("LR7OGX",$JOB,"INPUT",1)=DFN_U_DATE1_U_DATE2_U_+SPEC
+5 SET CNT=1
SET NUM=0
FOR
SET NUM=$ORDER(TESTS(NUM))
if NUM<1
QUIT
Begin DoDot:1
+6 SET CNT=CNT+1
+7 SET ^TMP("LR7OGX",$JOB,"INPUT",CNT)=+TESTS(NUM)
End DoDot:1
+8 DO GRIDDATA
+9 QUIT
+10 ;
+11 ;
GRIDDATA ;
+1 ; input format
+2 ; ^TMP("LR7OGX",$J,"INPUT",1)=dfn^start date^end date^spec^all tests
+3 ; ^TMP("LR7OGX",$J,"INPUT",#)=test# (tests displayed in this order)
+4 ; (these tests should, be atomic, subscript - ch, type - both or output)
+5 ;
+6 SET ^TMP("LR7OGX",$JOB,"OUTPUT",1)="0^0^0^1"
+7 NEW ABCNT,ABDCNT,ABLINE,ABTCNT,ABTLINE,ADCNT,ADSEQ,AGE,ATCNT,ATSEQ,CDT,CHSUB,COMCNT,COMMENT,DATACNT,DATESEQ,DFN,DISPDATE,EDATE,EDT,FLAG,I,IDT,INEXACT
+8 NEW LINE,LRCW,LRDFN,LRPROV,LRX,LRY,NUM,ONLYSPEC,OUTCNT,PNM,PRNTCODE,RESULT,SDATE,SEX,SPEC,SPECNAME,TESTNAME,TESTNUM,TESTSEQ,TESTZERO,X,ZERO
+9 FOR I="LR7OG","LRPLS","LRPLS-ADDR"
KILL ^TMP(I,$JOB)
+10 SET DFN=+^TMP("LR7OGX",$JOB,"INPUT",1)
SET SDATE=+$PIECE(^(1),U,2)
SET EDATE=+$PIECE(^(1),U,3)
SET ONLYSPEC=+$PIECE(^(1),U,4)
+11 DO DEMO^LR7OGU(DFN,.LRDFN,.PNM,.AGE,.SEX)
+12 if 'DFN
QUIT
if 'SDATE
QUIT
if 'EDATE
QUIT
if 'LRDFN
QUIT
+13 SET (COMCNT,OUTCNT)=1
SET (ADCNT,ADSEQ,ATCNT,ATSEQ,DATACNT,DATESEQ,TESTSEQ)=0
+14 SET NUM=1
+15 FOR
SET NUM=$ORDER(^TMP("LR7OGX",$JOB,"INPUT",NUM))
if NUM<1
QUIT
SET TESTNUM=+^(NUM)
Begin DoDot:1
+16 SET TESTZERO=$GET(^LAB(60,TESTNUM,0))
+17 SET CHSUB=$PIECE($PIECE(TESTZERO,U,5),";",2)
+18 IF 'CHSUB
QUIT
+19 SET TESTNAME=$PIECE($GET(^LAB(60,TESTNUM,.1)),U)
SET PRNTCODE=$PIECE($GET(^(.1)),U,3)
+20 IF TESTNAME=""
SET TESTNAME=$PIECE(TESTZERO,U)
+21 SET TESTSEQ=TESTSEQ+1
+22 SET LINE=TESTSEQ_U_TESTNUM_U_TESTNAME_U_PRNTCODE
+23 SET ^TMP("LR7OG",$JOB,"TEST",CHSUB)=LINE
+24 SET OUTCNT=OUTCNT+1
+25 SET ^TMP("LR7OGX",$JOB,"OUTPUT",OUTCNT)=LINE
End DoDot:1
+26 SET ^TMP("LR7OGX",$JOB,"OUTPUT",1)=TESTSEQ
+27 SET EDATE=EDATE\1
+28 SET IDT=9999999-SDATE
SET EDT=9999999-EDATE
+29 FOR
SET IDT=$ORDER(^LR(LRDFN,"CH",IDT))
if IDT<1
QUIT
if IDT>EDT
QUIT
Begin DoDot:1
+30 SET ZERO=^LR(LRDFN,"CH",IDT,0)
+31 IF '$PIECE(ZERO,U,3)
QUIT
+32 ;COMMENT=$S($O(^LR(LRDFN,"CH",IDT,1,0)):"**",1:"")
SET CDT=+ZERO
SET INEXACT=$PIECE(ZERO,U,2)
SET SPEC=+$PIECE(ZERO,U,5)
SET SPECNAME=$PIECE($GET(^LAB(61,SPEC,0)),U)
SET COMMENT="**"
+33 IF ONLYSPEC
IF SPEC'=ONLYSPEC
QUIT
+34 SET LRPROV=$PIECE(ZERO,"^",10)
+35 SET CHSUB=1
+36 FOR
SET CHSUB=$ORDER(^LR(LRDFN,"CH",IDT,CHSUB))
if CHSUB=""
QUIT
Begin DoDot:2
+37 IF '$DATA(^TMP("LR7OG",$JOB,"TEST",CHSUB))
QUIT
+38 IF '$DATA(^TMP("LR7OG",$JOB,"DATE",IDT))
SET ^(IDT)=""
Begin DoDot:3
+39 SET DATESEQ=DATESEQ+1
SET OUTCNT=OUTCNT+1
SET DISPDATE=$SELECT(INEXACT:CDT\1,1:CDT)
+40 SET ^TMP("LR7OGX",$JOB,"OUTPUT",OUTCNT)=DATESEQ_U_CDT_U_SPEC_U_SPECNAME_U_COMMENT_U_DISPDATE
End DoDot:3
+41 SET LRX=$$TSTRES^LRRPU(LRDFN,"CH",IDT,CHSUB,"")
+42 SET RESULT=$PIECE(LRX,"^")
SET FLAG=$PIECE(LRX,U,2)
+43 SET PRNTCODE=$PIECE(^TMP("LR7OG",$JOB,"TEST",CHSUB),U,4)
+44 IF PRNTCODE'=""
SET X=RESULT
SET LRCW=8
SET @("RESULT="_PRNTCODE)
+45 IF '$TEST
SET RESULT=$JUSTIFY(RESULT,8)
+46 SET RESULT=$$STRIP^LR7OGU(RESULT)
+47 IF FLAG'=""
Begin DoDot:3
+48 SET ABTLINE=^TMP("LR7OG",$JOB,"TEST",CHSUB)
+49 IF '$DATA(^TMP("LR7OG",$JOB,"ABTSEQ",+ABTLINE))
SET ^(+ABTLINE)=U_$PIECE(ABTLINE,U,2,3)
+50 IF '$DATA(^TMP("LR7OG",$JOB,"ABDSEQ",IDT))
SET ^(IDT)=U_CDT_U_SPEC_U_SPECNAME_U_COMMENT
+51 SET ^TMP("LR7OG",$JOB,"ABDATA",IDT,+ABTLINE)=RESULT_U_FLAG
End DoDot:3
+52 SET TESTSEQ=+^TMP("LR7OG",$JOB,"TEST",CHSUB)
+53 SET DATACNT=DATACNT+1
+54 SET ^TMP("LR7OG",$JOB,"DATA",DATACNT)=DATESEQ_U_TESTSEQ_U_RESULT_U_FLAG
+55 DO TESTSPEC(CHSUB,SPEC,SPECNAME,AGE,SEX)
+56 IF $PIECE(LRX,"^",6)
SET ^TMP("LRPLS",$JOB,$PIECE(LRX,"^",6),$PIECE(^TMP("LR7OG",$JOB,"TEST",CHSUB),"^",3))=""
End DoDot:2
+57 IF '$DATA(^TMP("LR7OG",$JOB,"DATE",IDT))
QUIT
+58 SET ^TMP("LR7OG",$JOB,"COMMENT",COMCNT)=$PIECE($$FMTE^XLFDT(CDT),":",1,2)_" ** Comments:"
SET COMCNT=COMCNT+1
+59 IF $DATA(^LR(LRDFN,"CH",IDT,1))
Begin DoDot:2
+60 SET NUM=0
+61 FOR
SET NUM=$ORDER(^LR(LRDFN,"CH",IDT,1,NUM))
if NUM<1
QUIT
SET LINE=$GET(^(NUM,0))
SET ^TMP("LR7OG",$JOB,"COMMENT",COMCNT)=LINE
SET COMCNT=COMCNT+1
+62 SET ^TMP("LR7OG",$JOB,"COMMENT",COMCNT)=" "
SET COMCNT=COMCNT+1
End DoDot:2
+63 SET LRY=$$NAME^XUSER(LRPROV,"G")
+64 SET ^TMP("LR7OG",$JOB,"COMMENT",COMCNT)="Ordering Provider: "_LRY
SET COMCNT=COMCNT+1
+65 DO RRDT($PIECE(ZERO,"^",3),.COMCNT)
+66 DO PLS
End DoDot:1
+67 SET $PIECE(^TMP("LR7OGX",$JOB,"OUTPUT",1),U,2,3)=DATESEQ_U_DATACNT
+68 SET DATACNT=0
+69 FOR
SET DATACNT=$ORDER(^TMP("LR7OG",$JOB,"DATA",DATACNT))
if DATACNT<1
QUIT
SET LINE=^(DATACNT)
Begin DoDot:1
+70 SET OUTCNT=OUTCNT+1
SET ^TMP("LR7OGX",$JOB,"OUTPUT",OUTCNT)=LINE
End DoDot:1
+71 SET OUTCNT=OUTCNT+1
SET ABLINE=OUTCNT
+72 SET ^TMP("LR7OGX",$JOB,"OUTPUT",OUTCNT)="0^0^0"
+73 ;
+74 SET (ABTCNT,ATSEQ)=0
+75 FOR
SET ATSEQ=$ORDER(^TMP("LR7OG",$JOB,"ABTSEQ",ATSEQ))
if ATSEQ<1
QUIT
Begin DoDot:1
+76 SET ABTCNT=ABTCNT+1
+77 SET $PIECE(^TMP("LR7OG",$JOB,"ABTSEQ",ATSEQ),U)=ABTCNT
+78 SET OUTCNT=OUTCNT+1
+79 SET ^TMP("LR7OGX",$JOB,"OUTPUT",OUTCNT)=^TMP("LR7OG",$JOB,"ABTSEQ",ATSEQ)
End DoDot:1
+80 ;
+81 SET (ABDCNT,ADSEQ)=0
+82 FOR
SET ADSEQ=$ORDER(^TMP("LR7OG",$JOB,"ABDSEQ",ADSEQ))
if ADSEQ<1
QUIT
Begin DoDot:1
+83 SET ABDCNT=ABDCNT+1
+84 SET $PIECE(^TMP("LR7OG",$JOB,"ABDSEQ",ADSEQ),U)=ABDCNT
+85 SET OUTCNT=OUTCNT+1
+86 SET ^TMP("LR7OGX",$JOB,"OUTPUT",OUTCNT)=^TMP("LR7OG",$JOB,"ABDSEQ",ADSEQ)
End DoDot:1
+87 ;
+88 SET (ABCNT,ADSEQ)=0
+89 FOR
SET ADSEQ=$ORDER(^TMP("LR7OG",$JOB,"ABDATA",ADSEQ))
if ADSEQ<1
QUIT
Begin DoDot:1
+90 SET ADCNT=+^TMP("LR7OG",$JOB,"ABDSEQ",ADSEQ)
+91 SET ATSEQ=0
+92 FOR
SET ATSEQ=$ORDER(^TMP("LR7OG",$JOB,"ABDATA",ADSEQ,ATSEQ))
if ATSEQ<1
QUIT
Begin DoDot:2
+93 SET ATCNT=+^TMP("LR7OG",$JOB,"ABTSEQ",ATSEQ)
+94 SET ABCNT=ABCNT+1
+95 SET OUTCNT=OUTCNT+1
+96 SET ^TMP("LR7OGX",$JOB,"OUTPUT",OUTCNT)=ADCNT_U_ATCNT_U_^TMP("LR7OG",$JOB,"ABDATA",ADSEQ,ATSEQ)
End DoDot:2
End DoDot:1
+97 ;
+98 SET ^TMP("LR7OGX",$JOB,"OUTPUT",ABLINE)=ABTCNT_U_ABDCNT_U_ABCNT
+99 SET $PIECE(^TMP("LR7OGX",$JOB,"OUTPUT",1),U,4)=OUTCNT
+100 SET TESTSEQ=0
+101 FOR
SET TESTSEQ=$ORDER(^TMP("LR7OG",$JOB,"TESTSPEC",TESTSEQ))
if TESTSEQ<1
QUIT
Begin DoDot:1
+102 SET SPEC=0
+103 FOR
SET SPEC=$ORDER(^TMP("LR7OG",$JOB,"TESTSPEC",TESTSEQ,SPEC))
if SPEC<1
QUIT
SET LINE=^(SPEC)
Begin DoDot:2
+104 SET OUTCNT=OUTCNT+1
+105 SET ^TMP("LR7OGX",$JOB,"OUTPUT",OUTCNT)=LINE
End DoDot:2
End DoDot:1
+106 SET $PIECE(^TMP("LR7OGX",$JOB,"OUTPUT",1),U,5)=OUTCNT
+107 ;
+108 SET NUM=0
+109 FOR
SET NUM=$ORDER(^TMP("LR7OG",$JOB,"COMMENT",NUM))
if NUM<1
QUIT
SET LINE=^(NUM)
Begin DoDot:1
+110 SET OUTCNT=OUTCNT+1
+111 SET ^TMP("LR7OGX",$JOB,"OUTPUT",OUTCNT)=LINE
End DoDot:1
+112 ;
+113 FOR I="LR7OG","LRPLS","LRPLS-ADDR"
KILL ^TMP(I,$JOB)
+114 QUIT
+115 ;
+116 ;
TESTSPEC(CHSUB,SPEC,SPECNAME,AGE,SEX) ;
+1 NEW RANGE,TESTNAME,TESTNUM,TESTSEQ,UNITS
+2 SET TESTSEQ=+$PIECE(^TMP("LR7OG",$JOB,"TEST",CHSUB),U)
SET TESTNUM=+$PIECE(^(CHSUB),U,2)
SET TESTNAME=$PIECE(^(CHSUB),U,3)
+3 IF $DATA(^TMP("LR7OG",$JOB,"TESTSPEC",TESTSEQ,SPEC))
QUIT
+4 DO URANGE^LR7OGU(TESTNUM,SPEC,AGE,SEX,.UNITS,.RANGE)
+5 SET ^TMP("LR7OG",$JOB,"TESTSPEC",TESTSEQ,SPEC)=TESTNUM_U_SPECNAME_U_SPEC_U_UNITS_U_$PIECE(RANGE," - ")_U_$PIECE($PIECE(RANGE," - ",2)," (")
+6 QUIT
+7 ;
+8 ;
RRDT(LRDT,COMCNT) ; Display report released date/time
+1 ; Call with LRDT = Date/time report released (completed) in FileMan d/t format
+2 ; CNT = Current comment line counter (pass by reference)
+3 NEW LRY
+4 ;
+5 IF LRDT
SET LRY=$$FMTE^XLFDT(LRDT,"M")
+6 IF '$TEST
SET LRY=""
+7 SET ^TMP("LR7OG",$JOB,"COMMENT",COMCNT)="Report Released Date/Time: "_LRY
SET COMCNT=COMCNT+1
+8 QUIT
+9 ;
+10 ;
PLS ; List reporting and performing laboratories
+1 ; If multiple performing labs then list tests associated with each lab.
+2 ;
+3 ;ZEXCEPT: COMCNT,IDT,LRDFN
+4 ;
+5 NEW LINE,LLEN,LRPLS,LRX,MPLS,PLS,TESTNAME,X
+6 ;
+7 ; Reporting Laboratory
+8 IF $$GET^XPAR("DIV^PKG","LR REPORTS FACILITY PRINT",1,"Q")#2
Begin DoDot:1
+9 SET LRX=+$GET(^LR(LRDFN,"CH",IDT,"RF"))
+10 IF LRX<1
QUIT
+11 SET LINE=$$PLSADDR^LR7OSUM2(LRX)
+12 SET ^TMP("LR7OG",$JOB,"COMMENT",COMCNT)=" "
SET COMCNT=COMCNT+1
+13 SET ^TMP("LR7OG",$JOB,"COMMENT",COMCNT)="Reporting Lab: "_$PIECE(LINE,"^")
SET COMCNT=COMCNT+1
+14 SET ^TMP("LR7OG",$JOB,"COMMENT",COMCNT)=" "_$PIECE(LINE,"^",2)
SET COMCNT=COMCNT+1
End DoDot:1
+15 ;
+16 SET PLS=$ORDER(^TMP("LRPLS",$JOB,0))
SET MPLS=0
+17 ; multiple performing labs
IF $ORDER(^TMP("LRPLS",$JOB,PLS))
SET MPLS=1
+18 SET LRPLS=0
+19 FOR
SET LRPLS=$ORDER(^TMP("LRPLS",$JOB,LRPLS))
if LRPLS<1
QUIT
Begin DoDot:1
+20 SET ^TMP("LR7OG",$JOB,"COMMENT",COMCNT)=" "
SET COMCNT=COMCNT+1
+21 IF MPLS
Begin DoDot:2
+22 SET TESTNAME=""
SET LINE="For test(s): "
SET LLEN=13
+23 FOR
SET TESTNAME=$ORDER(^TMP("LRPLS",$JOB,LRPLS,TESTNAME))
if TESTNAME=""
QUIT
Begin DoDot:3
+24 SET X=$LENGTH(TESTNAME)
+25 IF (LLEN+X)>240
SET ^TMP("LR7OG",$JOB,"COMMENT",COMCNT)=LINE
SET COMCNT=COMCNT+1
SET LINE=""
SET LLEN=0
+26 SET LINE=LINE_$SELECT(LLEN>13:", ",1:"")_TESTNAME
SET LLEN=LLEN+X+$SELECT(LLEN>13:2,1:0)
End DoDot:3
+27 IF LINE'=""
SET ^TMP("LR7OG",$JOB,"COMMENT",COMCNT)=LINE
SET COMCNT=COMCNT+1
End DoDot:2
+28 SET LINE=$$PLSADDR^LR7OSUM2(LRPLS)
+29 SET ^TMP("LR7OG",$JOB,"COMMENT",COMCNT)="Performing Lab: "_$PIECE(LINE,"^")
SET COMCNT=COMCNT+1
+30 SET ^TMP("LR7OG",$JOB,"COMMENT",COMCNT)=" "_$PIECE(LINE,"^",2)
SET COMCNT=COMCNT+1
End DoDot:1
+31 ;
+32 SET ^TMP("LR7OG",$JOB,"COMMENT",COMCNT)=" "
SET COMCNT=COMCNT+1
+33 ;
+34 KILL ^TMP("LRPLS",$JOB)
+35 QUIT
