GMTSLRSC.m

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 ---GMTSLRSC   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