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

ORPRS09.m

Go to the documentation of this file.
  1. 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
  1. PRES ;Change presentation context (All, Active, Expired, etc.)
  1. ;Returns ORPRES set to new context
  1. ;OREND=1 if no selection made
  1. S X=$O(^ORD(101,"B","ORRP STATUS MENU",0))_";ORD(101,"
  1. D EN^XQOR
  1. I $S('$D(X):0,X="^":1,X="^^":1,$D(DIROUT):1,$D(DTOUT):1,1:0) S OREND=1 Q
  1. S:'$D(ORPRES) ORPRES="2;ACTIVE ORDERS"
  1. Q
  1. SERV ;Change service context (All, Lab, RX, etc.)
  1. S (OREND,ORDG)=0
  1. 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
  1. I ORDG D SERV1(ORDG)
  1. Q
  1. SERV1(ORBUF) ;Setup ORGRP array based on display group
  1. ;ORBUF=ORDG ptr to display group
  1. Q:'$G(ORBUF)
  1. K ORGRP
  1. D EN^ORPRS01(ORBUF,"BILD")
  1. 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))
  1. Q
  1. LKUP ;
  1. S DIC="^ORD(100.98,",DIC(0)="NEQ",DIC("W")="W "" "",$P(Y,""^"",2)"
  1. D ^DIC
  1. K DIC
  1. S:+Y>0 ORDG=+Y
  1. Q
  1. LSRV ;
  1. 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),"^")
  1. I X["??" S ORDG=1 W ! D EN^ORPRS01(ORDG,"DISP")
  1. S ORDG=0
  1. W !
  1. Q
  1. FMT(LENGTH,INDEX,TEXT) ;Format text
  1. N X,Y,J
  1. S Y=1
  1. S:'$D(ORTX(INDEX)) ORTX(INDEX)=""
  1. S X=$L(TEXT)+$L(ORTX(INDEX))+1
  1. I X<255 S TEXT=$S($L(ORTX(INDEX)):ORTX(INDEX)_" "_TEXT,1:TEXT)
  1. I X'<255 S INDEX=INDEX+1,ORTX(INDEX)=""
  1. S ORTX(INDEX)=""
  1. F J=1:1 S X=$P(TEXT," ",J) Q:J>$L(TEXT," ") D
  1. . Q:'$L(X)
  1. . I ($L(X)+$L(ORTX(INDEX)))>LENGTH S Y=1,INDEX=INDEX+1,ORTX(INDEX)=""
  1. . S ORTX(INDEX)=$S(Y:X,1:ORTX(INDEX)_" "_X),Y=0
  1. S ORTX(INDEX)=$$STRIP^ORU2(ORTX(INDEX)),ORINDX=INDEX
  1. Q ORINDX
  1. ANSIH ;Clear scroll region and home cursor
  1. S DX=1,DY=ORANSI("T")
  1. W @ORANSI("XY"),$C(27),$C(91),"24",$C(77),$C(13)
  1. S (DX,DY)=0
  1. X ^%ZOSF("XY")
  1. Q