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

LR7OGMG.m

Go to the documentation of this file. 
  1. LR7OGMG ;VA/DALOI/STAFF- Interim report rpc memo grid ; 03-Jul-2014 07:41 ; MKK
  1.  ;;5.2;LAB SERVICE;**187,230,1018,286,1027,331,364,395,1031,1033,1039**;NOV 1, 1997;Build 146
  1.  ;
  1. GRID(OUTCNT) ; from LR7OGMC
  1.  N ACC,AGE,CDT,CMNT,CNT,DATA,DOC,FLAG,IDT,INTP,LINE,LRCW,LRX,MPLS,PLS,PORDER,PRNTCODE,RANGE,SEX,SPEC,SUB,TCNT,TESTNAME,TESTNUM
  1.  N UNITS,VALUE,X,ZERO,INEXACT,DISPDATE
  1.  ; the variables AGE, SEX, LRCW, and X are used withing the lab's print codes and ref ranges
  1.  K ^TMP("LRMPLS",$J)
  1.  S AGE=$P(^TMP("LR7OG",$J,"G"),U,4),SEX=$P(^("G"),U,5),LRCW=$P(^("G"),U,6)
  1.  S CDT=+$O(^TMP("LR7OG",$J,"TP",0)) Q:'CDT
  1.  S IDT=9999999-CDT
  1.  S ZERO=$S($D(^TMP("LR7OG",$J,"TP",CDT))#2:^(CDT),1:"")
  1.  S SPEC=+$P(ZERO,U,5)
  1.  S INEXACT=$P(ZERO,U,2),DISPDATE=$S(INEXACT:CDT\1,1:CDT)
  1.  S DOC=$$NAME^LR7OGMP(+$P(ZERO,U,10))
  1.  S ACC=$P(ZERO,U,6)
  1.  S $P(^TMP("LR7OGX",$J,"OUTPUT",1),U,4,6)=SPEC_U_$P($G(^LAB(61,SPEC,0)),U)_U_ACC_U_DOC
  1.  S $P(^TMP("LR7OGX",$J,"OUTPUT",1),U,10)=DISPDATE
  1.  S (TCNT,MPLS,PORDER,PLS)=0
  1.  S PLS=$O(^TMP("LRPLS",$J,0))
  1.  I $O(^TMP("LRPLS",$J,PLS)) S MPLS=1 ; multiple performing labs
  1.  F  S PORDER=$O(^TMP("LR7OG",$J,"TP",CDT,PORDER)) Q:PORDER'>0  S DATA=^(PORDER) D
  1.  . I $P(DATA,U,7)="" Q
  1.  . S TCNT=TCNT+1
  1.  . S TESTNUM=+DATA,TESTNAME=$P(DATA,U,2),PRNTCODE=$P(DATA,U,5),SUB=$P(DATA,U,6),FLAG=$P(DATA,U,8),X=$P(DATA,U,7),UNITS=$P(DATA,U,9),RANGE=$P(DATA,U,10),PLS=$P(DATA,U,11)
  1.  . ;
  1.  . ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1031
  1.  . ; NEW LOW,HIGH
  1.  . ; S LOW=$$TRIM^XLFSTR($P($G(RANGE),"-"),"LR"," ")
  1.  . ; S HIGH=$$TRIM^XLFSTR($P($G(RANGE),"-",2),"LR"," ")
  1.  . ; D:$L(LOW) ZEROFIX(TESTNUM,.LOW)
  1.  . ; D:$L(HIGH) ZEROFIX(TESTNUM,.HIGH)
  1.  . ; I $L(LOW)!($L(HIGH)) S RANGE=$$EN^LRLRRVF(LOW,HIGH)
  1.  . ; S ^BLR7OGMG("LR7OGMG",$J,"DID IT")=LOW_"^"_HIGH_"^"_RANGE
  1.  . ; K LOW,HIGH
  1.  . ; ----- END IHS/MSC/MKK - LR*5.2*1031
  1.  . ;
  1.  . ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1033
  1.  . I $$UP^XLFSTR(RANGE)'["REF:" D
  1.  .. NEW LOW,HIGH
  1.  .. S LOW=$$TRIM^XLFSTR($P($G(RANGE),"-"),"LR"," ")
  1.  .. S HIGH=$$TRIM^XLFSTR($P($G(RANGE),"-",2),"LR"," ")
  1.  .. D:$L(LOW) ZEROFIX(TESTNUM,.LOW)
  1.  .. D:$L(HIGH) ZEROFIX(TESTNUM,.HIGH)
  1.  .. I $L(LOW)!($L(HIGH)) S RANGE=$$EN^LRLRRVF(LOW,HIGH)
  1.  . I RANGE[" to "&(RANGE["Ref: ") S RANGE=$P(RANGE,"Ref: ",2)
  1.  . ; I RANGE["Ref:" S RANGE=$TR($P(RANGE,"Ref: ",2),"=")    ; MU2 Only
  1.  . ; ----- END IHS/MSC/MKK - LR*5.2*1033
  1.  . ;
  1.  . I MPLS,PLS S ^TMP("LRMPLS",$J,PLS,TESTNAME)=""
  1.  . I PRNTCODE="" S VALUE=$J(X,8)
  1.  . E  S @("VALUE="_PRNTCODE)
  1.  . ;
  1.  . S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=TESTNUM_U_TESTNAME_U_VALUE_U_FLAG_U_UNITS_U_RANGE
  1.  . ;
  1.  . ; ---- BEGIN IHS/MSC/JS - LR*5.2*1033 - Lookup LOINC CODE, add $P15 to ^TMP data  -- 7/11/13
  1.  . I +$G(TESTNUM) I +$G(SPEC) D
  1.  . . N IEN,IENS,LOINC
  1.  . . S IEN=TESTNUM,IENS=SPEC_","_IEN_","
  1.  . . S LOINC=$$GET1^DIQ(60.01,IENS,95.3)
  1.  . . I $G(LOINC) S $P(^TMP("LR7OGX",$J,"OUTPUT",OUTCNT),"^",15)=LOINC
  1.  . ; ---- END IHS/MSC/JS - LR*5.2*1033 - Lookup LOINC CODE, add $P15 to ^TMP data  -- 7/11/13
  1.  . ;
  1.  . S OUTCNT=OUTCNT+1
  1.  S $P(^TMP("LR7OGX",$J,"OUTPUT",1),U)=TCNT ;TCNT must be correct to display all values
  1.  ;
  1.  D SPECCOND   ; IHS/MSC/MKK - LR*5.2*1033
  1.  ;
  1.  S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=" ",OUTCNT=OUTCNT+1
  1.  D LABARRT    ; IHS/MSC/MKK - LR*5.2*1039
  1.  ; S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)="Report Released Date/Time: "_$$FMTE^XLFDT($P(ZERO,"^",3),"M"),OUTCNT=OUTCNT+1
  1.  S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)="Report Released Date/Time: "_$$UP^XLFSTR($$FMTE^XLFDT($P(ZERO,"^",3),"5MPZ")),OUTCNT=OUTCNT+1   ; IHS/MSC/MKK - LR*5.2*1039
  1.  ;
  1.  S (CNT,PORDER)=0
  1.  F  S PORDER=$O(^TMP("LR7OG",$J,"TP",CDT,PORDER)) Q:PORDER'>0  S DATA=^(PORDER) D
  1.  . I $O(^TMP("LR7OG",$J,"TP",CDT,PORDER,0))>0 D
  1.  . . S TESTNAME=$P(DATA,U,3)
  1.  . . S INTP=0
  1.  . . F  S INTP=+$O(^TMP("LR7OG",$J,"TP",CDT,PORDER,INTP)) Q:INTP<1  D
  1.  . . . S LINE=TESTNAME_" Eval: "_^TMP("LR7OG",$J,"TP",CDT,PORDER,INTP)
  1.  . . . S CNT=CNT+1  S:CNT=1 ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=" ",OUTCNT=OUTCNT+1
  1.  . . . S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=LINE
  1.  . . . S OUTCNT=OUTCNT+1
  1.  ;
  1.  I $D(^TMP("LR7OG",$J,"TP",CDT,"C")) D
  1.  . S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=" ",OUTCNT=OUTCNT+1
  1.  . S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)="Comment: "
  1.  . S OUTCNT=OUTCNT+1,CMNT=0
  1.  . F  S CMNT=+$O(^TMP("LR7OG",$J,"TP",CDT,"C",CMNT)) Q:CMNT<1  S LINE=^(CMNT) D
  1.  . . S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)="   "_LINE
  1.  . . S OUTCNT=OUTCNT+1
  1.  ;
  1.  D PLS
  1.  ;S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)="Report Released Date/Time: "_$$FMTE^XLFDT($P(ZERO,"^",3),"M"),OUTCNT=OUTCNT+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 CNT,LINE,LRPLS,X
  1.  N STR,COUNTY,COUNTRY,ICOUNTRY   ; IHS/MSC/MKK - LR*5.2*1033
  1.  ;
  1.  S (CNT,LRPLS)=0
  1.  F  S LRPLS=$O(^TMP("LRPLS",$J,LRPLS)) Q:LRPLS<1  D
  1.  . S:CNT=0 ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=" ",OUTCNT=OUTCNT+1
  1.  . I $D(^TMP("LRMPLS",$J,LRPLS)) D
  1.  . . S TESTNAME="",LINE="For test(s): "
  1.  . . F  S TESTNAME=$O(^TMP("LRMPLS",$J,LRPLS,TESTNAME)) Q:TESTNAME=""  D
  1.  . . . I ($L(LINE)+$L(TESTNAME))>240 D
  1.  . . . . S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=LINE
  1.  . . . . S OUTCNT=OUTCNT+1,LINE=""
  1.  . . . S LINE=LINE_TESTNAME_", "
  1.  . . S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=LINE,OUTCNT=OUTCNT+1
  1.  . S LINE=$$NAME^XUAF4(LRPLS)
  1.  . S X=$$PADD^XUAF4(LRPLS)
  1.  . S LINE=LINE_"  "_$P(X,U)_"  "_$P(X,U,2)_", "_$P(X,U,3)_" "_$P(X,U,4)
  1.  . S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)="Performing Lab: "_LINE
  1.  . S OUTCNT=OUTCNT+1,CNT=CNT+1
  1.  . ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1033
  1.  . S STR=$G(^TMP("LRPLS",$J,LRPLS))
  1.  . Q:$L(STR)<1
  1.  . S COUNTY=$P(STR,"^"),COUNTRY=+$P(STR,"^",2)
  1.  . S LINE=$J("",8)_$$LJ^XLFSTR("County:"_COUNTY,15)
  1.  . S:COUNTRY LINE=LINE_"Country:"_$$GET1^DIQ(779.004,COUNTRY,"CODE")
  1.  . S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=LINE
  1.  . S OUTCNT=OUTCNT+1,CNT=CNT+1
  1.  . ; ----- END IHS/MSC/MKK - LR*5.2*1033
  1.  ;
  1.  K ^TMP("LRPLS",$J),^TMP("LRMPLS",$J)
  1.  Q
  1.  ;
  1.  ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1031
  1. ZEROFIX(F60PTR,RESULT) ; EP - Leading & Trailing Zero Fix for Results
  1.  NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,F60PTR,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,RESULT,U,XPARSYS,XQXFLG)
  1.  ;
  1.  Q:$$UP^XLFSTR($G(RESULT))["SPECIMEN IN LAB"          ; Skip if not resulted
  1.  ;
  1.  Q:$L($G(RESULT))<1                      ; Skip if no Result
  1.  Q:$L($G(F60PTR))<1                      ; Skip if no File 60 Pointer
  1.  ;
  1.  S DN=+$G(^LAB(60,F60PTR,.2))
  1.  Q:DN<1                                  ; Skip if no DataName
  1.  ;
  1.  Q:$G(^DD(63.04,DN,0))'["^LRNUM"         ; Skip if no numeric defintiion
  1.  ;
  1.  S STR=$P($P($G(^DD(63.04,DN,0)),"Q9=",2),$C(34),2)     ; Get numeric formatting
  1.  ;
  1.  S DP=+$P(STR,",",3)                     ; Decimal Places
  1.  Q:DP<1                                  ; Skip if no Decimal Defintion
  1.  ;
  1.  S SYMBOL="",ORIGRSLT=RESULT
  1.  F  Q:$E(RESULT)="."!($E(RESULT)?1N)!(RESULT="")  D       ; Adjust if ANY Non-Numeric is at the beginning of RESULT
  1.  . S SYMBOL=SYMBOL_$E(RESULT)
  1.  . S RESULT=$E(RESULT,2,$L(RESULT))
  1.  ;
  1.  S:$E(RESULT)="." RESULT="0"_RESULT      ; Leading Zero Fix
  1.  ;
  1.  I $E(RESULT)'?1N  S RESULT=ORIGRSLT  Q  ; If RESULT has no numeric part: restore to original RESULT & skip
  1.  ;
  1.  S RESULT=$TR($FN(RESULT,"P",DP)," ")
  1.  ;
  1.  S:$L($G(SYMBOL)) RESULT=SYMBOL_RESULT   ; Restore "symbol", if necessary
  1.  ;
  1.  Q
  1.  ; ----- END IHS/MSC/MKK - LR*5.2*1031
  1.  ;
  1.  ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1033
  1. SPECCOND ; EP
  1.  NEW SPECCOND
  1.  ;
  1.  S SPECCOND=$P($G(^LR(+LRDFN,"CH",+IDT,"IHS")),"^")
  1.  Q:$L(SPECCOND)<1
  1.  ;
  1.  S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)=" ",OUTCNT=OUTCNT+1
  1.  S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)="Specimen Condition:"_SPECCOND,OUTCNT=OUTCNT+1
  1.  Q
  1.  ; ----- END IHS/MSC/MKK - LR*5.2*1033
  1.  ;
  1.  ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1039
  1. LABARRT ; EP - Lab Arrival Time
  1.  NEW LABARRT,LRAA,LRAD,LRAN,LRIDT,LRSS,UID,X
  1.  ;
  1.  Q:+$G(LRDFN)<1
  1.  ;
  1.  S LRIDT=+$G(CNIDT)
  1.  Q:LRIDT<1
  1.  ;
  1.  S LRSS=$G(LABSUB)
  1.  Q:LRSS=""
  1.  ;
  1.  S UID=+$G(^LR(LRDFN,LRSS,LRIDT,"ORU"))
  1.  Q:UID<1
  1.  ;
  1.  S X=$Q(^LRO(68,"C",UID,0))
  1.  Q:$QS(X,3)'=UID
  1.  ;
  1.  S LRAA=+$QS(X,4),LRAD=+$QS(X,5),LRAN=+$QS(X,6)
  1.  Q:LRAA<1!(LRAD<1)!(LRAN<1)
  1.  ;
  1.  S LABARRT=$$GET1^DIQ(68.02,LRAN_","_LRAD_","_LRAA,12,"I")
  1.  Q:+LABARRT<1
  1.  ;
  1.  S ^TMP("LR7OGX",$J,"OUTPUT",OUTCNT)="    Lab Arrival Date/Time: "_$$UP^XLFSTR($$FMTE^XLFDT(LABARRT,"5MPZ"))
  1.  S OUTCNT=OUTCNT+1
  1.  Q
  1.  ; ----- END IHS/MSC/MKK - LR*5.2*1039