- 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 Dec 13, 2024@02:32:56 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