GMTSORC3 ; SLC/JER,KER - Current Orders (V3) ; 09/21/2001
;;2.7;Health Summary;**15,28,47**;Oct 20, 1995
;
; External References
; DBIA 10096 ^%ZOSF("TEST")
; DBIA 10011 ^DIWP
; DBIA 3154 EN^ORQ1
;
MAIN ; Current Orders (v3)
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
;
; Call
; EN^ORQ1(PAT,GROUP,FLG,EXPAND,SDATE,EDATE,DETAIL,MULT,XREF,GETKID)
; PAT = #;DPT( Patient VP
; GROUP = 1 Display Group
; FLG = 2 Active Current Orders
; EXPAND = "" IEN of Parent Order
; SDATE = GMTSBEG Start Date
; EDATE = GMTSEND End Date
; DETAIL = 1 Return Details of Order
; MULT = 1 Allow Multiple Occurrences
;
D EN^ORQ1(DFN_";DPT(",1,2,"",GMTSBEG,GMTSEND,1,1,,1) G:'$D(^TMP("ORR",$J)) EXIT D HEAD S GMTSI=0
F S GMTSI=$O(^TMP("ORR",$J,ORLIST,GMTSI)) Q:GMTSI'>0!$D(GMTSQIT) D PRT
EXIT ; Clean-up and quit
K ^TMP("ORR",$J),^UTILITY($J,"W") Q
PRT ; Get the data
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)
I $L($P(GMTSDATA,U,7)) S GMTSSTAT=$P(GMTSDATA,U,7)
E S GMTSSTAT=$E($P(GMTSDATA,U,6),1,4)
S GMTSSTRT=$$REGDTM(GMTSSTRT),GMTSSTOP=$$REGDTM(GMTSSTOP)
I $O(^TMP("ORR",$J,ORLIST,GMTSI,"TX",0))'>0 D
. S ^TMP("ORR",$J,ORLIST,GMTSI,"TX")=1,^TMP("ORR",$J,ORLIST,GMTSI,"TX",1)="*** Unknown ***"
S GMTSJ=0,DIWL=1,DIWR=36,DIWF="" K ^UTILITY($J,"W",DIWL)
F S GMTSJ=$O(^TMP("ORR",$J,ORLIST,GMTSI,"TX",GMTSJ)) Q:GMTSJ'>0 D
. S X=$G(^TMP("ORR",$J,ORLIST,GMTSI,"TX",GMTSJ)) D ^DIWP
S (GMTSK,GMTSLINE,GMTSTTAB)=0
F S GMTSK=$O(^UTILITY($J,"W",DIWL,GMTSK)) Q:GMTSK'>0!$D(GMTSQIT) D
. D CKP^GMTSUP Q:$D(GMTSQIT) I GMTSNPG D HEAD S GMTSLINE=0
. S GMTSLINE=GMTSLINE+1
. W ?GMTSTTAB,$G(^UTILITY($J,"W",DIWL,GMTSK,0)) S GMTSTTAB=2
. W:GMTSLINE=1 ?39,GMTSSTAT,?45,GMTSSTRT,?63,GMTSSTOP W !
Q
HEAD ; Print the header
D CKP^GMTSUP Q:$D(GMTSQIT) W "Item Ordered",?38,"Status",?45,"Start Date",?63,"Stop Date",!! Q
REGDTM(X) ; Convert an internal to an external date/time
D:X]"" REGDTM4^GMTSU Q X
WRAP(TEXT,LENGTH) ; Breaks text string into substrings
;
; Input
; TEXT = Text String
; LENGTH = Maximum Length of Substrings
;
; Output vertical bar delimted text
; substring|substring|substring|substring|substring
;
N GMTI,GMTJ,LINE,GMX,GMX1,GMX2,GMY I $G(TEXT)']"" Q ""
F GMTI=1:1 D Q:GMTI=$L(TEXT," ")
. S GMX=$P(TEXT," ",GMTI)
. I $L(GMX)>LENGTH D
. . S GMX1=$E(GMX,1,LENGTH),GMX2=$E(GMX,LENGTH+1,$L(GMX)),$P(TEXT," ",GMTI)=GMX1_" "_GMX2
S LINE=1,GMX(1)=$P(TEXT," ") F GMTI=2:1 D Q:GMTI'<$L(TEXT," ")
. S:$L($G(GMX(LINE))_" "_$P(TEXT," ",GMTI))>LENGTH LINE=LINE+1,GMY=1
. S GMX(LINE)=$G(GMX(LINE))_$S(+$G(GMY):"",1:" ")_$P(TEXT," ",GMTI),GMY=0
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)
Q TEXT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSORC3 3258 printed Nov 22, 2024@17:08:41 Page 2
GMTSORC3 ; SLC/JER,KER - Current Orders (V3) ; 09/21/2001
+1 ;;2.7;Health Summary;**15,28,47**;Oct 20, 1995
+2 ;
+3 ; External References
+4 ; DBIA 10096 ^%ZOSF("TEST")
+5 ; DBIA 10011 ^DIWP
+6 ; DBIA 3154 EN^ORQ1
+7 ;
MAIN ; Current Orders (v3)
+1 NEW DIWF,DIWL,DIWR,GMTSDATA,GMTSDGRP,GMTSI,GMTSJ,GMTSK,GMTSLINE,GMTSORNM,GMTSSTAT,GMTSSTOP,GMTSSTRT,GMTSTTAB,GMTSWHEN,ORLIST,X
SET X="ORQ1"
XECUTE ^%ZOSF("TEST")
if '$TEST
GOTO EXIT
DO EXIT
+2 ;
+3 ; Call
+4 ; EN^ORQ1(PAT,GROUP,FLG,EXPAND,SDATE,EDATE,DETAIL,MULT,XREF,GETKID)
+5 ; PAT = #;DPT( Patient VP
+6 ; GROUP = 1 Display Group
+7 ; FLG = 2 Active Current Orders
+8 ; EXPAND = "" IEN of Parent Order
+9 ; SDATE = GMTSBEG Start Date
+10 ; EDATE = GMTSEND End Date
+11 ; DETAIL = 1 Return Details of Order
+12 ; MULT = 1 Allow Multiple Occurrences
+13 ;
+14 DO EN^ORQ1(DFN_";DPT(",1,2,"",GMTSBEG,GMTSEND,1,1,,1)
if '$DATA(^TMP("ORR",$JOB))
GOTO EXIT
DO HEAD
SET GMTSI=0
+15 FOR
SET GMTSI=$ORDER(^TMP("ORR",$JOB,ORLIST,GMTSI))
if GMTSI'>0!$DATA(GMTSQIT)
QUIT
DO PRT
EXIT ; Clean-up and quit
+1 KILL ^TMP("ORR",$JOB),^UTILITY($JOB,"W")
QUIT
PRT ; Get the data
+1 SET GMTSDATA=$GET(^TMP("ORR",$JOB,ORLIST,GMTSI))
SET GMTSORNM=$PIECE(GMTSDATA,U,1)
SET GMTSDGRP=$PIECE(GMTSDATA,U,2)
SET GMTSWHEN=$PIECE(GMTSDATA,U,3)
SET GMTSSTRT=$PIECE(GMTSDATA,U,4)
SET GMTSSTOP=$PIECE(GMTSDATA,U,5)
+2 IF $LENGTH($PIECE(GMTSDATA,U,7))
SET GMTSSTAT=$PIECE(GMTSDATA,U,7)
+3 IF '$TEST
SET GMTSSTAT=$EXTRACT($PIECE(GMTSDATA,U,6),1,4)
+4 SET GMTSSTRT=$$REGDTM(GMTSSTRT)
SET GMTSSTOP=$$REGDTM(GMTSSTOP)
+5 IF $ORDER(^TMP("ORR",$JOB,ORLIST,GMTSI,"TX",0))'>0
Begin DoDot:1
+6 SET ^TMP("ORR",$JOB,ORLIST,GMTSI,"TX")=1
SET ^TMP("ORR",$JOB,ORLIST,GMTSI,"TX",1)="*** Unknown ***"
End DoDot:1
+7 SET GMTSJ=0
SET DIWL=1
SET DIWR=36
SET DIWF=""
KILL ^UTILITY($JOB,"W",DIWL)
+8 FOR
SET GMTSJ=$ORDER(^TMP("ORR",$JOB,ORLIST,GMTSI,"TX",GMTSJ))
if GMTSJ'>0
QUIT
Begin DoDot:1
+9 SET X=$GET(^TMP("ORR",$JOB,ORLIST,GMTSI,"TX",GMTSJ))
DO ^DIWP
End DoDot:1
+10 SET (GMTSK,GMTSLINE,GMTSTTAB)=0
+11 FOR
SET GMTSK=$ORDER(^UTILITY($JOB,"W",DIWL,GMTSK))
if GMTSK'>0!$DATA(GMTSQIT)
QUIT
Begin DoDot:1
+12 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
IF GMTSNPG
DO HEAD
SET GMTSLINE=0
+13 SET GMTSLINE=GMTSLINE+1
+14 WRITE ?GMTSTTAB,$GET(^UTILITY($JOB,"W",DIWL,GMTSK,0))
SET GMTSTTAB=2
+15 if GMTSLINE=1
WRITE ?39,GMTSSTAT,?45,GMTSSTRT,?63,GMTSSTOP
WRITE !
End DoDot:1
+16 QUIT
HEAD ; Print the header
+1 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE "Item Ordered",?38,"Status",?45,"Start Date",?63,"Stop Date",!!
QUIT
REGDTM(X) ; Convert an internal to an external date/time
+1 if X]""
DO REGDTM4^GMTSU
QUIT X
WRAP(TEXT,LENGTH) ; Breaks text string into substrings
+1 ;
+2 ; Input
+3 ; TEXT = Text String
+4 ; LENGTH = Maximum Length of Substrings
+5 ;
+6 ; Output vertical bar delimted text
+7 ; substring|substring|substring|substring|substring
+8 ;
+9 NEW GMTI,GMTJ,LINE,GMX,GMX1,GMX2,GMY
IF $GET(TEXT)']""
QUIT ""
+10 FOR GMTI=1:1
Begin DoDot:1
+11 SET GMX=$PIECE(TEXT," ",GMTI)
+12 IF $LENGTH(GMX)>LENGTH
Begin DoDot:2
+13 SET GMX1=$EXTRACT(GMX,1,LENGTH)
SET GMX2=$EXTRACT(GMX,LENGTH+1,$LENGTH(GMX))
SET $PIECE(TEXT," ",GMTI)=GMX1_" "_GMX2
End DoDot:2
End DoDot:1
if GMTI=$LENGTH(TEXT," ")
QUIT
+14 SET LINE=1
SET GMX(1)=$PIECE(TEXT," ")
FOR GMTI=2:1
Begin DoDot:1
+15 if $LENGTH($GET(GMX(LINE))_" "_$PIECE(TEXT," ",GMTI))>LENGTH
SET LINE=LINE+1
SET GMY=1
+16 SET GMX(LINE)=$GET(GMX(LINE))_$SELECT(+$GET(GMY):"",1:" ")_$PIECE(TEXT," ",GMTI)
SET GMY=0
End DoDot:1
if GMTI'<$LENGTH(TEXT," ")
QUIT
+17 SET GMTJ=0
SET TEXT=""
FOR GMTI=1:1
SET GMTJ=$ORDER(GMX(GMTJ))
if +GMTJ'>0
QUIT
SET TEXT=TEXT_$SELECT(GMTI=1:"",1:"|")_GMX(GMTJ)
+18 QUIT TEXT
