Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LR7OGG

LR7OGG.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1. TEST ; test use only
  1.  N CNT,I
  1.  K ^TMP("LR7OGX",$J)
  1.  S ^TMP("LR7OGX",$J,"INPUT",1)="2^2970202^2920202"
  1.  S CNT=1
  1.  ;F I=1:1:10 I $D(^LAB(60,I,0)) S CNT=CNT+1,^TMP("LR7OGX",$J,"INPUT",CNT)=I
  1.  F I=7,173,9,1 I $D(^LAB(60,I,0)) S CNT=CNT+1,^TMP("LR7OGX",$J,"INPUT",CNT)=I
  1.  D GRIDDATA
  1.  S I=0 F  S I=$O(^TMP("LR7OGX",$J,"OUTPUT",I)) Q:I<1  W !,^(I)
  1.  K ^TMP("LR7OGX",$J)
  1.  Q
  1.  ;
  1. GRID(ROOT,DFN,DATE1,DATE2,SPEC,TESTS) ; from ORWLRR
  1.  N CNT,NUM
  1.  K ^TMP("LR7OGX",$J,"INPUT"),^("OUTPUT")
  1.  S ROOT=$NA(^TMP("LR7OGX",$J,"OUTPUT"))
  1.  S ^TMP("LR7OGX",$J,"INPUT",1)=DFN_U_DATE1_U_DATE2_U_+SPEC
  1.  S CNT=1,NUM=0 F  S NUM=$O(TESTS(NUM)) Q:NUM<1  D
  1.  .S CNT=CNT+1
  1.  .S ^TMP("LR7OGX",$J,"INPUT",CNT)=+TESTS(NUM)
  1.  D GRIDDATA
  1.  Q
  1.  ;
  1.  ;
  1. GRIDDATA ;
  1.  ; input format
  1.  ; ^TMP("LR7OGX",$J,"INPUT",1)=dfn^start date^end date^spec^all tests
  1.  ; ^TMP("LR7OGX",$J,"INPUT",#)=test#  (tests displayed in this order)
  1.  ;   (these tests should, be atomic, subscript - ch, type - both or output)
  1.  ;
  1.  S ^TMP("LR7OGX",$J,"OUTPUT",1)="0^0^0^1"
  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
  1.  N LINE,LRCW,LRDFN,LRPROV,LRX,LRY,NUM,ONLYSPEC,OUTCNT,PNM,PRNTCODE,RESULT,SDATE,SEX,SPEC,SPECNAME,TESTNAME,TESTNUM,TESTSEQ,TESTZERO,X,ZERO
  1.  F I="LR7OG","LRPLS","LRPLS-ADDR" K ^TMP(I,$J)
  1.  S DFN=+^TMP("LR7OGX",$J,"INPUT",1),SDATE=+$P(^(1),U,2),EDATE=+$P(^(1),U,3),ONLYSPEC=+$P(^(1),U,4)
  1.  D DEMO^LR7OGU(DFN,.LRDFN,.PNM,.AGE,.SEX)
  1.  Q:'DFN  Q:'SDATE  Q:'EDATE  Q:'LRDFN
  1.  S (COMCNT,OUTCNT)=1,(ADCNT,ADSEQ,ATCNT,ATSEQ,DATACNT,DATESEQ,TESTSEQ)=0
  1.  S NUM=1
  1.  F  S NUM=$O(^TMP("LR7OGX",$J,"INPUT",NUM)) Q:NUM<1  S TESTNUM=+^(NUM) D
  1.  . S TESTZERO=$G(^LAB(60,TESTNUM,0))
  1.  . S CHSUB=$P($P(TESTZERO,U,5),";",2)
  1.  . I 'CHSUB Q
  1.  . S TESTNAME=$P($G(^LAB(60,TESTNUM,.1)),U),PRNTCODE=$P($G(^(.1)),U,3)
  1.  . I TESTNAME="" S TESTNAME=$P(TESTZERO,U)
  1.  . S TESTSEQ=TESTSEQ+1
  1.  . S LINE=TESTSEQ_U_TESTNUM_U_TESTNAME_U_PRNTCODE
  1.  . S ^TMP("LR7OG",$J,"TEST",CHSUB)=LINE
  1.  . S OUTCNT=OUTCNT+1
  1.  . S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=LINE
  1.  S ^TMP("LR7OGX",$J,"OUTPUT",1)=TESTSEQ
  1.  S EDATE=EDATE\1
  1.  S IDT=9999999-SDATE,EDT=9999999-EDATE
  1.  F  S IDT=$O(^LR(LRDFN,"CH",IDT)) Q:IDT<1  Q:IDT>EDT  D
  1.  . S ZERO=^LR(LRDFN,"CH",IDT,0)
  1.  . I '$P(ZERO,U,3) Q
  1.  . 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:"")
  1.  . I ONLYSPEC,SPEC'=ONLYSPEC Q
  1.  . S LRPROV=$P(ZERO,"^",10)
  1.  . S CHSUB=1
  1.  . F  S CHSUB=$O(^LR(LRDFN,"CH",IDT,CHSUB)) Q:CHSUB=""  D
  1.  . . I '$D(^TMP("LR7OG",$J,"TEST",CHSUB)) Q
  1.  . . I '$D(^TMP("LR7OG",$J,"DATE",IDT)) S ^(IDT)="" D
  1.  . . . S DATESEQ=DATESEQ+1,OUTCNT=OUTCNT+1,DISPDATE=$S(INEXACT:CDT\1,1:CDT)
  1.  . . . S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=DATESEQ_U_CDT_U_SPEC_U_SPECNAME_U_COMMENT_U_DISPDATE
  1.  . . S LRX=$$TSTRES^LRRPU(LRDFN,"CH",IDT,CHSUB,"")
  1.  . . S RESULT=$P(LRX,"^"),FLAG=$P(LRX,U,2)
  1.  . . S PRNTCODE=$P(^TMP("LR7OG",$J,"TEST",CHSUB),U,4)
  1.  . . I PRNTCODE'="" S X=RESULT,LRCW=8 S @("RESULT="_PRNTCODE)
  1.  . . E  S RESULT=$J(RESULT,8)
  1.  . . S RESULT=$$STRIP^LR7OGU(RESULT)
  1.  . . I FLAG'="" D
  1.  . . . S ABTLINE=^TMP("LR7OG",$J,"TEST",CHSUB)
  1.  . . . I '$D(^TMP("LR7OG",$J,"ABTSEQ",+ABTLINE)) S ^(+ABTLINE)=U_$P(ABTLINE,U,2,3)
  1.  . . . I '$D(^TMP("LR7OG",$J,"ABDSEQ",IDT)) S ^(IDT)=U_CDT_U_SPEC_U_SPECNAME_U_COMMENT
  1.  . . . S ^TMP("LR7OG",$J,"ABDATA",IDT,+ABTLINE)=RESULT_U_FLAG
  1.  . . S TESTSEQ=+^TMP("LR7OG",$J,"TEST",CHSUB)
  1.  . . S DATACNT=DATACNT+1
  1.  . . S ^TMP("LR7OG",$J,"DATA",DATACNT)=DATESEQ_U_TESTSEQ_U_RESULT_U_FLAG
  1.  . . D TESTSPEC(CHSUB,SPEC,SPECNAME,AGE,SEX)
  1.  . . I $P(LRX,"^",6) S ^TMP("LRPLS",$J,$P(LRX,"^",6),$P(^TMP("LR7OG",$J,"TEST",CHSUB),"^",3))=""
  1.  . I '$D(^TMP("LR7OG",$J,"DATE",IDT)) Q
  1.  . S ^TMP("LR7OG",$J,"COMMENT",COMCNT)=$P($$FMTE^XLFDT(CDT),":",1,2)_" ** Comments:",COMCNT=COMCNT+1
  1.  . I $D(^LR(LRDFN,"CH",IDT,1)) D
  1.  . . S NUM=0
  1.  . . 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
  1.  . . S ^TMP("LR7OG",$J,"COMMENT",COMCNT)=" ",COMCNT=COMCNT+1
  1.  . S LRY=$$NAME^XUSER(LRPROV,"G")
  1.  . S ^TMP("LR7OG",$J,"COMMENT",COMCNT)="Ordering Provider: "_LRY,COMCNT=COMCNT+1
  1.  . D RRDT($P(ZERO,"^",3),.COMCNT)
  1.  . D PLS
  1.  S $P(^TMP("LR7OGX",$J,"OUTPUT",1),U,2,3)=DATESEQ_U_DATACNT
  1.  S DATACNT=0
  1.  F  S DATACNT=$O(^TMP("LR7OG",$J,"DATA",DATACNT)) Q:DATACNT<1  S LINE=^(DATACNT) D
  1.  . S OUTCNT=OUTCNT+1,^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=LINE
  1.  S OUTCNT=OUTCNT+1,ABLINE=OUTCNT
  1.  S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)="0^0^0"
  1.  ;
  1.  S (ABTCNT,ATSEQ)=0
  1.  F  S ATSEQ=$O(^TMP("LR7OG",$J,"ABTSEQ",ATSEQ)) Q:ATSEQ<1  D
  1.  . S ABTCNT=ABTCNT+1
  1.  . S $P(^TMP("LR7OG",$J,"ABTSEQ",ATSEQ),U)=ABTCNT
  1.  . S OUTCNT=OUTCNT+1
  1.  . S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=^TMP("LR7OG",$J,"ABTSEQ",ATSEQ)
  1.  ;
  1.  S (ABDCNT,ADSEQ)=0
  1.  F  S ADSEQ=$O(^TMP("LR7OG",$J,"ABDSEQ",ADSEQ)) Q:ADSEQ<1  D
  1.  . S ABDCNT=ABDCNT+1
  1.  . S $P(^TMP("LR7OG",$J,"ABDSEQ",ADSEQ),U)=ABDCNT
  1.  . S OUTCNT=OUTCNT+1
  1.  . S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=^TMP("LR7OG",$J,"ABDSEQ",ADSEQ)
  1.  ;
  1.  S (ABCNT,ADSEQ)=0
  1.  F  S ADSEQ=$O(^TMP("LR7OG",$J,"ABDATA",ADSEQ)) Q:ADSEQ<1  D
  1.  . S ADCNT=+^TMP("LR7OG",$J,"ABDSEQ",ADSEQ)
  1.  . S ATSEQ=0
  1.  .  F  S ATSEQ=$O(^TMP("LR7OG",$J,"ABDATA",ADSEQ,ATSEQ)) Q:ATSEQ<1  D
  1.  . . S ATCNT=+^TMP("LR7OG",$J,"ABTSEQ",ATSEQ)
  1.  . . S ABCNT=ABCNT+1
  1.  . . S OUTCNT=OUTCNT+1
  1.  . . S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=ADCNT_U_ATCNT_U_^TMP("LR7OG",$J,"ABDATA",ADSEQ,ATSEQ)
  1.  ;
  1.  S ^TMP("LR7OGX",$J,"OUTPUT",ABLINE)=ABTCNT_U_ABDCNT_U_ABCNT
  1.  S $P(^TMP("LR7OGX",$J,"OUTPUT",1),U,4)=OUTCNT
  1.  S TESTSEQ=0
  1.  F  S TESTSEQ=$O(^TMP("LR7OG",$J,"TESTSPEC",TESTSEQ)) Q:TESTSEQ<1  D
  1.  . S SPEC=0
  1.  . F  S SPEC=$O(^TMP("LR7OG",$J,"TESTSPEC",TESTSEQ,SPEC)) Q:SPEC<1  S LINE=^(SPEC) D
  1.  . . S OUTCNT=OUTCNT+1
  1.  . . S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=LINE
  1.  S $P(^TMP("LR7OGX",$J,"OUTPUT",1),U,5)=OUTCNT
  1.  ;
  1.  S NUM=0
  1.  F  S NUM=$O(^TMP("LR7OG",$J,"COMMENT",NUM)) Q:NUM<1  S LINE=^(NUM) D
  1.  . S OUTCNT=OUTCNT+1
  1.  . S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=LINE
  1.  ;
  1.  F I="LR7OG","LRPLS","LRPLS-ADDR" K ^TMP(I,$J)
  1.  Q
  1.  ;
  1.  ;
  1. TESTSPEC(CHSUB,SPEC,SPECNAME,AGE,SEX) ;
  1.  N RANGE,TESTNAME,TESTNUM,TESTSEQ,UNITS
  1.  S TESTSEQ=+$P(^TMP("LR7OG",$J,"TEST",CHSUB),U),TESTNUM=+$P(^(CHSUB),U,2),TESTNAME=$P(^(CHSUB),U,3)
  1.  I $D(^TMP("LR7OG",$J,"TESTSPEC",TESTSEQ,SPEC)) Q
  1.  D URANGE^LR7OGU(TESTNUM,SPEC,AGE,SEX,.UNITS,.RANGE)
  1.  S ^TMP("LR7OG",$J,"TESTSPEC",TESTSEQ,SPEC)=TESTNUM_U_SPECNAME_U_SPEC_U_UNITS_U_$P(RANGE," - ")_U_$P($P(RANGE," - ",2)," (")
  1.  Q
  1.  ;
  1.  ;
  1. RRDT(LRDT,COMCNT) ; Display report released date/time
  1.  ; Call with LRDT = Date/time report released (completed) in FileMan d/t format
  1.  ;            CNT = Current comment line counter (pass by reference)
  1.  N LRY
  1.  ;
  1.  I LRDT S LRY=$$FMTE^XLFDT(LRDT,"M")
  1.  E  S LRY=""
  1.  S ^TMP("LR7OG",$J,"COMMENT",COMCNT)="Report Released Date/Time: "_LRY,COMCNT=COMCNT+1
  1.  Q
  1.  ;
  1.  ;
  1. PLS ; List reporting and performing laboratories
  1.  ; If multiple performing labs then list tests associated with each lab.
  1.  ;
  1.  ;ZEXCEPT: COMCNT,IDT,LRDFN
  1.  ;
  1.  N LINE,LLEN,LRPLS,LRX,MPLS,PLS,TESTNAME,X
  1.  ;
  1.  ; Reporting Laboratory
  1.  I $$GET^XPAR("DIV^PKG","LR REPORTS FACILITY PRINT",1,"Q")#2 D
  1.  . S LRX=+$G(^LR(LRDFN,"CH",IDT,"RF"))
  1.  . I LRX<1 Q
  1.  . S LINE=$$PLSADDR^LR7OSUM2(LRX)
  1.  . S ^TMP("LR7OG",$J,"COMMENT",COMCNT)=" ",COMCNT=COMCNT+1
  1.  . S ^TMP("LR7OG",$J,"COMMENT",COMCNT)="Reporting Lab: "_$P(LINE,"^"),COMCNT=COMCNT+1
  1.  . S ^TMP("LR7OG",$J,"COMMENT",COMCNT)="               "_$P(LINE,"^",2),COMCNT=COMCNT+1
  1.  ;
  1.  S PLS=$O(^TMP("LRPLS",$J,0)),MPLS=0
  1.  I $O(^TMP("LRPLS",$J,PLS)) S MPLS=1 ; multiple performing labs
  1.  S LRPLS=0
  1.  F  S LRPLS=$O(^TMP("LRPLS",$J,LRPLS)) Q:LRPLS<1  D
  1.  . S ^TMP("LR7OG",$J,"COMMENT",COMCNT)=" ",COMCNT=COMCNT+1
  1.  . I MPLS D
  1.  . . S TESTNAME="",LINE="For test(s): ",LLEN=13
  1.  . . F  S TESTNAME=$O(^TMP("LRPLS",$J,LRPLS,TESTNAME)) Q:TESTNAME=""  D
  1.  . . . S X=$L(TESTNAME)
  1.  . . . I (LLEN+X)>240 S ^TMP("LR7OG",$J,"COMMENT",COMCNT)=LINE,COMCNT=COMCNT+1,LINE="",LLEN=0
  1.  . . . S LINE=LINE_$S(LLEN>13:", ",1:"")_TESTNAME,LLEN=LLEN+X+$S(LLEN>13:2,1:0)
  1.  . . I LINE'="" S ^TMP("LR7OG",$J,"COMMENT",COMCNT)=LINE,COMCNT=COMCNT+1
  1.  . S LINE=$$PLSADDR^LR7OSUM2(LRPLS)
  1.  . S ^TMP("LR7OG",$J,"COMMENT",COMCNT)="Performing Lab: "_$P(LINE,"^"),COMCNT=COMCNT+1
  1.  . S ^TMP("LR7OG",$J,"COMMENT",COMCNT)="                "_$P(LINE,"^",2),COMCNT=COMCNT+1
  1.  ;
  1.  S ^TMP("LR7OG",$J,"COMMENT",COMCNT)=" ",COMCNT=COMCNT+1
  1.  ;
  1.  K ^TMP("LRPLS",$J)
  1.  Q