source: WorldVistAEHR/trunk/r/CLINICAL_MONITORING_SYSTEM-QAM/QAMPINQ2.m@ 1361

Last change on this file since 1361 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.6 KB
RevLine 
[613]1QAMPINQ2 ;HISC/DAD-INQUIRE: GROUP FILE ;11/13/92 08:19
2 ;;1.0;Clinical Monitoring System;;09/13/1993
3EN1 D XIT S QAQDIC="^QA(743.5,",QAQDIC(0)="AEMNQ",QAQDIC("A")="Select GROUP: ",QAQUTIL=743.5 D ^QAQSELCT G:QAQQUIT EXIT
4 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
5ENTSK ;
6 S QAMQUIT=0,QAMGTXT="" K QAMUNDL S $P(QAMUNDL,"=",81)="" U IO
7 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
8EXIT ;
9 W ! D ^%ZISC
10XIT 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)
11 S:$D(ZTQUEUED) ZTREQ="@"
12 Q
13LOOP0 ;
14 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)
15 S QAMPAGE=1 D HEAD W !,"GROUP: ",QAMGROUP,?39,"FILE: ",QAMFILE,!!,"MEMBERS:"
16 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
17 I 'QAMQUIT W !!,QAMUNDL D WAIT
18 Q
19LOOP1 ;
20 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
21 Q
22PAUSE Q:$Y'>(IOSL-4) D WAIT,HEAD:'QAMQUIT
23 Q
24HEAD W:(QAMPAGE>1)!($E(IOST)="C") @IOF W !,QAMUNDL,! S QAMPAGE=QAMPAGE+1
25 Q
26WAIT I $E(IOST)="C" K DIR S DIR(0)="E" D ^DIR S QAMQUIT=$S(Y'>0:1,1:0)
27 Q
Note: See TracBrowser for help on using the repository browser.