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

GMTSORC3.m

Go to the documentation of this file. 
  1. GMTSORC3 ; SLC/JER,KER - Current Orders (V3) ; 09/21/2001
  1.  ;;2.7;Health Summary;**15,28,47**;Oct 20, 1995
  1.  ;
  1.  ; External References
  1.  ;   DBIA 10096    ^%ZOSF("TEST")
  1.  ;   DBIA 10011    ^DIWP
  1.  ;   DBIA  3154    EN^ORQ1
  1.  ;                             
  1. MAIN ; Current Orders (v3)
  1.  N DIWF,DIWL,DIWR,GMTSDATA,GMTSDGRP,GMTSI,GMTSJ,GMTSK,GMTSLINE,GMTSORNM,GMTSSTAT,GMTSSTOP,GMTSSTRT,GMTSTTAB,GMTSWHEN,ORLIST,X S X="ORQ1" X ^%ZOSF("TEST") G:'$T EXIT D EXIT
  1.  ;
  1.  ; Call 
  1.  ;  EN^ORQ1(PAT,GROUP,FLG,EXPAND,SDATE,EDATE,DETAIL,MULT,XREF,GETKID)
  1.  ;     PAT    = #;DPT(     Patient VP
  1.  ;     GROUP  = 1          Display Group
  1.  ;     FLG    = 2          Active Current Orders
  1.  ;     EXPAND = ""         IEN of Parent Order
  1.  ;     SDATE  = GMTSBEG    Start Date
  1.  ;     EDATE  = GMTSEND    End Date
  1.  ;     DETAIL = 1          Return Details of Order
  1.  ;     MULT   = 1          Allow Multiple Occurrences
  1.  ;           
  1.  D EN^ORQ1(DFN_";DPT(",1,2,"",GMTSBEG,GMTSEND,1,1,,1) G:'$D(^TMP("ORR",$J)) EXIT D HEAD S GMTSI=0
  1.  F  S GMTSI=$O(^TMP("ORR",$J,ORLIST,GMTSI)) Q:GMTSI'>0!$D(GMTSQIT)  D PRT
  1. EXIT ; Clean-up and quit
  1.  K ^TMP("ORR",$J),^UTILITY($J,"W") Q
  1. PRT ; Get the data
  1.  S GMTSDATA=$G(^TMP("ORR",$J,ORLIST,GMTSI)),GMTSORNM=$P(GMTSDATA,U,1),GMTSDGRP=$P(GMTSDATA,U,2),GMTSWHEN=$P(GMTSDATA,U,3),GMTSSTRT=$P(GMTSDATA,U,4),GMTSSTOP=$P(GMTSDATA,U,5)
  1.  I $L($P(GMTSDATA,U,7)) S GMTSSTAT=$P(GMTSDATA,U,7)
  1.  E  S GMTSSTAT=$E($P(GMTSDATA,U,6),1,4)
  1.  S GMTSSTRT=$$REGDTM(GMTSSTRT),GMTSSTOP=$$REGDTM(GMTSSTOP)
  1.  I $O(^TMP("ORR",$J,ORLIST,GMTSI,"TX",0))'>0 D
  1.  . S ^TMP("ORR",$J,ORLIST,GMTSI,"TX")=1,^TMP("ORR",$J,ORLIST,GMTSI,"TX",1)="*** Unknown ***"
  1.  S GMTSJ=0,DIWL=1,DIWR=36,DIWF="" K ^UTILITY($J,"W",DIWL)
  1.  F  S GMTSJ=$O(^TMP("ORR",$J,ORLIST,GMTSI,"TX",GMTSJ)) Q:GMTSJ'>0  D
  1.  . S X=$G(^TMP("ORR",$J,ORLIST,GMTSI,"TX",GMTSJ)) D ^DIWP
  1.  S (GMTSK,GMTSLINE,GMTSTTAB)=0
  1.  F  S GMTSK=$O(^UTILITY($J,"W",DIWL,GMTSK)) Q:GMTSK'>0!$D(GMTSQIT)  D
  1.  . D CKP^GMTSUP Q:$D(GMTSQIT)  I GMTSNPG D HEAD S GMTSLINE=0
  1.  . S GMTSLINE=GMTSLINE+1
  1.  . W ?GMTSTTAB,$G(^UTILITY($J,"W",DIWL,GMTSK,0)) S GMTSTTAB=2
  1.  . W:GMTSLINE=1 ?39,GMTSSTAT,?45,GMTSSTRT,?63,GMTSSTOP W !
  1.  Q
  1.  D CKP^GMTSUP Q:$D(GMTSQIT)  W "Item Ordered",?38,"Status",?45,"Start Date",?63,"Stop Date",!! Q
  1. REGDTM(X) ; Convert an internal to an external date/time
  1.  D:X]"" REGDTM4^GMTSU Q X
  1. WRAP(TEXT,LENGTH) ; Breaks text string into substrings
  1.  ;                
  1.  ;    Input
  1.  ;       TEXT = Text String
  1.  ;       LENGTH = Maximum Length of Substrings
  1.  ;                            
  1.  ;    Output vertical bar delimted text
  1.  ;       substring|substring|substring|substring|substring
  1.  ;                            
  1.  N GMTI,GMTJ,LINE,GMX,GMX1,GMX2,GMY I $G(TEXT)']"" Q ""
  1.  F GMTI=1:1 D  Q:GMTI=$L(TEXT," ")
  1.  . S GMX=$P(TEXT," ",GMTI)
  1.  . I $L(GMX)>LENGTH D
  1.  . . S GMX1=$E(GMX,1,LENGTH),GMX2=$E(GMX,LENGTH+1,$L(GMX)),$P(TEXT," ",GMTI)=GMX1_" "_GMX2
  1.  S LINE=1,GMX(1)=$P(TEXT," ") F GMTI=2:1 D  Q:GMTI'<$L(TEXT," ")
  1.  . S:$L($G(GMX(LINE))_" "_$P(TEXT," ",GMTI))>LENGTH LINE=LINE+1,GMY=1
  1.  . S GMX(LINE)=$G(GMX(LINE))_$S(+$G(GMY):"",1:" ")_$P(TEXT," ",GMTI),GMY=0
  1.  S GMTJ=0,TEXT="" F GMTI=1:1 S GMTJ=$O(GMX(GMTJ)) Q:+GMTJ'>0  S TEXT=TEXT_$S(GMTI=1:"",1:"|")_GMX(GMTJ)
  1.  Q TEXT