Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: GMTSLROB

GMTSLROB.m

Go to the documentation of this file.
  1. GMTSLROB ; SLC/JER - Brief Lab Order ; 01/06/2003
  1. ;;2.7;Health Summary;**28,58**;Oct 20, 1995
  1. MAIN ; Driver
  1. N GMW,GMX,ICD,MAX,OC,SN
  1. I $D(GMTSNDM),(GMTSNDM>0) S MAX=GMTSNDM
  1. E S MAX=999
  1. D ^GMTSLROE
  1. I '$D(^TMP("LRO",$J)) Q
  1. D WRTHDR
  1. 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
  1. K ^TMP("LRO",$J)
  1. Q
  1. GET ; Get Data
  1. S GMX=^TMP("LRO",$J,ICD,SN),OC=OC+1 I ICD>GMTS1,(ICD'>GMTS2) D WRT
  1. Q
  1. WRTHDR ; Prints Header
  1. D CKP^GMTSUP Q:$D(GMTSQIT) W "Collection DT",?18,"Test Name",?39,"Specimen",?51,"Urgency",?68,"Status",!
  1. W:'$D(GMTSOBJ) !
  1. Q
  1. WRT ; Writes Component
  1. 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),!
  1. Q