Routine: GMTSLROS

GMTSLROS ; SLC/JER,KER - Lab Order Status Summary ; 09/21/2001

 ;;2.7;Health Summary;**28,47**;Oct 20, 1995

MAIN ; Lab Order Status

 N GMW,GMX,ICD,MAX,OC,SN

 S MAX=$S(+($G(GMTSNDM))>0:+($G(GMTSNDM)),1:999)

 D ^GMTSLROE I '$D(^TMP("LRO",$J)) Q

 S (ICD,OC)=0 F  S ICD=$O(^TMP("LRO",$J,ICD)) Q:'ICD!(OC'<MAX)  S SN=0 F  S SN=$O(^TMP("LRO",$J,ICD,SN)) Q:'SN!(OC'<MAX)  D GET

 K ^TMP("LRO",$J)

GET ; Get Data from ^TMP("LRO",$J

 S GMX=^TMP("LRO",$J,ICD,SN),OC=OC+1

 I ICD>GMTS1,(ICD'>GMTS2) D CKP^GMTSUP Q:$D(GMTSQIT)  W:OC>1&'(GMTSNPG) ! D WRT

WRT ; Write Data

 N GMI,TSET,TEST S TSET="",$P(GMX,U,3)=$E($P(GMX,U,3),1,10)

 F GMI=1:1:3 S $P(TEST,"-",GMI)=$S(GMI=3:$P(GMX,U,GMI+1),1:$P($P(GMX,U,GMI+1),";",2))

 F  Q:$L(TEST)<23  S TSET=$P(TEST,"-",$L(TEST,"-"))_" "_TSET,TEST=$P(TEST,"-",1,$L(TEST,"-")-1)

 D CKP^GMTSUP Q:$D(GMTSQIT)  W $P(GMX,U),?18,$E(TEST,1,20),?39,"Prov: ",$E($P($P(GMX,U,6),";",2),1,10),?56,"Ord'd: ",$P(GMX,U,7),!

 D CKP^GMTSUP Q:$D(GMTSQIT)  G:GMTSNPG WRT W ?18,$E(TSET,1,20),?39,"# ",$E($P(GMX,U,8),1,15),?56,"Avail: ",$P(GMX,U,9),!

GMTSLROS  ; SLC/JER,KER - Lab Order Status Summary ; 09/21/2001

 +1       ;;2.7;Health Summary;**28,47**;Oct 20, 1995

 +2       ;

MAIN      ; Lab Order Status

 +1        NEW GMW,GMX,ICD,MAX,OC,SN

 +2        SET MAX=$SELECT(+($GET">GET(GMTSNDM))>0:+($GET">GET(GMTSNDM)),1:999)

 +3        DO ^GMTSLROE

           IF '$DATA(^TMP("LRO",$JOB))

               QUIT

 +4        SET (ICD,OC)=0

FOR

               SET ICD=$ORDER(^TMP("LRO",$JOB,ICD))

               IF 'ICD!(OC'<MAX)

                   QUIT

               SET SN=0

FOR

                   SET SN=$ORDER(^TMP("LRO",$JOB,ICD,SN))

                   IF 'SN!(OC'<MAX)

                       QUIT

                   DO GET

 +5        KILL ^TMP("LRO",$JOB)

 +6        QUIT

GET       ; Get Data from ^TMP("LRO",$J

 +1        SET GMX=^TMP("LRO",$JOB,ICD,SN)

           SET OC=OC+1

 +2        IF ICD>GMTS1

               IF (ICD'>GMTS2)

                   DO CKP^GMTSUP

                   IF $DATA(GMTSQIT)

                       QUIT

                   IF OC>1&'(GMTSNPG)

                       WRITE !

                   DO WRT

 +3        QUIT

WRT       ; Write Data

 +1        NEW GMI,TSET,TEST

           SET TSET=""

           SET $PIECE(GMX,U,3)=$EXTRACT($PIECE(GMX,U,3),1,10)

 +2        FOR GMI=1:1:3

               SET $PIECE(TEST,"-",GMI)=$SELECT(GMI=3:$PIECE(GMX,U,GMI+1),1:$PIECE($PIECE(GMX,U,GMI+1),";",2))

 +3        FOR

               IF $LENGTH(TEST)<23

                   QUIT

               SET TSET=$PIECE(TEST,"-",$LENGTH(TEST,"-"))_" "_TSET

               SET TEST=$PIECE(TEST,"-",1,$LENGTH(TEST,"-")-1)

 +4        DO CKP^GMTSUP

           IF $DATA(GMTSQIT)

               QUIT

           WRITE $PIECE(GMX,U),?18,$EXTRACT(TEST,1,20),?39,"Prov: ",$EXTRACT($PIECE($PIECE(GMX,U,6),";",2),1,10),?56,"Ord'd: ",$PIECE(GMX,U,7),!

 +5        DO CKP^GMTSUP

           IF $DATA(GMTSQIT)

               QUIT

           IF GMTSNPG

               GOTO WRT

           WRITE ?18,$EXTRACT(TSET,1,20),?39,"# ",$EXTRACT($PIECE(GMX,U,8),1,15),?56,"Avail: ",$PIECE(GMX,U,9),!

 +6        QUIT

GMTSLROS.m