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

LR7OSUM.m

Go to the documentation of this file.
  1. LR7OSUM ;DALOI/STAFF - Silent Patient cum ;11/19/09 18:15
  1. ;;5.2;LAB SERVICE;**121,187,230,256,350**;Sep 27, 1994;Build 230
  1. ;
  1. ;
  1. DFN S LRIN=0,LRIDT=0,LREND=0,LROUT=9999999
  1. K ZTRTN,DIC,X2
  1. D ^LRDPA Q:Y<0
  1. U IO
  1. D LRLLOC,END
  1. Q
  1. ;
  1. ;
  1. LRLLOC ;
  1. N GCNT,GIOM,GIOSL,CCNT,B,C,LRSB,VA,VA200,VAERR,W
  1. S CCNT=1,GCNT=0,GIOSL=999999,LRLLOC=$S($L(LRWRD):LRWRD,$D(^LR(LRDFN,.1)):^(.1),1:"File Room"),SSN=" "_SSN_" "
  1. S ^TMP($J,LRDFN,0)=PNM_U_SSN_U_AGE_U_LRDPF_U_DFN
  1. I $S('$D(SUBHEAD):1,1:$D(SUBHEAD("MISCELLANEOUS TESTS"))) S ^TMP($J,LRDFN,"MISC")="MISCELLANEOUS TESTS^"
  1. D LRIDT^LR7OSUM1
  1. D ^LR7OSUM3
  1. ;
  1. I $S('$D(SUBHEAD):1,1:$D(SUBHEAD("MICROBIOLOGY"))) D MICRO^LR7OSUM1
  1. I $S('$D(SUBHEAD):1,1:$D(SUBHEAD("BLOOD BANK"))) D
  1. . N GIOM
  1. . S GIOM=$G(LRGIOM)
  1. . I GIOM="" S GIOM=80
  1. . D EN^LR7OSBR
  1. ;
  1. ; Anatomic Path
  1. D EN^LR7OSAP
  1. Q
  1. ;
  1. ;
  1. END ; Cleanup variables
  1. D END^LRACM
  1. D CLEAN
  1. ;
  1. Q
  1. ;
  1. ;
  1. EN(Y,DFN,SDATE,EDATE,COUNT,LRGIOM,SUBHEAD) ; Enter here to get silent lab results
  1. ; Results in "CH" subscript are stored in the Cumulative format
  1. ; Headers for each format are found in ^TMP("LRH",$J,name)=ln count
  1. ; Index for where tests are found in ^TMP("LRT",$J,print name)=header^line # of1st occurance. Entries without a header means that the test exists in the report, but no result.
  1. ; Formatted reports are found in ^TMP("LRC",$J,ifn)
  1. ; DFN = Patient
  1. ; SDATE = Start date to search for results (optional)
  1. ; EDATE = End date to search for results (optional)
  1. ; COUNT = Count of results to send (optional)
  1. ; LRGIOM = Right margin
  1. ; SUBHEAD = Array of subheaders from file 64.5, misc, micro & AP to show results. Null param = get all results
  1. ;
  1. Q:'$G(DFN)
  1. S LRDFN=$$LRDFN^LR7OR1(DFN)
  1. Q:'LRDFN
  1. K ^TMP($J,"EVAL")
  1. N A,AGE,CT1,DIC,DOB,F,G,H,I,IFN,INC,J,K,LR,LRA,LRAA,LRABV,LRACT,LRADM,LRADX,LRCNT,LRCTN,LRDP,LREND,LRJ02,LRMD,LRMIT,LRN,LRNAME,LRPRAC,LRQ,LRRB,LRSAV,LRSPE,LRSPEM,LRTEST,LRTOP,LRTREA,LRUNKNOW,LRUNT,LRVAL,LRW,M,N,P,P7,S1,SP,T,X,X1,XZ,Y,Y1
  1. D PT^LRX
  1. S LRADM=$P($G(VAIN(7)),"^",2),LRADX=$G(VAIN(9)),CT1=0
  1. K VA,VADM,VAERR,VAIN
  1. D DTRNG^LR7OR1
  1. S COUNT=$S($G(COUNT):COUNT,1:9999999)
  1. I $G(LRGIOM)>240 S LRGIOM=240
  1. S (LRIN,LRIDT)=SDATE,LROUT=EDATE,LREND=0
  1. D LRLLOC,END
  1. S Y=$NA(^TMP("LRC",$J))
  1. Q
  1. ;
  1. ;
  1. TEST ; Test the output
  1. N IFN
  1. S IFN=0 F S IFN=$O(^TMP("LRC",$J,IFN)) Q:IFN<1 W !,^(IFN,0)
  1. Q
  1. ;
  1. ;
  1. GET64(Y) ; Get minor headers from file 64.5
  1. N I,J
  1. S I=0
  1. F S I=$O(^LAB(64.5,1,1,I)) Q:I<1 S J=0 F S J=$O(^LAB(64.5,1,1,I,1,J)) Q:J<1 S X=^(J,0),Y($P(X,"^"))=""
  1. S Y("MISCELLANEOUS TESTS")=""
  1. S Y("MICROBIOLOGY")=""
  1. S Y("BLOOD BANK")=""
  1. S Y("CYTOPATHOLOGY")=""
  1. S Y("SURGICAL PATHOLOGY")=""
  1. S Y("EM")=""
  1. S Y("AUTOPSY")=""
  1. S Y=$NA(Y)
  1. Q
  1. ;
  1. ;
  1. PT ; Test with a loop thru multiple patients
  1. N X,DFN,PTN,PTNX
  1. W !!,"How many patients: " R X:DTIME Q:X["^"
  1. I X'?1N.N W !!,"Enter a number" G PT
  1. S DFN=0,PTNX=X
  1. F PTN=1:1:PTNX S DFN=$O(^DPT(DFN)) Q:DFN<1 I $D(^DPT(DFN,"LR")) K ^TMP("LRC",$J),^TMP("LRH",$J),^TMP("LRT",$J) D EN(.Y,DFN) W !!!!,"////////////////////"_$P(^DPT(DFN,0),"^")_" LRDFN:"_+^DPT(DFN,"LR")_"////////////////////",!! D TEST
  1. Q
  1. ;
  1. ;
  1. CLEAN ; Clean up TMP globals
  1. K ^TMP("LRT",$J),^TMP("LRPLS",$J),^TMP("LRPLS-ADDR",$J),^TMP("LRCMTINDX",$J)
  1. Q
  1. ;
  1. ;
  1. AP(DFN) ; Get just the AP results
  1. Q:'$D(DFN)
  1. N GIOM,SUBHEAD,LRAU,LRV,LRZ,%I,E
  1. K ^TMP("LRC",$J)
  1. S SUBHEAD("CYTOPATHOLOGY")=""
  1. S SUBHEAD("SURGICAL PATHOLOGY")=""
  1. S SUBHEAD("EM")=""
  1. S SUBHEAD("AUTOPSY")=""
  1. S GIOM=$$GET^XPAR("USR^DIV^PKG","LR AP GUI REPORT RIGHT MARGIN",1,"Q")
  1. I GIOM="" S GIOM=80
  1. D EN(.ZIP,DFN,,,,GIOM,.SUBHEAD)
  1. Q