- GMTSLRSC ; SLC/JER,KER - Sel Cum Lab Comp w/Sel Items ; 01/06/2003
- ;;2.7;Health Summary;**28,47,58**;Oct 20, 1995
- ;
- ; External References
- ; DBIA 10035 ^DPT(
- ; DBIA 67 ^LAB(60
- ; DBIA 525 ^LR(
- ;
- MAIN ; Selected Cumulative Lab w/Selection Items
- N GMTSI,LRDFN,MAX,TEST,RWIDTH,GMCMNT,COMMNBR,GMCOM,TAB
- S MAX=$S(+($G(GMTSNDM))>0:+($G(GMTSNDM)),1:999) Q:'$D(^DPT(DFN,"LR"))
- Q:'$D(^DPT(DFN,"LR")) S LRDFN=+^DPT(DFN,"LR") Q:'$D(^LR(LRDFN)) Q:'$O(GMTSEG(GMTSEGN,60,0))
- S RWIDTH=4,GMTSI=0 F S GMTSI=$O(GMTSEG(GMTSEGN,60,GMTSI)) Q:GMTSI'>0 D Q:$D(GMTSQIT)
- . S TEST=GMTSEG(GMTSEGN,60,GMTSI) D ^GMTSLRSE
- Q:'$D(^TMP("LRS",$J)) S GMCMNT=$S($P($G(^GMT(142.99,1,0)),U,3)="Y":1,1:0),COMMNBR=0
- F D DISPLAY Q:$O(^TMP("LRS",$J,0))'>0 Q:$D(GMTSQIT)
- I GMCMNT,'$D(GMTSQIT) D WRTCOMM
- K ^TMP("LRS",$J),^TMP("LRSR",$J)
- Q
- DISPLAY ; Displays up to 7 tests across page
- N GMC,GMN,GMI,GMW,GMX,HDR,TST,IT,IX,MORE,RES
- D INVRT Q:$D(GMTSQIT) S IT="" F GMI=0:1:6 S IT=$O(^TMP("LRS",$J,IT)) Q:'IT D
- . S IX="" F S IX=$O(^(IT,IX)) Q:IX'>0 D
- . . S TST=+$P(^(IX),U,3),HDR(GMI)=$S(TST'="":$E($P($G(^LAB(60,TST,.1)),U),1,7),1:"")
- . . K ^TMP("LRS",$J,IT)
- D WRTHDR S RES=$$RES,MORE=$S(+($G(RES))>+($G(MAX)):1,1:0)
- S IX="" F GMW=1:1:MAX S IX=$O(^TMP("LRSR",$J,IX)) Q:+IX'>0 D Q:$D(GMTSQIT)
- . D CKP^GMTSUP Q:$D(GMTSQIT) D:GMTSNPG WRTHDR
- . S IT="" F GMI=0:1 S IT=$O(^TMP("LRSR",$J,IX,IT)) Q:IT="" D Q:$D(GMTSQIT)
- . . D WRT I '$O(^TMP("LRSR",$J,IX,IT)) W !
- I '$D(GMTSOBJ),+($G(MORE)) D
- . D CKP^GMTSUP Q:$D(GMTSQIT)
- . W $C(7),!?10,"** Additional Results available outside occurrence limit **",!
- K ^TMP("LRSR",$J) W:$D(^TMP("LRS",$J)) !
- Q
- WRTHDR ; Writes Column Header
- N GMI
- D CKP^GMTSUP Q:$D(GMTSQIT) W "Collection DT"
- W ?19,$S(+$G(GMCMNT):" ",1:""),"Spec"
- F GMI=0:1:6 D CKP^GMTSUP Q:'$D(HDR(GMI))!($D(GMTSQIT)) W ?(((8*GMI+25)+(7-$L(HDR(GMI))\2))),$E(HDR(GMI),1,7)
- D CKP^GMTSUP Q:$D(GMTSQIT) W !
- I '$D(GMTSOBJ) D CKP^GMTSUP Q:$D(GMTSQIT) W !
- Q
- WRT ; Writes the Lab Record
- S GMX=^TMP("LRSR",$J,IX,IT),TAB=$P(GMX,U)
- I GMI=0!(GMTSNPG) D
- . I +$G(GMCMNT),$D(^TMP("LRS",$J,"C",IX))>0,$D(GMCOM("DT",IX))'>0,COMMNBR<26 D
- . . S GMLTR=$C(97+COMMNBR) S COMMNBR=COMMNBR+1
- . . S GMCOM("DT",IX)=GMLTR,GMCOM("LTR",GMLTR)=IX
- . I +$G(GMCMNT) D Q
- . . W $E($G(GMCOM("DT",IX)),1),?2,$P(GMX,U,2),?19,$E($P($P(GMX,U,3),";",2),1,5)
- . W $P(GMX,U,2),?19,$E($P($P(GMX,U,3),";",2),1,5)
- W ?(8*TAB+25),$P(GMX,U,4)," ",$P(GMX,U,5)
- Q
- WRTCOMM ; Writes the lab Comments
- N GMLTR,GMLINE
- Q:$D(GMCOM)'>0
- D CKP^GMTSUP Q:$D(GMTSQIT) W "COMMENTS:",!
- S GMLTR=""
- F S GMLTR=$O(GMCOM("LTR",GMLTR)) Q:GMLTR']"" D Q:$D(GMTSQIT)
- . S IX=$G(GMCOM("LTR",GMLTR)),GMLINE=0
- . F S GMLINE=$O(^TMP("LRS",$J,"C",+IX,GMLINE)) Q:GMLINE'>0 D Q:$D(GMTSQIT)
- . . D CKP^GMTSUP Q:$D(GMTSQIT) I GMTSNPG W "COMMENTS:",!
- . . W:GMLINE=1!GMTSNPG GMLTR_"."
- . . W ?3,$G(^TMP("LRS",$J,"C",+IX,GMLINE)),!
- Q
- ;
- RES(X) ; Results
- N NN,NC S X=0,NN="^TMP(""LRSR"","_$J_")",NC="^TMP(""LRSR"","_$J_","
- F S NN=$Q(@NN) Q:NN=""!(NN'[NC) S X=X+1
- Q X
- INVRT ; Inverts Global Array
- ;
- ; From: ^TMP("LRS",$J,IT,IX)=CDT^SPC^TNM^RSLT^FLAG^UNIT^LO^HI
- ; To: ^TMP("LRSR",$J,IX,IT)=GMI,CDT,SPC,RSLT,FLAG
- ;
- N GMI,IT,IX
- S IT=""
- F GMI=0:1:6 S IT=$O(^TMP("LRS",$J,IT)) Q:IT'>0 D
- . S IX="" F S IX=$O(^TMP("LRS",$J,IT,IX)) Q:IX="" D
- . . S ^TMP("LRSR",$J,IX,IT)=GMI_U_$P(^TMP("LRS",$J,IT,IX),U,1,2)_U_$P(^TMP("LRS",$J,IT,IX),U,4,5)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSLRSC 3561 printed Mar 13, 2025@21:02:44 Page 2
- GMTSLRSC ; SLC/JER,KER - Sel Cum Lab Comp w/Sel Items ; 01/06/2003
- +1 ;;2.7;Health Summary;**28,47,58**;Oct 20, 1995
- +2 ;
- +3 ; External References
- +4 ; DBIA 10035 ^DPT(
- +5 ; DBIA 67 ^LAB(60
- +6 ; DBIA 525 ^LR(
- +7 ;
- MAIN ; Selected Cumulative Lab w/Selection Items
- +1 NEW GMTSI,LRDFN,MAX,TEST,RWIDTH,GMCMNT,COMMNBR,GMCOM,TAB
- +2 SET MAX=$SELECT(+($GET(GMTSNDM))>0:+($GET(GMTSNDM)),1:999)
- if '$DATA(^DPT(DFN,"LR"))
- QUIT
- +3 if '$DATA(^DPT(DFN,"LR"))
- QUIT
- SET LRDFN=+^DPT(DFN,"LR")
- if '$DATA(^LR(LRDFN))
- QUIT
- if '$ORDER(GMTSEG(GMTSEGN,60,0))
- QUIT
- +4 SET RWIDTH=4
- SET GMTSI=0
- FOR
- SET GMTSI=$ORDER(GMTSEG(GMTSEGN,60,GMTSI))
- if GMTSI'>0
- QUIT
- Begin DoDot:1
- +5 SET TEST=GMTSEG(GMTSEGN,60,GMTSI)
- DO ^GMTSLRSE
- End DoDot:1
- if $DATA(GMTSQIT)
- QUIT
- +6 if '$DATA(^TMP("LRS",$JOB))
- QUIT
- SET GMCMNT=$SELECT($PIECE($GET(^GMT(142.99,1,0)),U,3)="Y":1,1:0)
- SET COMMNBR=0
- +7 FOR
- DO DISPLAY
- if $ORDER(^TMP("LRS",$JOB,0))'>0
- QUIT
- if $DATA(GMTSQIT)
- QUIT
- +8 IF GMCMNT
- IF '$DATA(GMTSQIT)
- DO WRTCOMM
- +9 KILL ^TMP("LRS",$JOB),^TMP("LRSR",$JOB)
- +10 QUIT
- DISPLAY ; Displays up to 7 tests across page
- +1 NEW GMC,GMN,GMI,GMW,GMX,HDR,TST,IT,IX,MORE,RES
- +2 DO INVRT
- if $DATA(GMTSQIT)
- QUIT
- SET IT=""
- FOR GMI=0:1:6
- SET IT=$ORDER(^TMP("LRS",$JOB,IT))
- if 'IT
- QUIT
- Begin DoDot:1
- +3 SET IX=""
- FOR
- SET IX=$ORDER(^(IT,IX))
- if IX'>0
- QUIT
- Begin DoDot:2
- +4 SET TST=+$PIECE(^(IX),U,3)
- SET HDR(GMI)=$SELECT(TST'="":$EXTRACT($PIECE($GET(^LAB(60,TST,.1)),U),1,7),1:"")
- +5 KILL ^TMP("LRS",$JOB,IT)
- End DoDot:2
- End DoDot:1
- +6 DO WRTHDR
- SET RES=$$RES
- SET MORE=$SELECT(+($GET(RES))>+($GET(MAX)):1,1:0)
- +7 SET IX=""
- FOR GMW=1:1:MAX
- SET IX=$ORDER(^TMP("LRSR",$JOB,IX))
- if +IX'>0
- QUIT
- Begin DoDot:1
- +8 DO CKP^GMTSUP
- if $DATA(GMTSQIT)
- QUIT
- if GMTSNPG
- DO WRTHDR
- +9 SET IT=""
- FOR GMI=0:1
- SET IT=$ORDER(^TMP("LRSR",$JOB,IX,IT))
- if IT=""
- QUIT
- Begin DoDot:2
- +10 DO WRT
- IF '$ORDER(^TMP("LRSR",$JOB,IX,IT))
- WRITE !
- End DoDot:2
- if $DATA(GMTSQIT)
- QUIT
- End DoDot:1
- if $DATA(GMTSQIT)
- QUIT
- +11 IF '$DATA(GMTSOBJ)
- IF +($GET(MORE))
- Begin DoDot:1
- +12 DO CKP^GMTSUP
- if $DATA(GMTSQIT)
- QUIT
- +13 WRITE $CHAR(7),!?10,"** Additional Results available outside occurrence limit **",!
- End DoDot:1
- +14 KILL ^TMP("LRSR",$JOB)
- if $DATA(^TMP("LRS",$JOB))
- WRITE !
- +15 QUIT
- WRTHDR ; Writes Column Header
- +1 NEW GMI
- +2 DO CKP^GMTSUP
- if $DATA(GMTSQIT)
- QUIT
- WRITE "Collection DT"
- +3 WRITE ?19,$SELECT(+$GET(GMCMNT):" ",1:""),"Spec"
- +4 FOR GMI=0:1:6
- DO CKP^GMTSUP
- if '$DATA(HDR(GMI))!($DATA(GMTSQIT))
- QUIT
- WRITE ?(((8*GMI+25)+(7-$LENGTH(HDR(GMI))\2))),$EXTRACT(HDR(GMI),1,7)
- +5 DO CKP^GMTSUP
- if $DATA(GMTSQIT)
- QUIT
- WRITE !
- +6 IF '$DATA(GMTSOBJ)
- DO CKP^GMTSUP
- if $DATA(GMTSQIT)
- QUIT
- WRITE !
- +7 QUIT
- WRT ; Writes the Lab Record
- +1 SET GMX=^TMP("LRSR",$JOB,IX,IT)
- SET TAB=$PIECE(GMX,U)
- +2 IF GMI=0!(GMTSNPG)
- Begin DoDot:1
- +3 IF +$GET(GMCMNT)
- IF $DATA(^TMP("LRS",$JOB,"C",IX))>0
- IF $DATA(GMCOM("DT",IX))'>0
- IF COMMNBR<26
- Begin DoDot:2
- +4 SET GMLTR=$CHAR(97+COMMNBR)
- SET COMMNBR=COMMNBR+1
- +5 SET GMCOM("DT",IX)=GMLTR
- SET GMCOM("LTR",GMLTR)=IX
- End DoDot:2
- +6 IF +$GET(GMCMNT)
- Begin DoDot:2
- +7 WRITE $EXTRACT($GET(GMCOM("DT",IX)),1),?2,$PIECE(GMX,U,2),?19,$EXTRACT($PIECE($PIECE(GMX,U,3),";",2),1,5)
- End DoDot:2
- QUIT
- +8 WRITE $PIECE(GMX,U,2),?19,$EXTRACT($PIECE($PIECE(GMX,U,3),";",2),1,5)
- End DoDot:1
- +9 WRITE ?(8*TAB+25),$PIECE(GMX,U,4)," ",$PIECE(GMX,U,5)
- +10 QUIT
- WRTCOMM ; Writes the lab Comments
- +1 NEW GMLTR,GMLINE
- +2 if $DATA(GMCOM)'>0
- QUIT
- +3 DO CKP^GMTSUP
- if $DATA(GMTSQIT)
- QUIT
- WRITE "COMMENTS:",!
- +4 SET GMLTR=""
- +5 FOR
- SET GMLTR=$ORDER(GMCOM("LTR",GMLTR))
- if GMLTR']""
- QUIT
- Begin DoDot:1
- +6 SET IX=$GET(GMCOM("LTR",GMLTR))
- SET GMLINE=0
- +7 FOR
- SET GMLINE=$ORDER(^TMP("LRS",$JOB,"C",+IX,GMLINE))
- if GMLINE'>0
- QUIT
- Begin DoDot:2
- +8 DO CKP^GMTSUP
- if $DATA(GMTSQIT)
- QUIT
- IF GMTSNPG
- WRITE "COMMENTS:",!
- +9 if GMLINE=1!GMTSNPG
- WRITE GMLTR_"."
- +10 WRITE ?3,$GET(^TMP("LRS",$JOB,"C",+IX,GMLINE)),!
- End DoDot:2
- if $DATA(GMTSQIT)
- QUIT
- End DoDot:1
- if $DATA(GMTSQIT)
- QUIT
- +11 QUIT
- +12 ;
- RES(X) ; Results
- +1 NEW NN,NC
- SET X=0
- SET NN="^TMP(""LRSR"","_$JOB_")"
- SET NC="^TMP(""LRSR"","_$JOB_","
- +2 FOR
- SET NN=$QUERY(@NN)
- if NN=""!(NN'[NC)
- QUIT
- SET X=X+1
- +3 QUIT X
- INVRT ; Inverts Global Array
- +1 ;
- +2 ; From: ^TMP("LRS",$J,IT,IX)=CDT^SPC^TNM^RSLT^FLAG^UNIT^LO^HI
- +3 ; To: ^TMP("LRSR",$J,IX,IT)=GMI,CDT,SPC,RSLT,FLAG
- +4 ;
- +5 NEW GMI,IT,IX
- +6 SET IT=""
- +7 FOR GMI=0:1:6
- SET IT=$ORDER(^TMP("LRS",$JOB,IT))
- if IT'>0
- QUIT
- Begin DoDot:1
- +8 SET IX=""
- FOR
- SET IX=$ORDER(^TMP("LRS",$JOB,IT,IX))
- if IX=""
- QUIT
- Begin DoDot:2
- +9 SET ^TMP("LRSR",$JOB,IX,IT)=GMI_U_$PIECE(^TMP("LRS",$JOB,IT,IX),U,1,2)_U_$PIECE(^TMP("LRS",$JOB,IT,IX),U,4,5)
- End DoDot:2
- End DoDot:1
- +10 QUIT