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)
Q
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
Q
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),!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSLROS 1084 printed Oct 16, 2024@17:58:41 Page 2
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(GMTSNDM))>0:+($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
