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

LR7OGM.m

Go to the documentation of this file. 
  1. LR7OGM ;DALOI/STAFF- Interim report rpc memo ;11/19/09  17:38
  1.  ;;5.2;LAB SERVICE;**187,220,312,286,395,350,523**;Sep 27, 1994;Build 4
  1.  ;Per VHA Directive 2004-038, this routine should not be modified
  1.  ;
  1. TEST ; test use only
  1.  N TESTS,I K TESTS,^TMP("LR7OGX",$J)
  1.  ;S TESTS(548)=548
  1.  ;F I=1:1:10 I $D(^LAB(60,I,0)) S TESTS(I)=I
  1.  D SELECT(16,3090730,2700202,.TESTS,1,0)
  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. INTERIM(ROOT,DFN,SDATE,EDATE) ; from ORWLRR
  1.  N FORMAT,MICROCHK,TESTS K TESTS
  1.  S (FORMAT,MICROCHK)=""
  1.  S ROOT=$NA(^TMP("LR7OGX",$J,"OUTPUT"))
  1.  D SELECT(DFN,SDATE,EDATE,.TESTS,FORMAT,MICROCHK) ;
  1.  Q
  1.  ;
  1. INTERIMG(ROOT,DFN,SDATE,DIR,FORMAT) ; from ORWLRR
  1.  N MICROCHK,TESTS K TESTS
  1.  S MICROCHK=1,FORMAT=$G(FORMAT,1)
  1.  S ROOT=$NA(^TMP("LR7OGX",$J,"OUTPUT"))
  1.  D SELECT(DFN,SDATE,DIR,.TESTS,FORMAT,MICROCHK) ;
  1.  Q
  1.  ;
  1. INTERIMS(ROOT,DFN,SDATE,EDATE,TESTLIST) ; from ORWLRR
  1.  N FORMAT,MICROCHK,NUM,TESTS K TESTS
  1.  S (FORMAT,MICROCHK)=""
  1.  S NUM=0 F  S NUM=$O(TESTLIST(NUM)) Q:NUM<1  S TESTS(+TESTLIST(NUM))=""
  1.  S ROOT=$NA(^TMP("LR7OGX",$J,"OUTPUT"))
  1.  D SELECT(DFN,SDATE,EDATE,.TESTS,FORMAT,MICROCHK) ;
  1.  Q
  1.  ;
  1. MICRO(ROOT,DFN,SDATE,EDATE) ; from ORWLRR
  1.  N FORMAT,MICROCHK,TESTS K TESTS
  1.  S FORMAT="",MICROCHK=-1
  1.  S ROOT=$NA(^TMP("LR7OGX",$J,"OUTPUT"))
  1.  D SELECT(DFN,SDATE,EDATE,.TESTS,FORMAT,MICROCHK) ;
  1.  Q
  1.  ;
  1. SELECT(DFN,SDATE,EDATE,TESTS,FORMAT,MICROCHK) ;
  1.  ; get patient info, and expand tests
  1.  ; route setup chem and/or micro data
  1.  ; 9th piece of output indicates format (2: CH of CH/MI exact date/time, 3: MI of CH/MI, else 1 or "")
  1.  N AGE,ALL,ASK,AVAIL,CNIDT,DIRECT,DONE,EDT,FOK,I,IDT,LRCAN,LRDFN,MICROSUB,MNIDT,NEWOLD,OUTCNT,PNM,ROUTE,SEX,SDT,SKIP
  1.  K MICROSUB
  1.  K ^TMP("LR7OG",$J),^TMP("LR7OGX",$J,"OUTPUT"),^TMP("LRPLS",$J)
  1.  S OUTCNT=1,(DONE,SKIP)=0
  1.  D DEMO^LR7OGU(DFN,.LRDFN,.PNM,.AGE,.SEX)
  1.  I '$G(LRDFN) Q
  1.  D NEWOLD^LR7OGMU(.NEWOLD,DFN)
  1.  ;LR*523 Make NEWOLD date format match IDT format - reverse date
  1.  S $P(NEWOLD,U)=9999999-$P(NEWOLD,U),$P(NEWOLD,U,2)=9999999-$P(NEWOLD,U,2)
  1.  S ^TMP("LR7OG",$J,"G")=DFN_U_PNM_U_LRDFN_U_AGE_U_SEX_"^8"
  1.  S ALL=$S($O(TESTS(0)):0,1:1)
  1.  I 'ALL D TESTSGET^LR7OGU(.TESTS,.MICROSUB)
  1.  S DIRECT=1
  1.  I FORMAT S DIRECT=EDATE,EDATE=2700101
  1.  S EDATE=EDATE\1
  1.  S (IDT,SDT)=9999999-SDATE,EDT=9999999-EDATE
  1.  I FORMAT>1 S FOK=0 D  I FOK Q
  1.  . I DIRECT=1 D  Q
  1.  . . I FORMAT=2 D  Q
  1.  . . . D MI^LR7OGMM(LRDFN,IDT,.MICROSUB,ALL,.OUTCNT,FORMAT,.DONE,.SKIP)
  1.  . . . I SKIP S SKIP=0 Q
  1.  . . . S $P(^TMP("LR7OGX",$J,"OUTPUT",1),U,9)=3
  1.  . . . S FOK=1
  1.  . . I FORMAT=3 D  Q
  1.  . . . S $P(^TMP("LR7OGX",$J,"OUTPUT",1),U,9)=1
  1.  . I DIRECT=-1 D  Q
  1.  . . I FORMAT=2 D  Q
  1.  . . . S $P(^TMP("LR7OGX",$J,"OUTPUT",1),U,9)=1
  1.  . . I FORMAT=3 D  Q
  1.  . . . D CH^LR7OGMC(LRDFN,IDT,ALL,.OUTCNT,FORMAT,.DONE,.SKIP)
  1.  . . . I SKIP S SKIP=0 Q
  1.  . . . S $P(^TMP("LR7OGX",$J,"OUTPUT",1),U,9)=2
  1.  . . . S FOK=1
  1.  I ALL S ASK="BOTH"
  1.  E  I $O(MICROSUB(0)) D
  1.  . S ASK="MI" I $O(^TMP("LR7OG",$J,"TMP",0)) S ASK="BOTH"
  1.  E  S ASK="CH"
  1.  S I=IDT,CNIDT=0 F  S I=$O(^LR(LRDFN,"CH",I),DIRECT) Q:'I  S CNIDT=I Q
  1.  S I=IDT,MNIDT=0 F  S I=$O(^LR(LRDFN,"MI",I),DIRECT) Q:'I  S MNIDT=I Q
  1.  S AVAIL="NONE"
  1.  I CNIDT,CNIDT'>EDT D
  1.  . S AVAIL="CH" I MNIDT,MNIDT'>EDT S AVAIL="BOTH"
  1.  E  I MNIDT,MNIDT'>EDT S AVAIL="MI"
  1.  I DIRECT=-1 S AVAIL="BOTH"
  1.  S ROUTE="NONE"
  1.  I ASK="BOTH" S ROUTE=AVAIL
  1.  I ASK="CH",AVAIL="CH"!(AVAIL="BOTH") S ROUTE="CH"
  1.  I ASK="MI",AVAIL="MI"!(AVAIL="BOTH") S ROUTE="MI"
  1.  I MICROCHK=-1 S ROUTE="MI"
  1.  I ROUTE="NONE" D  Q
  1.  . K ^TMP("LR7OG",$J)
  1.  ;
  1.  ; Print "printed at" header on start of report.
  1.  I 'FORMAT,$$GET^XPAR("DIV^PKG","LR REPORTS FACILITY PRINT",1,"Q")>1 D PFAC^LR7OGMP
  1.  ;
  1.  I ROUTE="CH" D  Q
  1.  . F  S IDT=$O(^LR(LRDFN,"CH",IDT),DIRECT) Q:IDT<1  Q:IDT>EDT  D  Q:DONE
  1.  . . D CH^LR7OGMC(LRDFN,IDT,ALL,.OUTCNT,FORMAT,.DONE,.SKIP)
  1.  . . I SKIP S SKIP=0 Q
  1.  . I 'FORMAT,$D(^TMP("LRPLS",$J)) D PLS^LR7OGMP
  1.  . K ^TMP("LR7OG",$J),^TMP("LRPLS",$J)
  1.  ;
  1.  I ROUTE="MI" D  Q
  1.  . F  S IDT=$O(^LR(LRDFN,"MI",IDT),DIRECT) Q:IDT<1  Q:IDT>EDT  D  Q:DONE
  1.  . . D MI^LR7OGMM(LRDFN,IDT,.MICROSUB,ALL,.OUTCNT,FORMAT,.DONE,.SKIP)
  1.  . . I SKIP S SKIP=0 Q
  1.  . K ^TMP("LR7OG",$J)
  1.  F  D  Q:DONE
  1.  . S I=IDT,CNIDT=0 F  S I=$O(^LR(LRDFN,"CH",I),DIRECT) Q:'I  S CNIDT=I Q
  1.  . S I=IDT,MNIDT=0 F  S I=$O(^LR(LRDFN,"MI",I),DIRECT) Q:'I  S MNIDT=I Q
  1.  . I 'CNIDT,'MNIDT S DONE=1 Q
  1.  . D  I IDT>EDT S DONE=1 Q
  1.  . . I CNIDT=MNIDT D  Q  ; both chem and micro at this date/time
  1.  . . . S IDT=CNIDT
  1.  . . . I IDT'>EDT D
  1.  . . . . I FORMAT D  Q
  1.  . . . . . I SDT=(9999999-2700101)!(DIRECT=-1) D  Q
  1.  . . . . . . D MI^LR7OGMM(LRDFN,IDT,.MICROSUB,ALL,.OUTCNT,FORMAT,.DONE,.SKIP)
  1.  . . . . . . I SKIP S SKIP=0 D  Q
  1.  . . . . . . . D CH^LR7OGMC(LRDFN,IDT,ALL,.OUTCNT,FORMAT,.DONE,.SKIP)
  1.  . . . . . . . I SKIP S SKIP=0 Q
  1.  . . . . . . . I $P(NEWOLD,U),$P(NEWOLD,U)'=IDT D  Q
  1.  . . . . . . . . S $P(^TMP("LR7OGX",$J,"OUTPUT",1),U,9)=3
  1.  . . . . . . . S $P(^TMP("LR7OGX",$J,"OUTPUT",1),U,9)=1
  1.  . . . . . . ;LR 523 Check if a CH test at same date/time is displayable
  1.  . . . . . . ; necessary to correctly enable/disable NEXT button
  1.  . . . . . . D CH^LR7OGMC(LRDFN,IDT,ALL,.OUTCNT,4,.DONE,.SKIP)
  1.  . . . . . . I SKIP S SKIP=0,$P(^TMP("LR7OGX",$J,"OUTPUT",1),U,9)=($S(DIRECT=-1:1,1:2)) Q
  1.  . . . . . . S $P(^TMP("LR7OGX",$J,"OUTPUT",1),U,9)=3
  1.  . . . . . D CH^LR7OGMC(LRDFN,IDT,ALL,.OUTCNT,FORMAT,.DONE,.SKIP)
  1.  . . . . . I SKIP S SKIP=0 D  Q
  1.  . . . . . . D MI^LR7OGMM(LRDFN,IDT,.MICROSUB,ALL,.OUTCNT,FORMAT,.DONE,.SKIP)
  1.  . . . . . . I SKIP S SKIP=0 Q
  1.  . . . . . . I $P(NEWOLD,U),$P(NEWOLD,U)'=IDT D  Q
  1.  . . . . . . . S $P(^TMP("LR7OGX",$J,"OUTPUT",1),U,9)=3
  1.  . . . . . . S $P(^TMP("LR7OGX",$J,"OUTPUT",1),U,9)=1
  1.  . . . . . I $P(NEWOLD,U),$P(NEWOLD,U)'=IDT D  Q
  1.  . . . . . . S $P(^TMP("LR7OGX",$J,"OUTPUT",1),U,9)=2
  1.  . . . . . S $P(^TMP("LR7OGX",$J,"OUTPUT",1),U,9)=2
  1.  . . . . I MICROCHK'=1 D  Q:DONE
  1.  . . . . . D CH^LR7OGMC(LRDFN,IDT,ALL,.OUTCNT,FORMAT,.DONE,.SKIP)
  1.  . . . . . I SKIP S SKIP=0 Q
  1.  . . . . . I FORMAT S MICROCHK=1
  1.  . . . . D MI^LR7OGMM(LRDFN,IDT,.MICROSUB,ALL,.OUTCNT,FORMAT,.DONE,.SKIP)
  1.  . . . . I SKIP S SKIP=0 Q
  1.  . . I 'MNIDT D  Q  ; no micro since this date/time, only chem at this date/time
  1.  . . . S IDT=CNIDT
  1.  . . . I IDT'>EDT D CH^LR7OGMC(LRDFN,IDT,ALL,.OUTCNT,FORMAT,.DONE,.SKIP)
  1.  . . . I SKIP S SKIP=0 Q
  1.  . . I 'CNIDT D  Q  ; no chem since this date/time, only micro at this date/time
  1.  . . . S IDT=MNIDT
  1.  . . . I IDT'>EDT D MI^LR7OGMM(LRDFN,IDT,.MICROSUB,ALL,.OUTCNT,FORMAT,.DONE,.SKIP)
  1.  . . . I SKIP S SKIP=0 Q
  1.  . . I (DIRECT=1&(CNIDT<MNIDT))!(DIRECT=-1&(CNIDT>MNIDT)) D  Q  ;chem and micro data, chem is more recent
  1.  . . . S IDT=CNIDT
  1.  . . . I IDT'>EDT D CH^LR7OGMC(LRDFN,IDT,ALL,.OUTCNT,FORMAT,.DONE,.SKIP)
  1.  . . . I SKIP S SKIP=0 Q
  1.  . . S IDT=MNIDT
  1.  . . I IDT'>EDT D MI^LR7OGMM(LRDFN,IDT,.MICROSUB,ALL,.OUTCNT,FORMAT,.DONE,.SKIP)
  1.  . . I SKIP S SKIP=0 Q
  1.  ;
  1.  I 'FORMAT,$D(^TMP("LRPLS",$J)) D PLS^LR7OGMP
  1.  ;
  1.  K ^TMP("LR7OG",$J),^TMP("LRPLS",$J),^TMP("LRPLS-ADDR",$J)
  1.  Q