- 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 Jan 18, 2025@02:43:49 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