source: FOIAVistA/trunk/r/CLINICAL_MONITORING_SYSTEM-QAM/QAMPINQ3.m@ 1397

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

initial load of FOIAVistA 6/30/08 version

File size: 1.7 KB
Line 
1QAMPINQ3 ;HISC/DAD-INQUIRE: DATA ELEMENT FILE ;11/13/92 08:51
2 ;;1.0;Clinical Monitoring System;;09/13/1993
3EN1 D XIT S QAQDIC="^QA(743.4,",QAQDIC(0)="AEMNQ",QAQDIC("A")="Select DATA ELEMENT: ",QAQUTIL=743.4 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^QAMPINQ3",ZTSAVE("^UTILITY($J,")="",ZTDESC="Data element file inquire" D ^%ZTLOAD G EXIT
5ENTSK ;
6 S (QAMQUIT,QAMEDT7)=0,QAMDTXT="" K QAMUNDL S $P(QAMUNDL,"=",81)="" U IO
7 F S QAMDTXT=$O(^UTILITY($J,743.4,QAMDTXT)) Q:QAMDTXT=""!QAMQUIT F QAMD0=0:0 S QAMD0=$O(^UTILITY($J,743.4,QAMDTXT,QAMD0)) Q:QAMD0'>0!QAMQUIT D LOOP
8EXIT ;
9 W ! D ^%ZISC
10XIT K %ZIS,DIR,POP,QA,QAM,QAMD0,QAMD1,QAMDATA,QAMDTXT,QAMEDT7,QAMELEM,QAMFILE,QAMPAGE,QAMQUIT,QAMUNDL,QAQDIC,QAQQUIT,QAQUTIL,X,Y,ZTRTN,ZTSAVE,^UTILITY($J,743.4)
11 S:$D(ZTQUEUED) ZTREQ="@"
12 Q
13LOOP ;LOOP THROUGH SELECTED DATA ELEMENTS
14 S QAM=$S($D(^QA(743.4,QAMD0,0))#2:^(0),1:"") Q:QAM="" S QAMELEM=$P(QAM,"^"),QAMFILE=$P(QAM,"^",3),QAMFILE=$S($D(^DIC(+QAMFILE,0))#2:$P(^(0),"^"),1:QAMFILE)
15 K QAMDATA F QAMD1=0:0 S QAMD1=$O(^QA(743.4,QAMD0,"DD",QAMD1)) Q:QAMD1'>0 S QAM=^QA(743.4,QAMD0,"DD",QAMD1,0),QAMDATA(+$P(QAM,"^",3))=QAM
16 S QAMPAGE=1 D HEAD W !,"ELEMENT: ",QAMELEM,?39,"FILE: ",QAMFILE,!!?2,"DD LEVEL",?28,"FIELD #",?52,"DD NUMBER"
17 F QAMD1=0:0 S QAMD1=$O(QAMDATA(QAMD1)) Q:QAMD1'>0!QAMQUIT S QA=QAMDATA(QAMD1) W !?3,$J($P(QA,"^",3),2,0),?30,$P(QA,"^",2),?54,$P(QA,"^") D:$O(QAMDATA(QAMD1)) PAUSE
18 I 'QAMQUIT W !!,QAMUNDL D WAIT:'QAMEDT7
19 Q
20PAUSE Q:$Y'>(IOSL-4) D WAIT,HEAD:'QAMQUIT
21 Q
22HEAD W:(QAMPAGE>1)!($E(IOST)="C") @IOF,!,QAMUNDL,! S QAMPAGE=QAMPAGE+1
23 Q
24WAIT I $E(IOST)="C" K DIR S DIR(0)="E" D ^DIR S QAMQUIT=$S(Y'>0:1,1:0)
25 Q
Note: See TracBrowser for help on using the repository browser.