QAMPINQ2 ;HISC/DAD-INQUIRE: GROUP FILE ;11/13/92 08:19
;;1.0;Clinical Monitoring System;;09/13/1993
EN1 D XIT S QAQDIC="^QA(743.5,",QAQDIC(0)="AEMNQ",QAQDIC("A")="Select GROUP: ",QAQUTIL=743.5 D ^QAQSELCT G:QAQQUIT EXIT
K %ZIS,IOP S %ZIS="MQ",%ZIS("B")="HOME" W ! D ^%ZIS G:POP EXIT I $D(IO("Q")) K IO("Q") S ZTRTN="ENTSK^QAMPINQ2",ZTSAVE("^UTILITY($J,")="",ZTDESC="Group file inquire" D ^%ZTLOAD G EXIT
ENTSK ;
S QAMQUIT=0,QAMGTXT="" K QAMUNDL S $P(QAMUNDL,"=",81)="" U IO
F S QAMGTXT=$O(^UTILITY($J,743.5,QAMGTXT)) Q:QAMGTXT=""!QAMQUIT F QAMD0=0:0 S QAMD0=$O(^UTILITY($J,743.5,QAMGTXT,QAMD0)) Q:QAMD0'>0!QAMQUIT D LOOP0
EXIT ;
W ! D ^%ZISC
XIT K %ZIS,DIR,POP,QAM,QAMD0,QAMD1,QAMEMBR,QAMFILE,QAMGROUP,QAMGTXT,QAMPAGE,QAMQUIT,QAMUNDL,QAQDIC,QAQQUIT,QAQUTIL,X,Y,ZTRTN,ZTSAVE,^UTILITY($J,743.5)
S:$D(ZTQUEUED) ZTREQ="@"
Q
LOOP0 ;
S QAM=$S($D(^QA(743.5,QAMD0,0))#2:^(0),1:"") Q:QAM="" S QAMGROUP=$P(QAM,"^"),QAMFILE=$P(QAM,"^",2),QAMFILE=$S($D(^DIC(+QAMFILE,0))#2:$P(^(0),"^"),1:QAMFILE)
S QAMPAGE=1 D HEAD W !,"GROUP: ",QAMGROUP,?39,"FILE: ",QAMFILE,!!,"MEMBERS:"
S QAMEMBR="" F S QAMEMBR=$O(^QA(743.5,QAMD0,"GRP","B",QAMEMBR)) Q:QAMEMBR=""!QAMQUIT F QAMD1=0:0 S QAMD1=$O(^QA(743.5,QAMD0,"GRP","B",QAMEMBR,QAMD1)) Q:QAMD1'>0!QAMQUIT D LOOP1
I 'QAMQUIT W !!,QAMUNDL D WAIT
Q
LOOP1 ;
S QAM=$S($D(^QA(743.5,QAMD0,"GRP",QAMD1,0))#2:$P($P(^(0),"^"),";"),1:"") W:QAM]"" !?5,QAM D:$O(^QA(743.5,QAMD0,"GRP","B",QAMEMBR))]"" PAUSE
Q
PAUSE Q:$Y'>(IOSL-4) D WAIT,HEAD:'QAMQUIT
Q
HEAD W:(QAMPAGE>1)!($E(IOST)="C") @IOF W !,QAMUNDL,! S QAMPAGE=QAMPAGE+1
Q
WAIT I $E(IOST)="C" K DIR S DIR(0)="E" D ^DIR S QAMQUIT=$S(Y'>0:1,1:0)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAMPINQ2 1667 printed Dec 13, 2024@01:42:36 Page 2
QAMPINQ2 ;HISC/DAD-INQUIRE: GROUP FILE ;11/13/92 08:19
+1 ;;1.0;Clinical Monitoring System;;09/13/1993
EN1 DO XIT
SET QAQDIC="^QA(743.5,"
SET QAQDIC(0)="AEMNQ"
SET QAQDIC("A")="Select GROUP: "
SET QAQUTIL=743.5
DO ^QAQSELCT
if QAQQUIT
GOTO EXIT
+1 KILL %ZIS,IOP
SET %ZIS="MQ"
SET %ZIS("B")="HOME"
WRITE !
DO ^%ZIS
if POP
GOTO EXIT
IF $DATA(IO("Q"))
KILL IO("Q")
SET ZTRTN="ENTSK^QAMPINQ2"
SET ZTSAVE("^UTILITY($J,")=""
SET ZTDESC="Group file inquire"
DO ^%ZTLOAD
GOTO EXIT
ENTSK ;
+1 SET QAMQUIT=0
SET QAMGTXT=""
KILL QAMUNDL
SET $PIECE(QAMUNDL,"=",81)=""
USE IO
+2 FOR
SET QAMGTXT=$ORDER(^UTILITY($JOB,743.5,QAMGTXT))
if QAMGTXT=""!QAMQUIT
QUIT
FOR QAMD0=0:0
SET QAMD0=$ORDER(^UTILITY($JOB,743.5,QAMGTXT,QAMD0))
if QAMD0'>0!QAMQUIT
QUIT
DO LOOP0
EXIT ;
+1 WRITE !
DO ^%ZISC
XIT KILL %ZIS,DIR,POP,QAM,QAMD0,QAMD1,QAMEMBR,QAMFILE,QAMGROUP,QAMGTXT,QAMPAGE,QAMQUIT,QAMUNDL,QAQDIC,QAQQUIT,QAQUTIL,X,Y,ZTRTN,ZTSAVE,^UTILITY($JOB,743.5)
+1 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 QUIT
LOOP0 ;
+1 SET QAM=$SELECT($DATA(^QA(743.5,QAMD0,0))#2:^(0),1:"")
if QAM=""
QUIT
SET QAMGROUP=$PIECE(QAM,"^")
SET QAMFILE=$PIECE(QAM,"^",2)
SET QAMFILE=$SELECT($DATA(^DIC(+QAMFILE,0))#2:$PIECE(^(0),"^"),1:QAMFILE)
+2 SET QAMPAGE=1
DO HEAD
WRITE !,"GROUP: ",QAMGROUP,?39,"FILE: ",QAMFILE,!!,"MEMBERS:"
+3 SET QAMEMBR=""
FOR
SET QAMEMBR=$ORDER(^QA(743.5,QAMD0,"GRP","B",QAMEMBR))
if QAMEMBR=""!QAMQUIT
QUIT
FOR QAMD1=0:0
SET QAMD1=$ORDER(^QA(743.5,QAMD0,"GRP","B",QAMEMBR,QAMD1))
if QAMD1'>0!QAMQUIT
QUIT
DO LOOP1
+4 IF 'QAMQUIT
WRITE !!,QAMUNDL
DO WAIT
+5 QUIT
LOOP1 ;
+1 SET QAM=$SELECT($DATA(^QA(743.5,QAMD0,"GRP",QAMD1,0))#2:$PIECE($PIECE(^(0),"^"),";"),1:"")
if QAM]""
WRITE !?5,QAM
if $ORDER(^QA(743.5,QAMD0,"GRP","B",QAMEMBR))]""
DO PAUSE
+2 QUIT
PAUSE if $Y'>(IOSL-4)
QUIT
DO WAIT
if 'QAMQUIT
DO HEAD
+1 QUIT
HEAD if (QAMPAGE>1)!($EXTRACT(IOST)="C")
WRITE @IOF
WRITE !,QAMUNDL,!
SET QAMPAGE=QAMPAGE+1
+1 QUIT
WAIT IF $EXTRACT(IOST)="C"
KILL DIR
SET DIR(0)="E"
DO ^DIR
SET QAMQUIT=$SELECT(Y'>0:1,1:0)
+1 QUIT
