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

LR7OSUM3.m

Go to the documentation of this file.
  1. LR7OSUM3 ;DALOI/STAFF - Silent Patient cum cont. ;02/20/13 16:5
  1. ;;5.2;LAB SERVICE;**121,201,187,228,250,350,427**;Sep 27, 1994;Build 33
  1. ;
  1. N GIOM,LRPF,LRI
  1. S GIOM=$G(LRGIOM)
  1. I GIOM="" D
  1. . S GIOM=$$GET^XPAR("USR^DIV^PKG","LR CH GUI REPORT RIGHT MARGIN",1,"Q")
  1. . I GIOM="" S GIOM=80
  1. S LRAG=0,LRYESCOM=0,LRIL=0,LRFULL=0
  1. ;
  1. ; Print header with name of facility printing report.
  1. I $$GET^XPAR("DIV^PKG","LR REPORTS FACILITY PRINT",1,"Q")>1 D PFAC
  1. ;
  1. D LRMH S LRMH="MISC"
  1. G PRE^LR7OSUM6
  1. ;
  1. LRMH S LRMH=0
  1. F S LRMH=$O(^TMP($J,LRDFN,LRMH)) Q:LRMH<1 S X=^(LRMH) D MH1
  1. Q
  1. ;
  1. ;
  1. MH1 S LRMHN=$P(X,U,1),LRSH=0
  1. S LRPG=1
  1. D TOP^LR7OSUM6
  1. S LROFMT="",LRFDE=0 D LRSH
  1. D:'LRFDE LRBOT^LR7OSUM6
  1. K LRTM,^TMP($J,"TM")
  1. S LRFULL=0,LRTM=0,LROFMT="",LRFDE=0
  1. Q
  1. ;
  1. ;
  1. LRSH ;from LR7OSUM4, LR7OSUM5
  1. S LRSH=$O(^TMP($J,LRDFN,LRMH,LRSH)) Q:LRSH<1 G:$D(^(LRSH))'=11 LRSH S X=^(LRSH),LRSHN=$P(X,U,1),LRTOPP=$P(X,U,2),LRSHD=$P(X,U,3),LRFMT=$P(X,U,4),LRFMT(1)=$E(LRFMT,1),LROFMT(1)=$E(LROFMT,1)
  1. Q:$S('$D(SUBHEAD):0,1:'$D(SUBHEAD(LRSHN)))
  1. I (LROFMT["V"&(LRFMT["V"))!(LROFMT'=""&(LRFMT(1)'=LROFMT(1))) S LROFMT="" D HEAD^LR7OSUM6
  1. S LROFMT=LRFMT,LRTOPP=$E($P(^LAB(61,LRTOPP,0),U,1),1,13),LRTOT=0,LRPL=1,LRACT=0,LRJS=0,LRTS=0,LRFDE=0
  1. S LRNP=0,LRFDT=0,LRLFDT=0,LRFFDT=0 D LRNP
  1. ;
  1. LOOP ;from LR7OSUM5
  1. I LRACT<LRPL S LRFDT=LRFFDT G:LRFMT["H" TS^LR7OSUM5 I LRFMT["V" S LRMULT=99999,LRMU=0 G BS^LR7OSUM4
  1. D TXT1^LR7OSUM5
  1. I LRCTR'<LRLNS S LRFULL=1 S:'LRFDT LRFED=1 D:LRFDE LRBOT^LR7OSUM6 D:'LRFDT HEAD^LR7OSUM6 S LRFULL=0 G LRSH
  1. G LRSH
  1. ;
  1. ;
  1. LRNP ;from LR7OSUM4
  1. S I=0 F S I=$O(^LAB(64.5,1,1,LRMH,1,LRSH,1,I)) Q:I<1 D
  1. . N LRCW
  1. . S LRCW=$P(^LAB(64.5,1,1,LRMH,1,LRSH,1,I,0),U,2)
  1. . I LRCW<1 S LRCW=15
  1. . S LRTOT=LRTOT+LRCW
  1. . I LRTOT>(GIOM-25) S LRPL=LRPL+1,LRTOT=LRCW
  1. LRLNS ;from LR7OSUM5
  1. K LRTM,^TMP($J,"TM") S LRTM=0
  1. S LRLNS=((GIOSL-18)-(GCNT+(6*LRPL)))\LRPL
  1. S LRCL=(GIOM/2)-(5+($L(LRSHN)/2)) S GCNT=GCNT+1,CCNT=1,^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(LRCL,CCNT,"---- "_LRSHN_" ----")
  1. S ^TMP("LRH",$J,LRSHN)=GCNT ;Set x-ref of minor headers with data
  1. S LRACT=0,LRJS=0,LRNP=1
  1. Q
  1. ;
  1. ;
  1. UDT ;from LR7OSUM4, LR7OSUM5
  1. N LRBDT,LREAL
  1. S LRBDT=LRFDT
  1. ; If inexact date/time then suppress any pseudo time.
  1. S LREAL=+$P(^TMP($J,LRDFN,LRMH,LRSH,LRFDT,0),U,6)
  1. ; Forces all formats to be inverse date/time regardless of parameter in file 64.5
  1. S LRFDT=$P(^TMP($J,LRDFN,LRMH,LRSH,LRFDT,0),U,2) ;,LRTIM=$E(LRFDT,9,12)
  1. ;F I=0:0 Q:$L(LRTIM)=4 S LRTIM=LRTIM_0
  1. ;S LRTIM=$S(LRTIM?4"0":" ",1:$E(LRTIM,1,2)_":"_$E(LRTIM,3,4))
  1. ;S LRUDT=$E($$Y2K^LRX($P(LRFDT,".")),1,5)_" "_$J(LRTIM,4)_" "
  1. S LRFDT=LRBDT D:LRTM LRTM
  1. Q
  1. ;
  1. ;
  1. LRTM ;
  1. S LRNXSW=0 S:'$D(LRTM(0)) LRTM(0)=96
  1. I $D(^TMP($J,"TM",LRFDT)) S LRNXSW=1
  1. E I $D(^TMP($J,LRDFN,LRMH,LRSH,LRFDT,"TX")) D
  1. . S ^TMP($J,"TM",LRFDT)=^TMP("LRCMTINDX",$J,LRFDT),LRNXSW=1
  1. . S I=0 F S I=$O(^TMP($J,LRDFN,LRMH,LRSH,LRFDT,"TX",I)) Q:I<1 S ^TMP($J,"TM",LRFDT,I)=^(I,0)
  1. N LRUDT7
  1. ;S LRUDT7=$$Y2K^LRX(9999999-LRFDT)
  1. ;S LRUDT7=$$FMTE^XLFDT(9999999-LRFDT,"1"_$S(LREAL:"D",1:"M"))
  1. S LRUDT7=$$LRUDT^LR7OSUM6(9999999-LRFDT,LREAL)
  1. S LRUDT=$P(LRUDT7,"@")_" "_$E($P(LRUDT7,"@",2),1,5)
  1. ;S:LRNXSW I=$P(^TMP($J,"TM",LRFDT),"^"),LRUDT=I_$E(" ",1,$S(I'="":1,1:2))_LRUDT
  1. I LRNXSW D
  1. . S I=$P(^TMP($J,"TM",LRFDT),"^")
  1. . I I'="" S I="["_I_"]"
  1. . S LRUDT=$$LJ^XLFSTR(I,5)_LRUDT_" "
  1. Q
  1. ;
  1. ;
  1. PFAC ; Print header with name of facility printing report.
  1. ;
  1. D PFAC^LRRP1(DUZ(2),0,1,.LRPF)
  1. I ($O(^TMP($J,LRDFN,0))!($O(^TMP($J,LRDFN,"MISC",0)))),$D(LRPF) D
  1. . S LRI=0
  1. . F S LRI=$O(LRPF(LRI)) Q:'LRI D LN^LR7OSUM4 S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(CCNT,CCNT,LRPF(LRI))
  1. . D LINE^LR7OSUM4 S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(CCNT,CCNT,"As of: "_$$HTE^XLFDT($H,"1M"))
  1. . D LINE^LR7OSUM4,LINE^LR7OSUM4
  1. Q