ORPRS09 ; slc/dcm - The prints_es_n_da_p ;6/10/97 15:33
;;3.0;ORDER ENTRY/RESULTS REPORTING;**11,99**;Dec 17, 1997
PRES ;Change presentation context (All, Active, Expired, etc.)
;Returns ORPRES set to new context
;OREND=1 if no selection made
S X=$O(^ORD(101,"B","ORRP STATUS MENU",0))_";ORD(101,"
D EN^XQOR
I $S('$D(X):0,X="^":1,X="^^":1,$D(DIROUT):1,$D(DTOUT):1,1:0) S OREND=1 Q
S:'$D(ORPRES) ORPRES="2;ACTIVE ORDERS"
Q
SERV ;Change service context (All, Lab, RX, etc.)
S (OREND,ORDG)=0
F W !!,"Select Service/Section: All Services// " R X:DTIME S:'$T X="^" S:X["^^" DIROUT=1 S:'$L(X) X="ALL SERVICES" S:X["^" OREND=1 Q:OREND=1 D @$S(X["?":"LSRV",1:"LKUP") Q:ORDG
I ORDG D SERV1(ORDG)
Q
SERV1(ORBUF) ;Setup ORGRP array based on display group
;ORBUF=ORDG ptr to display group
Q:'$G(ORBUF)
K ORGRP
D EN^ORPRS01(ORBUF,"BILD")
S ORGRP("NAM")=^ORD(100.98,ORDG,0),ORGRP("ROOT")=ORBUF,ORGRP("NAM")=$S($L($P(ORGRP("NAM"),"^",3)):$P(ORGRP("NAM"),"^",3),1:$E($P(ORGRP("NAM"),"^"),1,5))
Q
LKUP ;
S DIC="^ORD(100.98,",DIC(0)="NEQ",DIC("W")="W "" "",$P(Y,""^"",2)"
D ^DIC
K DIC
S:+Y>0 ORDG=+Y
Q
LSRV ;
I X'["??" W !!,"ALL SERVICES" F I=0:0 S I=$O(^ORD(100.98,1,1,I)) Q:I'>0 I $D(^ORD(100.98,1,1,I,0)) S ORDG=+$P(^(0),"^") W:$D(^ORD(100.98,ORDG,0)) !?2,$P(^(0),"^")
I X["??" S ORDG=1 W ! D EN^ORPRS01(ORDG,"DISP")
S ORDG=0
W !
Q
FMT(LENGTH,INDEX,TEXT) ;Format text
N X,Y,J
S Y=1
S:'$D(ORTX(INDEX)) ORTX(INDEX)=""
S X=$L(TEXT)+$L(ORTX(INDEX))+1
I X<255 S TEXT=$S($L(ORTX(INDEX)):ORTX(INDEX)_" "_TEXT,1:TEXT)
I X'<255 S INDEX=INDEX+1,ORTX(INDEX)=""
S ORTX(INDEX)=""
F J=1:1 S X=$P(TEXT," ",J) Q:J>$L(TEXT," ") D
. Q:'$L(X)
. I ($L(X)+$L(ORTX(INDEX)))>LENGTH S Y=1,INDEX=INDEX+1,ORTX(INDEX)=""
. S ORTX(INDEX)=$S(Y:X,1:ORTX(INDEX)_" "_X),Y=0
S ORTX(INDEX)=$$STRIP^ORU2(ORTX(INDEX)),ORINDX=INDEX
Q ORINDX
ANSIH ;Clear scroll region and home cursor
S DX=1,DY=ORANSI("T")
W @ORANSI("XY"),$C(27),$C(91),"24",$C(77),$C(13)
S (DX,DY)=0
X ^%ZOSF("XY")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORPRS09 2039 printed Apr 09, 2024@21:45:02 Page 2
ORPRS09 ; slc/dcm - The prints_es_n_da_p ;6/10/97 15:33
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**11,99**;Dec 17, 1997
PRES ;Change presentation context (All, Active, Expired, etc.)
+1 ;Returns ORPRES set to new context
+2 ;OREND=1 if no selection made
+3 SET X=$ORDER(^ORD(101,"B","ORRP STATUS MENU",0))_";ORD(101,"
+4 DO EN^XQOR
+5 IF $SELECT('$DATA(X):0,X="^":1,X="^^":1,$DATA(DIROUT):1,$DATA(DTOUT):1,1:0)
SET OREND=1
QUIT
+6 if '$DATA(ORPRES)
SET ORPRES="2;ACTIVE ORDERS"
+7 QUIT
SERV ;Change service context (All, Lab, RX, etc.)
+1 SET (OREND,ORDG)=0
+2 FOR
WRITE !!,"Select Service/Section: All Services// "
READ X:DTIME
if '$TEST
SET X="^"
if X["^^"
SET DIROUT=1
if '$LENGTH(X)
SET X="ALL SERVICES"
if X["^"
SET OREND=1
if OREND=1
QUIT
DO @$SELECT(X["?":"LSRV",1:"LKUP")
if ORDG
QUIT
+3 IF ORDG
DO SERV1(ORDG)
+4 QUIT
SERV1(ORBUF) ;Setup ORGRP array based on display group
+1 ;ORBUF=ORDG ptr to display group
+2 if '$GET(ORBUF)
QUIT
+3 KILL ORGRP
+4 DO EN^ORPRS01(ORBUF,"BILD")
+5 SET ORGRP("NAM")=^ORD(100.98,ORDG,0)
SET ORGRP("ROOT")=ORBUF
SET ORGRP("NAM")=$SELECT($LENGTH($PIECE(ORGRP("NAM"),"^",3)):$PIECE(ORGRP("NAM"),"^",3),1:$EXTRACT($PIECE(ORGRP("NAM"),"^"),1,5))
+6 QUIT
LKUP ;
+1 SET DIC="^ORD(100.98,"
SET DIC(0)="NEQ"
SET DIC("W")="W "" "",$P(Y,""^"",2)"
+2 DO ^DIC
+3 KILL DIC
+4 if +Y>0
SET ORDG=+Y
+5 QUIT
LSRV ;
+1 IF X'["??"
WRITE !!,"ALL SERVICES"
FOR I=0:0
SET I=$ORDER(^ORD(100.98,1,1,I))
if I'>0
QUIT
IF $DATA(^ORD(100.98,1,1,I,0))
SET ORDG=+$PIECE(^(0),"^")
if $DATA(^ORD(100.98,ORDG,0))
WRITE !?2,$PIECE(^(0),"^")
+2 IF X["??"
SET ORDG=1
WRITE !
DO EN^ORPRS01(ORDG,"DISP")
+3 SET ORDG=0
+4 WRITE !
+5 QUIT
FMT(LENGTH,INDEX,TEXT) ;Format text
+1 NEW X,Y,J
+2 SET Y=1
+3 if '$DATA(ORTX(INDEX))
SET ORTX(INDEX)=""
+4 SET X=$LENGTH(TEXT)+$LENGTH(ORTX(INDEX))+1
+5 IF X<255
SET TEXT=$SELECT($LENGTH(ORTX(INDEX)):ORTX(INDEX)_" "_TEXT,1:TEXT)
+6 IF X'<255
SET INDEX=INDEX+1
SET ORTX(INDEX)=""
+7 SET ORTX(INDEX)=""
+8 FOR J=1:1
SET X=$PIECE(TEXT," ",J)
if J>$LENGTH(TEXT," ")
QUIT
Begin DoDot:1
+9 if '$LENGTH(X)
QUIT
+10 IF ($LENGTH(X)+$LENGTH(ORTX(INDEX)))>LENGTH
SET Y=1
SET INDEX=INDEX+1
SET ORTX(INDEX)=""
+11 SET ORTX(INDEX)=$SELECT(Y:X,1:ORTX(INDEX)_" "_X)
SET Y=0
End DoDot:1
+12 SET ORTX(INDEX)=$$STRIP^ORU2(ORTX(INDEX))
SET ORINDX=INDEX
+13 QUIT ORINDX
ANSIH ;Clear scroll region and home cursor
+1 SET DX=1
SET DY=ORANSI("T")
+2 WRITE @ORANSI("XY"),$CHAR(27),$CHAR(91),"24",$CHAR(77),$CHAR(13)
+3 SET (DX,DY)=0
+4 XECUTE ^%ZOSF("XY")
+5 QUIT
