source: WorldVistAEHR/trunk/r/HEALTH_SUMMARY-GMTS/GMTSORC3.m@ 1005

Last change on this file since 1005 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.1 KB
Line 
1GMTSORC3 ; SLC/JER,KER - Current Orders (V3) ; 09/21/2001
2 ;;2.7;Health Summary;**15,28,47**;Oct 20, 1995
3 ;
4 ; External References
5 ; DBIA 10096 ^%ZOSF("TEST")
6 ; DBIA 10011 ^DIWP
7 ; DBIA 3154 EN^ORQ1
8 ;
9MAIN ; Current Orders (v3)
10 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
11 ;
12 ; Call
13 ; EN^ORQ1(PAT,GROUP,FLG,EXPAND,SDATE,EDATE,DETAIL,MULT,XREF,GETKID)
14 ; PAT = #;DPT( Patient VP
15 ; GROUP = 1 Display Group
16 ; FLG = 2 Active Current Orders
17 ; EXPAND = "" IEN of Parent Order
18 ; SDATE = GMTSBEG Start Date
19 ; EDATE = GMTSEND End Date
20 ; DETAIL = 1 Return Details of Order
21 ; MULT = 1 Allow Multiple Occurrences
22 ;
23 D EN^ORQ1(DFN_";DPT(",1,2,"",GMTSBEG,GMTSEND,1,1,,1) G:'$D(^TMP("ORR",$J)) EXIT D HEAD S GMTSI=0
24 F S GMTSI=$O(^TMP("ORR",$J,ORLIST,GMTSI)) Q:GMTSI'>0!$D(GMTSQIT) D PRT
25EXIT ; Clean-up and quit
26 K ^TMP("ORR",$J),^UTILITY($J,"W") Q
27PRT ; Get the data
28 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)
29 I $L($P(GMTSDATA,U,7)) S GMTSSTAT=$P(GMTSDATA,U,7)
30 E S GMTSSTAT=$E($P(GMTSDATA,U,6),1,4)
31 S GMTSSTRT=$$REGDTM(GMTSSTRT),GMTSSTOP=$$REGDTM(GMTSSTOP)
32 I $O(^TMP("ORR",$J,ORLIST,GMTSI,"TX",0))'>0 D
33 . S ^TMP("ORR",$J,ORLIST,GMTSI,"TX")=1,^TMP("ORR",$J,ORLIST,GMTSI,"TX",1)="*** Unknown ***"
34 S GMTSJ=0,DIWL=1,DIWR=36,DIWF="" K ^UTILITY($J,"W",DIWL)
35 F S GMTSJ=$O(^TMP("ORR",$J,ORLIST,GMTSI,"TX",GMTSJ)) Q:GMTSJ'>0 D
36 . S X=$G(^TMP("ORR",$J,ORLIST,GMTSI,"TX",GMTSJ)) D ^DIWP
37 S (GMTSK,GMTSLINE,GMTSTTAB)=0
38 F S GMTSK=$O(^UTILITY($J,"W",DIWL,GMTSK)) Q:GMTSK'>0!$D(GMTSQIT) D
39 . D CKP^GMTSUP Q:$D(GMTSQIT) I GMTSNPG D HEAD S GMTSLINE=0
40 . S GMTSLINE=GMTSLINE+1
41 . W ?GMTSTTAB,$G(^UTILITY($J,"W",DIWL,GMTSK,0)) S GMTSTTAB=2
42 . W:GMTSLINE=1 ?39,GMTSSTAT,?45,GMTSSTRT,?63,GMTSSTOP W !
43 Q
44HEAD ; Print the header
45 D CKP^GMTSUP Q:$D(GMTSQIT) W "Item Ordered",?38,"Status",?45,"Start Date",?63,"Stop Date",!! Q
46REGDTM(X) ; Convert an internal to an external date/time
47 D:X]"" REGDTM4^GMTSU Q X
48WRAP(TEXT,LENGTH) ; Breaks text string into substrings
49 ;
50 ; Input
51 ; TEXT = Text String
52 ; LENGTH = Maximum Length of Substrings
53 ;
54 ; Output vertical bar delimted text
55 ; substring|substring|substring|substring|substring
56 ;
57 N GMTI,GMTJ,LINE,GMX,GMX1,GMX2,GMY I $G(TEXT)']"" Q ""
58 F GMTI=1:1 D Q:GMTI=$L(TEXT," ")
59 . S GMX=$P(TEXT," ",GMTI)
60 . I $L(GMX)>LENGTH D
61 . . S GMX1=$E(GMX,1,LENGTH),GMX2=$E(GMX,LENGTH+1,$L(GMX)),$P(TEXT," ",GMTI)=GMX1_" "_GMX2
62 S LINE=1,GMX(1)=$P(TEXT," ") F GMTI=2:1 D Q:GMTI'<$L(TEXT," ")
63 . S:$L($G(GMX(LINE))_" "_$P(TEXT," ",GMTI))>LENGTH LINE=LINE+1,GMY=1
64 . S GMX(LINE)=$G(GMX(LINE))_$S(+$G(GMY):"",1:" ")_$P(TEXT," ",GMTI),GMY=0
65 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)
66 Q TEXT
Note: See TracBrowser for help on using the repository browser.