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