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

LR7OSMZU.m

Go to the documentation of this file.
  1. LR7OSMZU ;DALOI/STAFF - Silent Micro rpt cont. ;11/05/09 12:04
  1. ;;5.2;LAB SERVICE;**121,244,350**;Sep 27, 1994;Build 230
  1. ;
  1. ;
  1. FH ;from LR7OSMZ2, LR7OSMZ5
  1. Q
  1. ;
  1. ;
  1. FHR ;from LR7OSMZ1, LR7OSMZ2
  1. D REFS
  1. Q
  1. ;
  1. ;
  1. REFS ;from LR7OSMZ1
  1. S B=1,LREF=0
  1. F S LREF=$O(LRBUG(LREF)) Q:LREF="" S LRIFN=LRBUG(LREF) D LIST Q:LREND
  1. K LRBUG
  1. Q
  1. ;
  1. ;
  1. LIST Q:'$D(^LAB(61.2,LRIFN,"JR",0))
  1. S LRNUM=0
  1. F S LRNUM=$O(^LAB(61.2,LRIFN,"JR",LRNUM)) Q:LRNUM="" D WR Q:LREND
  1. Q
  1. ;
  1. ;
  1. WR ;
  1. S X1=^LAB(61.2,LRIFN,"JR",LRNUM,0)
  1. Q:$P(X1,U,7)'=1
  1. I B=1 D LINE^LR7OSUM4,LINE^LR7OSUM4 S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"Reference(s): ")
  1. S B=0
  1. D LINE^LR7OSUM4,LINE^LR7OSUM4
  1. S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,$J(LREF,2)_". "_$P(X1,U,2))
  1. D LINE^LR7OSUM4
  1. S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,$P(X1,U))
  1. D LINE^LR7OSUM4
  1. I $P(X1,U,3)'="" S ^TMP("LRC",$J,GCNT,0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(CCNT,CCNT,$P(^LAB(95,$P(X1,U,3),0),U)_" "_$P(X1,U,4)_":")
  1. S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(CCNT,CCNT,$P(X1,U,5))
  1. I $P(X1,U,6)'="" S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(CCNT,CCNT,","_$E($P(X1,U,6),1,3)+1700)
  1. Q
  1. ;
  1. ;
  1. HDR ;from LR7OSMZ1
  1. N LRI,LRPF,LRX
  1. ;
  1. S LRPG=LRPG+1,LRJ02=1
  1. D LINE^LR7OSUM4
  1. S X=GIOM/2-(12/2+5),^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(X,CCNT,"---- MICROBIOLOGY ----")
  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. ; Display reporting lab
  1. I $$GET^XPAR("DIV^PKG","LR REPORTS FACILITY PRINT",1,"Q")#2 D
  1. . S LRX=+$G(^LR(LRDFN,"MI",LRIDT,"RF"))
  1. . I LRX D RL(LRX)
  1. ;
  1. ;D LINE^LR7OSUM4
  1. K LRX
  1. D ORUA^LRRP1(.LRX,LRDFN,"MI",LRIDT,1)
  1. S LRI=0
  1. F S LRI=$O(LRX(LRI)) Q:LRI<1 D LINE^LR7OSUM4 S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,LRX(LRI))
  1. ;S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"Accession: "_LRACC)_$$S^LR7OS(40,CCNT,"Received: "_LRRC)
  1. ;
  1. D LINE^LR7OSUM4
  1. S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"Collection sample: "_LRCS)_$$S^LR7OS(40,CCNT,"Collection date: "_LRTK)
  1. I LRCS'=LRST,LRPG=1 D LINE^LR7OSUM4 S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"Site/Specimen: "_LRST)
  1. I LRPG=1 D
  1. . D LINE^LR7OSUM4
  1. . S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"Provider: "_LRDOC)
  1. . D LINE^LR7OSUM4
  1. . I LRCMNT'="" S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"Comment on specimen: "_$S($L(LRCMNT)>58:"",1:LRCMNT)) D LINE^LR7OSUM4
  1. . I $L(LRCMNT)>58 S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,LRCMNT) D LINE^LR7OSUM4
  1. Q
  1. ;
  1. ;
  1. PRE ;from LR7OSMZ2, LR7OSMZ3, LR7OSMZ4
  1. Q:LRTUS["F"&('$D(^XUSEC("LRLAB",DUZ))!$D(LRWRDVEW))
  1. I +$O(^LR(LRDFN,"MI",LRIDT,LRPRE,0)) D
  1. . D LINE^LR7OSUM4 S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"Preliminary Comments: ")
  1. . S J=0
  1. . F S J=+$O(^LR(LRDFN,"MI",LRIDT,LRPRE,J)) Q:J<1 S X=^(J,0) D LINE^LR7OSUM4 S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(3,CCNT,X)
  1. D LINE^LR7OSUM4
  1. Q
  1. ;
  1. ;
  1. RL(LRX) ; Set reporting lab into TMP global
  1. ; Call with LRX = IEN of entry in file #4
  1. ;
  1. N LINE
  1. S LINE=$$PLSADDR^LR7OSUM2(LRX)
  1. D LINE^LR7OSUM4
  1. D LINE^LR7OSUM4
  1. S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"Reporting Lab: "_$P(LINE,"^"))
  1. D LINE^LR7OSUM4
  1. S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT," "_$P(LINE,"^",2))
  1. D LINE^LR7OSUM4
  1. Q
  1. ;
  1. ;
  1. PFAC ; Print header with name of facility printing report.
  1. ;
  1. N LRI,LRPF
  1. D PFAC^LRRP1(DUZ(2),0,1,.LRPF)
  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. ;
  1. Q