GMTSLROB ; SLC/JER - Brief Lab Order ; 01/06/2003
;;2.7;Health Summary;**28,58**;Oct 20, 1995
MAIN ; Driver
N GMW,GMX,ICD,MAX,OC,SN
I $D(GMTSNDM),(GMTSNDM>0) S MAX=GMTSNDM
E S MAX=999
D ^GMTSLROE
I '$D(^TMP("LRO",$J)) Q
D WRTHDR
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
S GMX=^TMP("LRO",$J,ICD,SN),OC=OC+1 I ICD>GMTS1,(ICD'>GMTS2) D WRT
Q
WRTHDR ; Prints Header
D CKP^GMTSUP Q:$D(GMTSQIT) W "Collection DT",?18,"Test Name",?39,"Specimen",?51,"Urgency",?68,"Status",!
W:'$D(GMTSOBJ) !
Q
WRT ; Writes Component
D CKP^GMTSUP Q:$D(GMTSQIT) D:GMTSNPG WRTHDR W $P(GMX,U),?18,$P($P(GMX,U,2),";",2),?39,$E($P($P(GMX,U,3),";",2),1,10),?51,$P(GMX,U,4),?68,$P(GMX,U,5),!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSLROB 824 printed Nov 22, 2024@17:08 Page 2
GMTSLROB ; SLC/JER - Brief Lab Order ; 01/06/2003
+1 ;;2.7;Health Summary;**28,58**;Oct 20, 1995
MAIN ; Driver
+1 NEW GMW,GMX,ICD,MAX,OC,SN
+2 IF $DATA(GMTSNDM)
IF (GMTSNDM>0)
SET MAX=GMTSNDM
+3 IF '$TEST
SET MAX=999
+4 DO ^GMTSLROE
+5 IF '$DATA(^TMP("LRO",$JOB))
QUIT
+6 DO WRTHDR
+7 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
+8 KILL ^TMP("LRO",$JOB)
+9 QUIT
GET ; Get Data
+1 SET GMX=^TMP("LRO",$JOB,ICD,SN)
SET OC=OC+1
IF ICD>GMTS1
IF (ICD'>GMTS2)
DO WRT
+2 QUIT
WRTHDR ; Prints Header
+1 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE "Collection DT",?18,"Test Name",?39,"Specimen",?51,"Urgency",?68,"Status",!
+2 if '$DATA(GMTSOBJ)
WRITE !
+3 QUIT
WRT ; Writes Component
+1 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
if GMTSNPG
DO WRTHDR
WRITE $PIECE(GMX,U),?18,$PIECE($PIECE(GMX,U,2),";",2),?39,$EXTRACT($PIECE($PIECE(GMX,U,3),";",2),1,10),?51,$PIECE(GMX,U,4),?68,$PIECE(GMX,U,5),!
+2 QUIT
