ORCHANG1 ; SLC/KCM,MKB - Navigate Display Groups ;9/19/95 15:27
;;3.0;ORDER ENTRY/RESULTS REPORTING;;Dec 17, 1997
DG(ORDG,ORSEL,ORGRP) ;Setup/Display groups
N ORSTK,ORMEM,ORCNT
Q:'ORDG Q:'$D(ORSEL)
S ORSTK=0,ORCNT=0 D @ORSEL
S ORSTK=1,ORSTK(ORSTK)=ORDG_"^0",ORSTK(0)=0,ORMEM=0
F S ORMEM=$O(^ORD(100.98,+ORSTK(ORSTK),1,ORMEM)) D @$S(+ORMEM'>0:"POP",1:"PROC") Q:ORSTK<1
K ORMEM,ORSTK
Q
;
POP ; -- pop the stack
S ORSTK=ORSTK-1,ORMEM=$P(ORSTK(ORSTK),U,2)
Q
PROC ; -- process member
S $P(ORSTK(ORSTK),U,2)=ORMEM
S ORDG=$P(^ORD(100.98,+ORSTK(ORSTK),1,ORMEM,0),U)
D @ORSEL
S ORSTK=ORSTK+1,ORSTK(ORSTK)=ORDG_"^0",ORMEM=0
Q
;
DISP ; -- display item
S ORCNT=ORCNT+1 I ORCNT>(IOSL-4) D READ S ORCNT=1
W !,?((ORSTK*2)),$P(^ORD(100.98,ORDG,0),U)
Q
;
BILD ; -- build ORGRP()
S ORGRP(ORDG)=""
Q
;
READ ; -- continue?
N X
W !!,"Press <return> to continue ..." R X:DTIME
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORCHANG1 921 printed Oct 16, 2024@18:28:55 Page 2
ORCHANG1 ; SLC/KCM,MKB - Navigate Display Groups ;9/19/95 15:27
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;;Dec 17, 1997
DG(ORDG,ORSEL,ORGRP) ;Setup/Display groups
+1 NEW ORSTK,ORMEM,ORCNT
+2 if 'ORDG
QUIT
if '$DATA(ORSEL)
QUIT
+3 SET ORSTK=0
SET ORCNT=0
DO @ORSEL
+4 SET ORSTK=1
SET ORSTK(ORSTK)=ORDG_"^0"
SET ORSTK(0)=0
SET ORMEM=0
+5 FOR
SET ORMEM=$ORDER(^ORD(100.98,+ORSTK(ORSTK),1,ORMEM))
DO @$SELECT(+ORMEM'>0:"POP",1:"PROC")
if ORSTK<1
QUIT
+6 KILL ORMEM,ORSTK
+7 QUIT
+8 ;
POP ; -- pop the stack
+1 SET ORSTK=ORSTK-1
SET ORMEM=$PIECE(ORSTK(ORSTK),U,2)
+2 QUIT
PROC ; -- process member
+1 SET $PIECE(ORSTK(ORSTK),U,2)=ORMEM
+2 SET ORDG=$PIECE(^ORD(100.98,+ORSTK(ORSTK),1,ORMEM,0),U)
+3 DO @ORSEL
+4 SET ORSTK=ORSTK+1
SET ORSTK(ORSTK)=ORDG_"^0"
SET ORMEM=0
+5 QUIT
+6 ;
DISP ; -- display item
+1 SET ORCNT=ORCNT+1
IF ORCNT>(IOSL-4)
DO READ
SET ORCNT=1
+2 WRITE !,?((ORSTK*2)),$PIECE(^ORD(100.98,ORDG,0),U)
+3 QUIT
+4 ;
BILD ; -- build ORGRP()
+1 SET ORGRP(ORDG)=""
+2 QUIT
+3 ;
READ ; -- continue?
+1 NEW X
+2 WRITE !!,"Press <return> to continue ..."
READ X:DTIME
+3 QUIT