GMTSLRC ; SLC/JER,KER - Chemistry & Hematology Comp Dvr ; 01/06/2003
;;2.7;Health Summary;**28,47,58,88**;Oct 20, 1995;Build 23
;
; External References
; DBIA 525 ^LR( all fields
; DBIA 10035 ^DPT( field 63 Read w/Fileman
; DBIA 2056 $$GET1^DIQ (file 2)
;
MAIN ; Chemisty and Hematology
N GMCFLAG,GMCMNT,IX0,IX,LRDFN,MAX,CNT,PTR,RWIDTH
S LRDFN=+($$GET1^DIQ(2,(+($G(DFN))_","),63,"I")) Q:+LRDFN=0 Q:'$D(^LR(LRDFN))
I $D(GMTSNDM),(GMTSNDM>0) S MAX=GMTSNDM
E S MAX=999
S RWIDTH=8 ;Optional variable used in ^GMTSLRCE
D ^GMTSLRCE
I '$D(^TMP("LRC",$J)) Q
D WRTHDR S GMCMNT=$S($P($G(^GMT(142.99,1,0)),U,3)="Y":1,1:0)
S IX=GMTS1 F IX0=1:1:MAX S IX=$O(^TMP("LRC",$J,IX)) Q:IX=""!(IX>GMTS2) S (PTR,CNT)=0 F S PTR=$O(^TMP("LRC",$J,IX,PTR)) Q:PTR="" S CNT=CNT+1 D WRT
I +$G(GMCFLAG) D
. D CKP^GMTSUP Q:$D(GMTSQIT) W !
. D CKP^GMTSUP Q:$D(GMTSQIT) W "!! Indicates COMMENTS AVAILABLE...Refer to Interim Lab Report.",!
K ^TMP("LRC",$J)
Q
WRTHDR ; Prints columnar header
D CKP^GMTSUP Q:$D(GMTSQIT) W "Collection DT",?18,"Specimen",?29
W "Test Name",?48,"Result",?58,"Units",?70,"Ref Range",!
W:'$D(GMTSOBJ) !
S GMTSNPG=1
Q
WRT ; Writes Chemistry & Hematology Component
N GMI,GMX,GMTSI,ISNEG,REF,TAB
I PTR="C",'+$G(GMCMNT) Q
I PTR="C",($D(^TMP("LRC",$J,IX,"C"))>9),+$G(GMCMNT) D Q
. S GMI=0 F S GMI=$O(^TMP("LRC",$J,IX,"C",GMI)) Q:GMI'>0 D
. . D CKP^GMTSUP Q:$D(GMTSQIT) W "Comment: ",^TMP("LRC",$J,IX,"C",GMI),!
S GMX=^TMP("LRC",$J,IX,PTR)
D CKP^GMTSUP Q:$D(GMTSQIT) D:GMTSNPG WRTHDR
W:CNT=1!(GMTSNPG) $P(GMX,U),?18,$E($P(GMX,U,2),1,10)
W:CNT>1&'(GMTSNPG) ?3,"""",?12,"""",?20,""""
I $D(^TMP("LRC",$J,IX,"C"))>9,'+$G(GMCMNT) W ?24,"!! " S GMCFLAG=1
W ?29,$E($P(GMX,U,3),1,17),?46,$P(GMX,U,4)," ",$P(GMX,U,5)
W ?58,$P(GMX,U,6)
; VM/RJT - Ref Range reformat
; W ?68,$J($P(GMX,U,7),4),?73,"-",?74,$J(GMTSI,4),!
S GMTSI=$P(GMX,U,8),ISNEG=0 S:GMTSI="NEGATIVE" GMTSI="NEG",ISNEG=1
D
. I ((ISNEG=1)!($P(GMX,U,7)="NEGATIVE")) W ?69,$J("NEG",12),! Q
. S REF=$$EN^LRLRRVF($P(GMX,U,7),$G(GMTSI))
. S TAB=67+($S(REF?1A.E:2,1:(8-$F(REF,"-")))) S:TAB<67 TAB=67
. I (TAB>72)&($L(REF)>5) S TAB=67+((13-($L(REF))/2))
. I ($L(REF)>12),($L(REF)<15) S TAB=80-($L(REF))
. W ?TAB,REF,!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSLRC 2309 printed Dec 13, 2024@01:57:43 Page 2
GMTSLRC ; SLC/JER,KER - Chemistry & Hematology Comp Dvr ; 01/06/2003
+1 ;;2.7;Health Summary;**28,47,58,88**;Oct 20, 1995;Build 23
+2 ;
+3 ; External References
+4 ; DBIA 525 ^LR( all fields
+5 ; DBIA 10035 ^DPT( field 63 Read w/Fileman
+6 ; DBIA 2056 $$GET1^DIQ (file 2)
+7 ;
MAIN ; Chemisty and Hematology
+1 NEW GMCFLAG,GMCMNT,IX0,IX,LRDFN,MAX,CNT,PTR,RWIDTH
+2 SET LRDFN=+($$GET1^DIQ(2,(+($GET(DFN))_","),63,"I"))
if +LRDFN=0
QUIT
if '$DATA(^LR(LRDFN))
QUIT
+3 IF $DATA(GMTSNDM)
IF (GMTSNDM>0)
SET MAX=GMTSNDM
+4 IF '$TEST
SET MAX=999
+5 ;Optional variable used in ^GMTSLRCE
SET RWIDTH=8
+6 DO ^GMTSLRCE
+7 IF '$DATA(^TMP("LRC",$JOB))
QUIT
+8 DO WRTHDR
SET GMCMNT=$SELECT($PIECE($GET(^GMT(142.99,1,0)),U,3)="Y":1,1:0)
+9 SET IX=GMTS1
FOR IX0=1:1:MAX
SET IX=$ORDER(^TMP("LRC",$JOB,IX))
if IX=""!(IX>GMTS2)
QUIT
SET (PTR,CNT)=0
FOR
SET PTR=$ORDER(^TMP("LRC",$JOB,IX,PTR))
if PTR=""
QUIT
SET CNT=CNT+1
DO WRT
+10 IF +$GET(GMCFLAG)
Begin DoDot:1
+11 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE !
+12 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE "!! Indicates COMMENTS AVAILABLE...Refer to Interim Lab Report.",!
End DoDot:1
+13 KILL ^TMP("LRC",$JOB)
+14 QUIT
WRTHDR ; Prints columnar header
+1 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE "Collection DT",?18,"Specimen",?29
+2 WRITE "Test Name",?48,"Result",?58,"Units",?70,"Ref Range",!
+3 if '$DATA(GMTSOBJ)
WRITE !
+4 SET GMTSNPG=1
+5 QUIT
WRT ; Writes Chemistry & Hematology Component
+1 NEW GMI,GMX,GMTSI,ISNEG,REF,TAB
+2 IF PTR="C"
IF '+$GET(GMCMNT)
QUIT
+3 IF PTR="C"
IF ($DATA(^TMP("LRC",$JOB,IX,"C"))>9)
IF +$GET(GMCMNT)
Begin DoDot:1
+4 SET GMI=0
FOR
SET GMI=$ORDER(^TMP("LRC",$JOB,IX,"C",GMI))
if GMI'>0
QUIT
Begin DoDot:2
+5 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE "Comment: ",^TMP("LRC",$JOB,IX,"C",GMI),!
End DoDot:2
End DoDot:1
QUIT
+6 SET GMX=^TMP("LRC",$JOB,IX,PTR)
+7 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
if GMTSNPG
DO WRTHDR
+8 if CNT=1!(GMTSNPG)
WRITE $PIECE(GMX,U),?18,$EXTRACT($PIECE(GMX,U,2),1,10)
+9 if CNT>1&'(GMTSNPG)
WRITE ?3,"""",?12,"""",?20,""""
+10 IF $DATA(^TMP("LRC",$JOB,IX,"C"))>9
IF '+$GET(GMCMNT)
WRITE ?24,"!! "
SET GMCFLAG=1
+11 WRITE ?29,$EXTRACT($PIECE(GMX,U,3),1,17),?46,$PIECE(GMX,U,4)," ",$PIECE(GMX,U,5)
+12 WRITE ?58,$PIECE(GMX,U,6)
+13 ; VM/RJT - Ref Range reformat
+14 ; W ?68,$J($P(GMX,U,7),4),?73,"-",?74,$J(GMTSI,4),!
+15 SET GMTSI=$PIECE(GMX,U,8)
SET ISNEG=0
if GMTSI="NEGATIVE"
SET GMTSI="NEG"
SET ISNEG=1
+16 Begin DoDot:1
+17 IF ((ISNEG=1)!($PIECE(GMX,U,7)="NEGATIVE"))
WRITE ?69,$JUSTIFY("NEG",12),!
QUIT
+18 SET REF=$$EN^LRLRRVF($PIECE(GMX,U,7),$GET(GMTSI))
+19 SET TAB=67+($SELECT(REF?1A.E:2,1:(8-$FIND(REF,"-"))))
if TAB<67
SET TAB=67
+20 IF (TAB>72)&($LENGTH(REF)>5)
SET TAB=67+((13-($LENGTH(REF))/2))
+21 IF ($LENGTH(REF)>12)
IF ($LENGTH(REF)<15)
SET TAB=80-($LENGTH(REF))
+22 WRITE ?TAB,REF,!
End DoDot:1
+23 QUIT
+24
