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

LR7OSUM2.m

Go to the documentation of this file.
  1. LR7OSUM2 ;DALOI/staff - Silent Patient cum cont. ;08/28/09 14:13
  1. ;;5.2;LAB SERVICE;**350**;Sep 27, 1994;Build 230
  1. ;
  1. ;
  1. ORDBY ; List ordering provider
  1. N L,LRMH,LRSH,LRY
  1. S LRY=$$NAME^XUSER(LRPROV,"G")
  1. ;
  1. S LRMH=0
  1. F S LRMH=$O(^TMP($J,LRDFN,LRMH)) Q:'LRMH D
  1. . S LRSH=0
  1. . F S LRSH=$O(^TMP($J,LRDFN,LRMH,LRSH)) Q:'LRSH D
  1. . . I '$D(^TMP($J,LRDFN,LRMH,LRSH,LRIDT)) Q
  1. . . S L=+$O(^TMP($J,LRDFN,LRMH,LRSH,LRIDT,"TX",9999999),-1),L=L+1
  1. . . I L>1 S ^TMP($J,LRDFN,LRMH,LRSH,LRIDT,"TX",L,0)=" ",L=L+1
  1. . . S ^TMP($J,LRDFN,LRMH,LRSH,LRIDT,"TX",L,0)="Ordering Provider: "_LRY
  1. . . S ^TMP("LRCMTINDX",$J,LRIDT)=""
  1. ;
  1. I $D(^TMP($J,LRDFN,"MISC",LRIDT)) D
  1. . S L=+$O(^TMP($J,LRDFN,"MISC",LRIDT,"TX",9999999),-1),L=L+1
  1. . S ^TMP($J,LRDFN,"MISC",LRIDT,"TX",L,0)=" "
  1. . S ^TMP($J,LRDFN,"MISC",LRIDT,"TX",L+1,0)="Ordering Provider: "_LRY
  1. Q
  1. ;
  1. ;
  1. RELDT ; List report release date/time
  1. N L,LRMH,LRSH,LRY
  1. S LRY=$$FMTE^XLFDT(LRVDT,"M")
  1. ;
  1. S LRMH=0
  1. F S LRMH=$O(^TMP($J,LRDFN,LRMH)) Q:'LRMH D
  1. . S LRSH=0
  1. . F S LRSH=$O(^TMP($J,LRDFN,LRMH,LRSH)) Q:'LRSH D
  1. . . I '$D(^TMP($J,LRDFN,LRMH,LRSH,LRIDT)) Q
  1. . . S L=+$O(^TMP($J,LRDFN,LRMH,LRSH,LRIDT,"TX",9999999),-1),L=L+1
  1. . . S ^TMP($J,LRDFN,LRMH,LRSH,LRIDT,"TX",L,0)="Report Released..: "_LRY
  1. . . S ^TMP("LRCMTINDX",$J,LRIDT)=""
  1. ;
  1. I $D(^TMP($J,LRDFN,"MISC",LRIDT)) D
  1. . S L=+$O(^TMP($J,LRDFN,"MISC",LRIDT,"TX",9999999),-1),L=L+1
  1. . S ^TMP($J,LRDFN,"MISC",LRIDT,"TX",L+1,0)="Report Released..: "_LRY
  1. Q
  1. ;
  1. ;
  1. RL ; List reporting laboratory
  1. N L,LINE,LRMH,LRSH,LRX
  1. ; Retrieve reporting lab
  1. S LRX=+$G(^LR(LRDFN,"CH",LRIDT,"RF"))
  1. I LRX<1 Q
  1. S LINE=$$PLSADDR(LRX)
  1. ;
  1. S LRMH=0
  1. F S LRMH=$O(^TMP($J,LRDFN,LRMH)) Q:'LRMH D
  1. . S LRSH=0
  1. . F S LRSH=$O(^TMP($J,LRDFN,LRMH,LRSH)) Q:'LRSH D
  1. . . I '$D(^TMP($J,LRDFN,LRMH,LRSH,LRIDT)) Q
  1. . . S L=+$O(^TMP($J,LRDFN,LRMH,LRSH,LRIDT,"TX",9999999),-1),L=L+1
  1. . . S ^TMP($J,LRDFN,LRMH,LRSH,LRIDT,"TX",L,0)="Reporting Lab....: "_$P(LINE,"^"),L=L+1
  1. . . S ^TMP($J,LRDFN,LRMH,LRSH,LRIDT,"TX",L,0)=" "_$P(LINE,"^",2)
  1. . . S ^TMP("LRCMTINDX",$J,LRIDT)=""
  1. ;
  1. I $D(^TMP($J,LRDFN,"MISC",LRIDT)) D
  1. . S L=+$O(^TMP($J,LRDFN,"MISC",LRIDT,"TX",9999999),-1),L=L+1
  1. . S ^TMP($J,LRDFN,"MISC",LRIDT,"TX",L,0)="Reporting Lab....: "_$P(LINE,"^"),L=L+1
  1. . S ^TMP($J,LRDFN,"MISC",LRIDT,"TX",L,0)=" "_$P(LINE,"^",2)
  1. ;
  1. Q
  1. ;
  1. ;
  1. PLS ; List performing laboratories
  1. ; If multiple performing labs then list tests associated with each lab.
  1. ;
  1. N CLIA,CNT,LINE,LLEN,LRMH,LRMPLS,LRPLS,LRSH,OUTCNT,TESTNAME,X
  1. ;
  1. ; Tests formatted to a header
  1. S LRMH=0
  1. F S LRMH=$O(^TMP($J,LRDFN,LRMH)) Q:'LRMH D
  1. . S LRSH=0
  1. . F S LRSH=$O(^TMP($J,LRDFN,LRMH,LRSH)) Q:'LRSH D
  1. . . I '$D(^TMP($J,LRDFN,LRMH,LRSH,LRIDT)) Q
  1. . . S OUTCNT=+$O(^TMP($J,LRDFN,LRMH,LRSH,LRIDT,"TX",9999999),-1),OUTCNT=OUTCNT+1,CNT=0
  1. . . S LRMPLS=+$O(^TMP("LRPLS",$J,LRMH,LRSH,0)),LRMPLS=+$O(^TMP("LRPLS",$J,LRMH,LRSH,LRMPLS)) ; More than one performing lab to report
  1. . . S LRPLS=0
  1. . . F S LRPLS=$O(^TMP("LRPLS",$J,LRMH,LRSH,LRPLS)) Q:LRPLS<1 D
  1. . . . I CNT S ^TMP($J,LRDFN,LRMH,LRSH,LRIDT,"TX",OUTCNT,0)=" ",OUTCNT=OUTCNT+1
  1. . . . I LRMPLS D
  1. . . . . S TESTNAME="",LINE="For test(s): ",LLEN=13
  1. . . . . F S TESTNAME=$O(^TMP("LRPLS",$J,LRMH,LRSH,LRPLS,TESTNAME)) Q:TESTNAME="" D
  1. . . . . . S X=$L(TESTNAME)
  1. . . . . . I (LLEN+X)>240 S ^TMP($J,LRDFN,LRMH,LRSH,LRIDT,"TX",OUTCNT,0)=LINE,OUTCNT=OUTCNT+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($J,LRDFN,LRMH,LRSH,LRIDT,"TX",OUTCNT,0)=LINE,OUTCNT=OUTCNT+1
  1. . . . S LINE=$$PLSADDR(LRPLS)
  1. . . . S ^TMP($J,LRDFN,LRMH,LRSH,LRIDT,"TX",OUTCNT,0)="Performing Lab...: "_$P(LINE,"^"),OUTCNT=OUTCNT+1,CNT=CNT+1
  1. . . . S ^TMP($J,LRDFN,LRMH,LRSH,LRIDT,"TX",OUTCNT,0)=" "_$P(LINE,"^",2),OUTCNT=OUTCNT+1
  1. . . I CNT>0 S ^TMP($J,LRDFN,LRMH,LRSH,LRIDT,"TX",OUTCNT,0)=" ",^TMP("LRCMTINDX",$J,LRIDT)=""
  1. ;
  1. ; Miscellaneous tests
  1. S OUTCNT=+$O(^TMP($J,LRDFN,"MISC",LRIDT,"TX",9999999),-1),OUTCNT=OUTCNT+1,CNT=0
  1. S LRMPLS=+$O(^TMP("LRPLS",$J,"MISC",0)),LRMPLS=+$O(^TMP("LRPLS",$J,"MISC",LRMPLS)) ; More than one performing lab to report
  1. S LRPLS=0
  1. F S LRPLS=$O(^TMP("LRPLS",$J,"MISC",LRPLS)) Q:LRPLS<1 D
  1. . I CNT S ^TMP($J,LRDFN,"MISC",LRIDT,"TX",OUTCNT,0)=" ",OUTCNT=OUTCNT+1
  1. . I LRMPLS D
  1. . . S TESTNAME="",LINE="For test(s): ",LLEN=13
  1. . . F S TESTNAME=$O(^TMP("LRPLS",$J,"MISC",LRPLS,TESTNAME)) Q:TESTNAME="" D
  1. . . . S X=$L(TESTNAME)
  1. . . . I (LLEN+X)>240 S ^TMP($J,LRDFN,"MISC",LRIDT,"TX",OUTCNT,0)=LINE,OUTCNT=OUTCNT+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($J,LRDFN,"MISC",LRIDT,"TX",OUTCNT,0)=LINE,OUTCNT=OUTCNT+1
  1. . S LINE=$$PLSADDR(LRPLS)
  1. . S ^TMP($J,LRDFN,"MISC",LRIDT,"TX",OUTCNT,0)="Performing Lab...: "_$P(LINE,"^"),OUTCNT=OUTCNT+1,CNT=CNT+1
  1. . S ^TMP($J,LRDFN,"MISC",LRIDT,"TX",OUTCNT,0)=" "_$P(LINE,"^",2),OUTCNT=OUTCNT+1
  1. I CNT>0 S ^TMP($J,LRDFN,"MISC",LRIDT,"TX",OUTCNT,0)=" "
  1. ;
  1. K ^TMP("LRPLS",$J),^TMP("LRPLS-ADDR",$J)
  1. Q
  1. ;
  1. ;
  1. PLSADDR(LRPLS) ; Performing lab name/address/CLIA
  1. ; Call with LRPLS = ien of entry in file #4
  1. ; Returns LINE = name [CLIA# nnnn] ^ address of institution
  1. ;
  1. ; Saves information in TMP("LRPLS-ADDR",$J) for subsequent use by this process.
  1. ;
  1. N CLIA,LINE,LRX
  1. S LINE=""
  1. I $D(^TMP("LRPLS-ADDR",$J,LRPLS)) S LINE=^TMP("LRPLS-ADDR",$J,LRPLS)
  1. I LINE="" D
  1. . S LINE=$$NAME^XUAF4(LRPLS),CLIA=$$ID^XUAF4("CLIA",LRPLS)
  1. . I CLIA'="" S LINE=LINE_" [CLIA# "_CLIA_"]"
  1. . S LRX=$$PADD^XUAF4(LRPLS),LRX(1)=$$WHAT^XUAF4(LRPLS,1.02)
  1. . S LINE=LINE_"^"_$P(LRX,U)_" "_$S(LRX(1)'="":LRX(1)_" ",1:"")_$P(LRX,U,2)_$S($P(LRX,U,3)'="":", ",1:"")_$P(LRX,U,3)_" "_$P(LRX,U,4)
  1. . S ^TMP("LRPLS-ADDR",$J,LRPLS)=LINE
  1. Q LINE
  1. ;
  1. ;
  1. CMTINDX ; Generate comment indexes for each specimen date/time
  1. N CNT,LRIDT,LRNX
  1. S LRIDT=0,CNT=1
  1. F S LRIDT=$O(^TMP("LRCMTINDX",$J,LRIDT)) Q:'LRIDT S ^TMP("LRCMTINDX",$J,LRIDT)=$$LRNX(CNT),CNT=CNT+1
  1. Q
  1. ;
  1. ;
  1. LRNX(CNT) ; Generate comment index
  1. ; Call with CNT = current seed value
  1. ; Returns LRNX = comment index
  1. N LRNX
  1. ;
  1. S LRNX=""
  1. F S J=CNT#26,LRNX=$C(96+$S(J=0:26,1:J))_LRNX,CNT=$S(CNT#26=0:(CNT\26)-1,1:CNT\26) Q:CNT<1
  1. ;
  1. Q LRNX