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

LR7OSUM1.m

Go to the documentation of this file.
  1. LR7OSUM1 ;DALOI/staff - Silent Patient cum cont. ;06/03/13 11:17
  1. ;;5.2;LAB SERVICE;**121,187,256,286,384,350,427**;Sep 27, 1994;Build 33
  1. ;
  1. LRIDT ; from LR7OSUM
  1. N GIOM,LRDRL
  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. K ^TMP("LRPLS",$J),^TMP("LRPLS-ADDR",$J),^TMP("LRCMTINDX",$J)
  1. ;
  1. ; Flag to determine if reporting laboratory is printed on report
  1. S LRDRL=$$GET^XPAR("DIV^PKG","LR REPORTS FACILITY PRINT",1,"Q")#2
  1. ;
  1. F S LRIDT=$O(^LR(LRDFN,"CH",LRIDT)) Q:LRIDT<1!(LRIDT>LROUT)!(CT1>COUNT) I $D(^(LRIDT,0)) S X=^(0),CT1=CT1+1 D LRIIDT
  1. D CMTINDX^LR7OSUM2
  1. Q
  1. ;
  1. ;
  1. LRIIDT ;
  1. N LRIIDT,LRAN,LRPROV,LREAL,LRSPM,LRSPM1,LRSUB,LRTLOC,LRTNN,LRTST,LRTSTS,LRVDT,LRVIDT
  1. S (LRIIDT,LRVIDT)=$P(X,U,1),LREAL=$P(X,U,2),LRSUB=1,LRTNN=1,LRSPM=$P(X,U,5),LRTLOC=$E($P(X,U,11),1,7),LRVDT=$P(X,U,3),LRAN=$P(X,U,6),LRPROV=$P(X,U,10)
  1. ;
  1. I LRVDT D Q
  1. . D LRSUB,ORDBY^LR7OSUM2,RELDT^LR7OSUM2
  1. . I LRDRL D RL^LR7OSUM2
  1. . D PLS^LR7OSUM2
  1. ;
  1. I LRVDT="" D
  1. . D CHKNP,ORDBY^LR7OSUM2
  1. . I LRDRL D RL^LR7OSUM2
  1. . N OUTCNT
  1. . S OUTCNT=+$O(^TMP($J,LRDFN,"MISC",LRIDT,"TX",9999999),-1),OUTCNT=OUTCNT+1
  1. . S ^TMP($J,LRDFN,"MISC",LRIDT,"TX",OUTCNT,0)=" "
  1. ;
  1. Q
  1. ;
  1. ;
  1. LRSUB ;
  1. N LRTRES
  1. S LRSUB=1
  1. F S LRSUB=$O(^LR(LRDFN,"CH",LRIDT,LRSUB)) Q:LRSUB<1 D
  1. . S X=^LR(LRDFN,"CH",LRIDT,LRSUB)
  1. . S LRTRES=$$TSTRES^LRRPU(LRDFN,"CH",LRIDT,LRSUB,"")
  1. . I $P(LRTRES,"^",1)="" Q
  1. . D SUB1
  1. Q
  1. ;
  1. ;
  1. SUB1 ;
  1. N LRNOFL,LRTSTVAL
  1. S LRTSTVAL=$P(LRTRES,U,1)
  1. S LRNOFL="",LRTST=$O(^LAB(60,"C","CH;"_LRSUB_";"_1,0))
  1. Q:LRTST=""
  1. Q:"IN"[$P(^LAB(60,LRTST,0),U,3)
  1. I '$D(^LAB(64.5,"AC",LRSUB)) D MISC Q
  1. K LRNON
  1. D LRMH
  1. I '$D(LRNON) D MISC
  1. Q
  1. ;
  1. ;
  1. LRMH ;
  1. S LRMH=0
  1. F S LRMH=$O(^LAB(64.5,"AC",LRSUB,1,LRMH)) Q:LRMH<1 D LRSH
  1. Q
  1. ;
  1. ;
  1. LRSH ;
  1. S LRSH=0
  1. F S LRSH=$O(^LAB(64.5,"AC",LRSUB,1,LRMH,LRSH)) Q:LRSH<1 D TST
  1. Q
  1. ;
  1. ;
  1. TST ;
  1. S LRTSTS=0
  1. F S LRTSTS=$O(^LAB(64.5,"AC",LRSUB,1,LRMH,LRSH,LRTSTS)) Q:'LRTSTS S LRSPM1=^(LRTSTS) D TST1
  1. Q
  1. ;
  1. ;
  1. TST1 ;
  1. Q:LRSPM'=LRSPM1
  1. ;
  1. SBSET ;
  1. N LRMHN,LRTF
  1. S LRMHN=$P(^LAB(64.5,1,1,LRMH,0),U,1),LRTF=^(1,LRSH,0),$P(LRTF,U,4)=$P(LRTF,U,3),$P(LRTF,U,3)=$P(^(1,0),U,4),LRNON=1
  1. Q:$S('$D(SUBHEAD):0,1:'$D(SUBHEAD($P(LRTF,"^"))))
  1. ;
  1. ;** LRTE=Total minor headings
  1. ;** LRMHN=Major heading name^TE^Lab performing tests
  1. ;** LRTF=Minor header^Profile specimen^Total tests^Type of display
  1. ;
  1. S LRIIDT=LRVIDT
  1. S:'$D(^TMP($J,LRDFN,LRMH)) ^(LRMH)=LRMHN
  1. S:'$D(^TMP($J,LRDFN,LRMH,LRSH))!($D(^(LRSH))=10) ^(LRSH)=LRTF_U
  1. S:'$D(^TMP($J,LRDFN,LRMH,LRSH,LRIDT,0)) ^(0)=LRTLOC_U_LRVIDT_U_LRVDT_U_LRAN_U_LRIDT_U_LREAL
  1. ;
  1. LRTSTVAL ;
  1. ;
  1. N TST
  1. S ^TMP($J,LRDFN,LRMH,LRSH,LRIDT,LRTSTS)=$P(LRTRES,"^")_"^"_$P(LRTRES,"^",2)
  1. S X=$P($G(^LAB(64.5,1,1,LRMH,1,LRSH,1,LRTSTS,0)),"^",3)
  1. I X'="" S ^TMP("LRT",$J,X)=$P(LRTF,"^")
  1. ;
  1. ; Check for comment on specimen and put in TMP global on first pass
  1. I $D(^LR(LRDFN,"CH",LRIDT,1,0)),'$D(^TMP($J,LRDFN,LRMH,LRSH,LRIDT,"TX",0)) D TEXT
  1. ;
  1. ; Check if individual result's unit/normals different from test units/normals
  1. I $P(LRTRES,"^")'?1(1"pending",1"comment",1"canc") D CHKUN
  1. ;
  1. S TST=$S($P($G(^LAB(60,LRTST,.1)),"^")'="":$P(^(.1),"^"),1:$P(^LAB(60,LRTST,0),"^"))
  1. I $O(^LAB(60,LRTST,1,LRSPM,1,0)),'$D(^TMP($J,"EVAL",LRTST,LRSPM)) D
  1. . S ^TMP($J,"EVAL",LRTST,LRSPM)=""
  1. . N I,L,X
  1. . S I=0
  1. . S L=+$O(^TMP($J,LRDFN,LRMH,LRSH,LRIDT,"TX",9999999),-1),L=L+1,^TMP($J,LRDFN,LRMH,LRSH,LRIDT,"TX",L,0)="Evaluation for "_TST_":"
  1. . F S I=$O(^LAB(60,LRTST,1,LRSPM,1,I)) Q:'I S X=^(I,0) S L=L+1,^TMP($J,LRDFN,LRMH,LRSH,LRIDT,"TX",L,0)=X
  1. . S ^TMP("LRCMTINDX",$J,LRIDT)=""
  1. ;
  1. ; Save performing lab ien in list
  1. I $P(LRTRES,U,6) S ^TMP("LRPLS",$J,LRMH,LRSH,$P(LRTRES,U,6),TST)="",^TMP("LRCMTINDX",$J,LRIDT)=""
  1. Q
  1. ;
  1. ;
  1. MISC ;
  1. Q:$S('$D(SUBHEAD):0,1:'$D(SUBHEAD("MISCELLANEOUS TESTS")))
  1. S LRTST=$O(^LAB(60,"C","CH;"_LRSUB_";"_1,0))
  1. Q:LRTST=""
  1. Q:"IN"[$P(^LAB(60,LRTST,0),U,3)
  1. N LRTOP,TST
  1. S LRTOP=LRSPM
  1. ;
  1. S:'$D(^TMP($J,LRDFN,"MISC",LRIDT,0)) ^(0)=LRIDT_U_LRVIDT_U_LRVDT_U_LRAN_U_LRSPM_U_LREAL
  1. S ^TMP($J,LRDFN,"MISC",LRIDT,LRTNN)=$P(LRTRES,"^")_U_LRSPM_U_LRTST_U_$P(LRTRES,"^",2)_U_LRSUB_U_$P(LRTRES,"^",3,6)
  1. ;
  1. S TST=$P($G(^LAB(60,LRTST,.1)),"^")
  1. I TST="" S TST=$P(^LAB(60,LRTST,0),"^")
  1. S ^TMP("LRT",$J,TST)="MISCELLANEOUS TESTS"
  1. ;
  1. ; Grab specimen comments
  1. D GSC
  1. ;
  1. ; Grab test interpretation
  1. I $O(^LAB(60,LRTST,1,LRSPM,1,0)) D
  1. . N I,L,X
  1. . S I=0
  1. . S:'$D(^TMP($J,LRDFN,"MISC",LRIDT,"TX",0)) ^TMP($J,LRDFN,"MISC",LRIDT,"TX",0)=""
  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)="Evaluation for "_TST_":"
  1. . F S I=$O(^LAB(60,LRTST,1,LRSPM,1,I)) Q:'I S X=^(I,0) S L=L+1,^TMP($J,LRDFN,"MISC",LRIDT,"TX",L,0)=X
  1. ;
  1. ; Save performing lab ien in list
  1. I $P(LRTRES,U,6) S ^TMP("LRPLS",$J,"MISC",$P(LRTRES,U,6),TST)=""
  1. ;
  1. S LRTNN=LRTNN+1
  1. Q
  1. ;
  1. ;
  1. TEXT ;
  1. N LRYESCOM,M,N
  1. S LRYESCOM=0
  1. S M=0
  1. F S M=$O(^LR(LRDFN,"CH",LRIDT,1,M)) Q:M<1!(LRYESCOM) F N=1:1:$L(^LR(LRDFN,"CH",LRIDT,1,M,0)) Q:LRYESCOM S:$E(^(0),N)'[$C(32) LRYESCOM=1
  1. Q:'LRYESCOM
  1. S L=0
  1. F S L=$O(^LR(LRDFN,"CH",LRIDT,1,L)) Q:L<1 S ^TMP($J,LRDFN,LRMH,LRSH,LRIDT,"TX",L,0)=^LR(LRDFN,"CH",LRIDT,1,L,0)
  1. S ^TMP("LRCMTINDX",$J,LRIDT)=""
  1. Q
  1. ;
  1. ;
  1. MICRO ;from LR7OSUM
  1. Q:'$D(^LR(LRDFN,"MI"))
  1. N GIOM,MICROCNT
  1. S GIOM=$G(LRGIOM)
  1. I GIOM="" D
  1. . S GIOM=$$GET^XPAR("USR^DIV^PKG","LR MI GUI REPORT RIGHT MARGIN",1,"Q")
  1. . I GIOM="" S GIOM=80
  1. S:'$D(LRUNKNOW) LRUNKNOW=$P(^LAB(69.9,1,1),U,5)
  1. S (LRONESPC,LRONETST)="",LREND=0,MICROCNT=GCNT+1
  1. I $O(^LR(LRDFN,"MI",0)) S ^TMP("LRH",$J,"MICROBIOLOGY")=MICROCNT
  1. S LRWRDVEW="",LRSB=0,LRIDT=LRIN
  1. F S LRIDT=$O(^LR(LRDFN,"MI",LRIDT)) Q:LRIDT<1!(LRIDT>LROUT)!(CT1>COUNT) D
  1. . N LRX
  1. . ;
  1. . S LRNLOC=LRLLOC
  1. . S CT1=CT1+1
  1. . ;
  1. . D EN1^LR7OSMZ0
  1. . ;
  1. . D LN^LR7OSMZ1
  1. . S LRX="=",^TMP("LRC",$J,GCNT,0)=$$REPEAT^XLFSTR(LRX,GIOM/$L(LRX))
  1. . D LN^LR7OSMZ1
  1. . S ^TMP("LRC",$J,GCNT,0)=""
  1. . ;
  1. . S LRLLOC=LRNLOC
  1. I GCNT'>MICROCNT K ^TMP("LRH",$J,"MICROBIOLOGY")
  1. K %,A,A1,AGE,B,B1,DFN,DOB,DZ,I,J,LR2ORMOR,LRAA,LRACC,LRACN,LRAD,LRADM,LRADX,LRAFS,LRAX,LRBUG,LRCMNT,LRCS,LRDCOM,LREF,LREND,LRIFN,LRLLT,LRMD,LRNLOC,LRNS,LROK,LRONESPC,LRONETST,LRORG,LRPRE,LRPRINT
  1. Q
  1. ;
  1. ;
  1. CHKUN ; Check units and normals with cumulative report values
  1. ; Add comment if these differ from file #64.5 values
  1. ;
  1. N I,L,LRFLAG,LRHI,LRLO,LRLOHI,LRX,LRY,TST,TXT
  1. S LRX=$G(^LAB(64.5,"A",1,LRMH,LRSH,LRTSTS)),LRFLAG=0
  1. S TST=$P($G(^LAB(64.5,1,1,LRMH,1,LRSH,1,LRTSTS,0)),"^",3)
  1. S LRY="*** For test "_TST
  1. ; Check units - if different generate comment
  1. I $$UP^XLFSTR($P(LRX,"^",7))'=$$UP^XLFSTR($P(LRTRES,"^",5)) S LRY=LRY_" Units: "_$S($P(LRTRES,"^",5)'="":$P(LRTRES,"^",5),1:"<none specified>"),LRFLAG=1
  1. ;
  1. ; Check normals - if different generate comment
  1. S @("LRLO="_$S($P(LRX,"^",2)'="":$P(LRX,"^",2),$P(LRX,"^",11)'="":$P(LRX,"^",11),1:""""""))
  1. ;
  1. S @("LRHI="_$S($P(LRX,"^",3)'="":$P(LRX,"^",3),$P(LRX,"^",12)'="":$P(LRX,"^",12),1:""""""))
  1. I LRLO'=$P(LRTRES,"^",3)!(LRHI'=$P(LRTRES,"^",4)) D
  1. . I '$$REALDIFF Q
  1. . I LRFLAG S LRY=LRY_" and"
  1. . S TXT=""
  1. . D
  1. . . I $P(LRTRES,"^",3)="",$P(LRTRES,"^",4)="" S TXT="<none specified>" Q
  1. . . I $P(LRTRES,"^",3)'="",$P(LRTRES,"^",4)'="" S TXT=$P(LRTRES,"^",3)_" to "_$P(LRTRES,"^",4) Q
  1. . . I $P(LRTRES,"^",3)'="",$P(LRTRES,"^",4)="" S TXT=$S($P(LRTRES,"^",3)?.AP:$P(LRTRES,"^",3),1:"low: "_$P(LRTRES,"^",3)) Q
  1. . . I $P(LRTRES,"^",3)="",$P(LRTRES,"^",4)'="" S TXT=$S($P(LRTRES,"^",4)?.AP:$P(LRTRES,"^",4),1:"high: "_$P(LRTRES,"^",4)) Q
  1. . I TXT'="" S LRY=LRY_" Normals: "_TXT,LRFLAG=1
  1. ;
  1. I 'LRFLAG Q
  1. ;
  1. S L=+$O(^TMP($J,LRDFN,LRMH,LRSH,LRIDT,"TX",9999999),-1),L=L+1
  1. S LRY=LRY_" ***",^TMP($J,LRDFN,LRMH,LRSH,LRIDT,"TX",L,0)=LRY
  1. S ^TMP("LRCMTINDX",$J,LRIDT)=""
  1. Q
  1. ;
  1. ;
  1. REALDIFF() ;
  1. ; function to determine if values are numeric and are different
  1. ; solely because of leading or trailing zeroes
  1. ; returns 0 if difference is because of leading/trailing zeroes
  1. ; returns 1 if differences are meaningful
  1. N LRTRESLO,LRTRESHI,DIFF
  1. S LRTRESLO=$P(LRTRES,"^",3),LRTRESHI=$P(LRTRES,"^",4)
  1. S DIFF=0
  1. I LRLO'=LRTRESLO S DIFF=1 D
  1. . I LRLO?.N!(LRLO?.N1".".N) D
  1. . . I LRTRESLO?.N!(LRTRESLO?.N1".".N) D
  1. . . . I +LRLO=+LRTRESLO S DIFF=0
  1. I DIFF Q 1
  1. I LRHI'=LRTRESHI S DIFF=1 D
  1. . I LRHI?.N!(LRHI?.N1".".N) D
  1. . . I LRTRESHI?.N!(LRTRESHI?.N1".".N) D
  1. . . . I +LRHI=+LRTRESHI S DIFF=0
  1. I DIFF Q 1
  1. Q 0
  1. ;
  1. ;
  1. GSC ; Grab specimen comments
  1. ;
  1. I $D(^LR(LRDFN,"CH",LRIDT,1,0)),'$D(^TMP($J,LRDFN,"MISC",LRIDT,"TX",0)) D
  1. . S ^TMP($J,LRDFN,"MISC",LRIDT,"TX",0)="",L=0
  1. . F S L=$O(^LR(LRDFN,"CH",LRIDT,1,L)) Q:L<1 S ^TMP($J,LRDFN,"MISC",LRIDT,"TX",L,0)=^LR(LRDFN,"CH",LRIDT,1,L,0)
  1. ;
  1. Q
  1. ;
  1. ;
  1. CHKNP ; Check for NP comments and no verified results.
  1. ;
  1. ;
  1. N LRCAN,TST
  1. ; Don't print unverified results.
  1. I $O(^LR(LRDFN,"CH",LRIDT,1)) Q
  1. ;
  1. S LRCAN=0
  1. F S LRCAN=+$O(^LR(LRDFN,"CH",LRIDT,1,LRCAN)) Q:LRCAN<1 Q:($E(^(LRCAN,0))="*")
  1. ;
  1. ; Print if cancel comment and no unverified results.
  1. I LRCAN<1 Q
  1. ;
  1. Q:$S('$D(SUBHEAD):0,1:'$D(SUBHEAD("MISCELLANEOUS TESTS")))
  1. ;
  1. S:'$D(^TMP($J,LRDFN,"MISC",LRIDT,0)) ^(0)=LRIDT_U_LRVIDT_U_LRVDT_U_LRAN_U_LRSPM_U_LREAL
  1. S ^TMP($J,LRDFN,"MISC",LRIDT,LRTNN)=""_U_LRSPM_U
  1. ;
  1. S TST="See comment"
  1. S ^TMP("LRT",$J,TST)="MISCELLANEOUS TESTS"
  1. ;
  1. ; Grab specimen comments
  1. D GSC
  1. ;
  1. S LRTNN=LRTNN+1
  1. Q