- GMTSLRC ; SLC/JER,KER - Chemistry & Hematology Comp Dvr ; 01/06/2003
- ;;2.7;Health Summary;**28,47,58**;Oct 20, 1995
- ;
- ; 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",?68,"Ref Range",!
- W:'$D(GMTSOBJ) !
- S GMTSNPG=1
- Q
- WRT ; Writes Chemistry & Hematology Component
- N GMI,GMX,GMTSI
- 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)
- S GMTSI=$P(GMX,U,8) S:GMTSI="NEGATIVE" GMTSI="NEG"
- W ?68,$J($P(GMX,U,7),4),?73,"-",?74,$J(GMTSI,4),!
- Q
- GMTSLRC ; SLC/JER,KER - Chemistry & Hematology Comp Dvr ; 01/06/2003
- +1 ;;2.7;Health Summary;**28,47,58**;Oct 20, 1995
- +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",?68,"Ref Range",!
- +3 IF '$DATA(GMTSOBJ)
- WRITE !
- +4 SET GMTSNPG=1
- +5 QUIT
- WRT ; Writes Chemistry & Hematology Component
- +1 NEW GMI,GMX,GMTSI
- +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 SET GMTSI=$PIECE(GMX,U,8)
- IF GMTSI="NEGATIVE"
- SET GMTSI="NEG"
- +14 WRITE ?68,$JUSTIFY($PIECE(GMX,U,7),4),?73,"-",?74,$JUSTIFY(GMTSI,4),!
- +15 QUIT
