QAMPINQ3 ;HISC/DAD-INQUIRE: DATA ELEMENT FILE ;11/13/92 08:51
;;1.0;Clinical Monitoring System;;09/13/1993
EN1 D XIT S QAQDIC="^QA(743.4,",QAQDIC(0)="AEMNQ",QAQDIC("A")="Select DATA ELEMENT: ",QAQUTIL=743.4 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^QAMPINQ3",ZTSAVE("^UTILITY($J,")="",ZTDESC="Data element file inquire" D ^%ZTLOAD G EXIT
ENTSK ;
S (QAMQUIT,QAMEDT7)=0,QAMDTXT="" K QAMUNDL S $P(QAMUNDL,"=",81)="" U IO
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
EXIT ;
W ! D ^%ZISC
XIT 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)
S:$D(ZTQUEUED) ZTREQ="@"
Q
LOOP ;LOOP THROUGH SELECTED DATA ELEMENTS
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)
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
S QAMPAGE=1 D HEAD W !,"ELEMENT: ",QAMELEM,?39,"FILE: ",QAMFILE,!!?2,"DD LEVEL",?28,"FIELD #",?52,"DD NUMBER"
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
I 'QAMQUIT W !!,QAMUNDL D WAIT:'QAMEDT7
Q
PAUSE Q:$Y'>(IOSL-4) D WAIT,HEAD:'QAMQUIT
Q
HEAD W:(QAMPAGE>1)!($E(IOST)="C") @IOF,!,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[HQAMPINQ3 1750 printed Nov 22, 2024@16:52:48 Page 2
QAMPINQ3 ;HISC/DAD-INQUIRE: DATA ELEMENT FILE ;11/13/92 08:51
+1 ;;1.0;Clinical Monitoring System;;09/13/1993
EN1 DO XIT
SET QAQDIC="^QA(743.4,"
SET QAQDIC(0)="AEMNQ"
SET QAQDIC("A")="Select DATA ELEMENT: "
SET QAQUTIL=743.4
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^QAMPINQ3"
SET ZTSAVE("^UTILITY($J,")=""
SET ZTDESC="Data element file inquire"
DO ^%ZTLOAD
GOTO EXIT
ENTSK ;
+1 SET (QAMQUIT,QAMEDT7)=0
SET QAMDTXT=""
KILL QAMUNDL
SET $PIECE(QAMUNDL,"=",81)=""
USE IO
+2 FOR
SET QAMDTXT=$ORDER(^UTILITY($JOB,743.4,QAMDTXT))
if QAMDTXT=""!QAMQUIT
QUIT
FOR QAMD0=0:0
SET QAMD0=$ORDER(^UTILITY($JOB,743.4,QAMDTXT,QAMD0))
if QAMD0'>0!QAMQUIT
QUIT
DO LOOP
EXIT ;
+1 WRITE !
DO ^%ZISC
XIT KILL %ZIS,DIR,POP,QA,QAM,QAMD0,QAMD1,QAMDATA,QAMDTXT,QAMEDT7,QAMELEM,QAMFILE,QAMPAGE,QAMQUIT,QAMUNDL,QAQDIC,QAQQUIT,QAQUTIL,X,Y,ZTRTN,ZTSAVE,^UTILITY($JOB,743.4)
+1 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 QUIT
LOOP ;LOOP THROUGH SELECTED DATA ELEMENTS
+1 SET QAM=$SELECT($DATA(^QA(743.4,QAMD0,0))#2:^(0),1:"")
if QAM=""
QUIT
SET QAMELEM=$PIECE(QAM,"^")
SET QAMFILE=$PIECE(QAM,"^",3)
SET QAMFILE=$SELECT($DATA(^DIC(+QAMFILE,0))#2:$PIECE(^(0),"^"),1:QAMFILE)
+2 KILL QAMDATA
FOR QAMD1=0:0
SET QAMD1=$ORDER(^QA(743.4,QAMD0,"DD",QAMD1))
if QAMD1'>0
QUIT
SET QAM=^QA(743.4,QAMD0,"DD",QAMD1,0)
SET QAMDATA(+$PIECE(QAM,"^",3))=QAM
+3 SET QAMPAGE=1
DO HEAD
WRITE !,"ELEMENT: ",QAMELEM,?39,"FILE: ",QAMFILE,!!?2,"DD LEVEL",?28,"FIELD #",?52,"DD NUMBER"
+4 FOR QAMD1=0:0
SET QAMD1=$ORDER(QAMDATA(QAMD1))
if QAMD1'>0!QAMQUIT
QUIT
SET QA=QAMDATA(QAMD1)
WRITE !?3,$JUSTIFY($PIECE(QA,"^",3),2,0),?30,$PIECE(QA,"^",2),?54,$PIECE(QA,"^")
if $ORDER(QAMDATA(QAMD1))
DO PAUSE
+5 IF 'QAMQUIT
WRITE !!,QAMUNDL
if 'QAMEDT7
DO WAIT
+6 QUIT
PAUSE if $Y'>(IOSL-4)
QUIT
DO WAIT
if 'QAMQUIT
DO HEAD
+1 QUIT
HEAD if (QAMPAGE>1)!($EXTRACT(IOST)="C")
WRITE @IOF,!,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
