source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORPRS09.m@ 1608

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

initial load of WorldVistAEHR

File size: 1.9 KB
RevLine 
[613]1ORPRS09 ; slc/dcm - The prints_es_n_da_p ;6/10/97 15:33
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**11,99**;Dec 17, 1997
3PRES ;Change presentation context (All, Active, Expired, etc.)
4 ;Returns ORPRES set to new context
5 ;OREND=1 if no selection made
6 S X=$O(^ORD(101,"B","ORRP STATUS MENU",0))_";ORD(101,"
7 D EN^XQOR
8 I $S('$D(X):0,X="^":1,X="^^":1,$D(DIROUT):1,$D(DTOUT):1,1:0) S OREND=1 Q
9 S:'$D(ORPRES) ORPRES="2;ACTIVE ORDERS"
10 Q
11SERV ;Change service context (All, Lab, RX, etc.)
12 S (OREND,ORDG)=0
13 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
14 I ORDG D SERV1(ORDG)
15 Q
16SERV1(ORBUF) ;Setup ORGRP array based on display group
17 ;ORBUF=ORDG ptr to display group
18 Q:'$G(ORBUF)
19 K ORGRP
20 D EN^ORPRS01(ORBUF,"BILD")
21 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))
22 Q
23LKUP ;
24 S DIC="^ORD(100.98,",DIC(0)="NEQ",DIC("W")="W "" "",$P(Y,""^"",2)"
25 D ^DIC
26 K DIC
27 S:+Y>0 ORDG=+Y
28 Q
29LSRV ;
30 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),"^")
31 I X["??" S ORDG=1 W ! D EN^ORPRS01(ORDG,"DISP")
32 S ORDG=0
33 W !
34 Q
35FMT(LENGTH,INDEX,TEXT) ;Format text
36 N X,Y,J
37 S Y=1
38 S:'$D(ORTX(INDEX)) ORTX(INDEX)=""
39 S X=$L(TEXT)+$L(ORTX(INDEX))+1
40 I X<255 S TEXT=$S($L(ORTX(INDEX)):ORTX(INDEX)_" "_TEXT,1:TEXT)
41 I X'<255 S INDEX=INDEX+1,ORTX(INDEX)=""
42 S ORTX(INDEX)=""
43 F J=1:1 S X=$P(TEXT," ",J) Q:J>$L(TEXT," ") D
44 . Q:'$L(X)
45 . I ($L(X)+$L(ORTX(INDEX)))>LENGTH S Y=1,INDEX=INDEX+1,ORTX(INDEX)=""
46 . S ORTX(INDEX)=$S(Y:X,1:ORTX(INDEX)_" "_X),Y=0
47 S ORTX(INDEX)=$$STRIP^ORU2(ORTX(INDEX)),ORINDX=INDEX
48 Q ORINDX
49ANSIH ;Clear scroll region and home cursor
50 S DX=1,DY=ORANSI("T")
51 W @ORANSI("XY"),$C(27),$C(91),"24",$C(77),$C(13)
52 S (DX,DY)=0
53 X ^%ZOSF("XY")
54 Q
Note: See TracBrowser for help on using the repository browser.