QAMPINQ4 ;HISC/DAD-INQUIRE: CONDITION FILE ;11/13/92 08:23
;;1.0;Clinical Monitoring System;;09/13/1993
EN1 D XIT S QAQDIC="^QA(743.3,",QAQDIC(0)="AEMNQ",QAQDIC("A")="Select CONDITION: ",QAQUTIL=743.3 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^QAMPINQ4",ZTSAVE("^UTILITY($J,")="",ZTDESC="Condition file inquire" D ^%ZTLOAD G EXIT
ENTSK ;
S QAMQUIT=0,QAMCTXT="" K QAMUNDL S $P(QAMUNDL,"=",81)="" U IO
F S QAMCTXT=$O(^UTILITY($J,743.3,QAMCTXT)) Q:QAMCTXT=""!QAMQUIT F QAMD0=0:0 S QAMD0=$O(^UTILITY($J,743.3,QAMCTXT,QAMD0)) Q:QAMD0'>0!QAMQUIT D LOOP
EXIT ;
W ! D ^%ZISC
XIT K %ZIS,DIR,DIW,DIWF,DIWL,DIWR,DIWT,DN,POP,QA,QAM,QAMAUTO,QAMCOND,QAMCTXT,QAMD0,QAMD1,QAMELEM,QAMFOUND,QAMPAGE,QAMQUIT,QAMUNDL,QAQQUIT,X,Y,ZTRTN,ZTSAVE,^UTILITY($J,743.3),^UTILITY($J,"W"),^UTILITY($J,"QAMPINQ4")
S:$D(ZTQUEUED) ZTREQ="@"
Q
LOOP ;
S QAM=$S($D(^QA(743.3,QAMD0,0))#2:^(0),1:"") Q:QAM="" S QAMCOND=$P(QAM,"^"),QAMAUTO=$S($P(QAM,"^",2):"YES",1:"NO")
K ^UTILITY($J,"QAMPINQ4") F QAMD1=0:0 S QAMD1=$O(^QA(743.3,QAMD0,"ELEM",QAMD1)) Q:QAMD1'>0 S QA=+^QA(743.3,QAMD0,"ELEM",QAMD1,0),QAM=$S($D(^QA(743.4,QA,0))#2:$P(^(0),"^"),1:QA),^UTILITY($J,"QAMPINQ4",QAM)=""
S QAMPAGE=1 D HEAD W !,"CONDITION: ",QAMCOND,?44,"AUTO ENROLL: ",QAMAUTO,!!,"DESCRIPTION:"
S QAMFOUND=0,DIWL=6,DIWR=75,DIWF="W" K ^UTILITY($J,"W")
F QAMD1=0:0 S QAMD1=$O(^QA(743.3,QAMD0,"DESC",QAMD1)) Q:QAMD1'>0!QAMQUIT S X=^QA(743.3,QAMD0,"DESC",QAMD1,0),QAMFOUND=1 D ^DIWP,PAUSE:$O(^QA(743.3,QAMD0,"DESC",QAMD1))
I 'QAMFOUND S X="Sorry, no description found for this condition." D ^DIWP,PAUSE
Q:QAMQUIT D ^DIWW,PAUSE Q:QAMQUIT
W !,"DATA ELEMENTS:" D PAUSE Q:QAMQUIT
S QAMELEM="" F S QAMELEM=$O(^UTILITY($J,"QAMPINQ4",QAMELEM)) Q:QAMELEM=""!QAMQUIT W !?5,QAMELEM D:$O(^UTILITY($J,"QAMPINQ4",QAMELEM))]"" PAUSE
I 'QAMQUIT W !!,QAMUNDL D WAIT
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[HQAMPINQ4 2121 printed Dec 13, 2024@01:42:37 Page 2
QAMPINQ4 ;HISC/DAD-INQUIRE: CONDITION FILE ;11/13/92 08:23
+1 ;;1.0;Clinical Monitoring System;;09/13/1993
EN1 DO XIT
SET QAQDIC="^QA(743.3,"
SET QAQDIC(0)="AEMNQ"
SET QAQDIC("A")="Select CONDITION: "
SET QAQUTIL=743.3
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^QAMPINQ4"
SET ZTSAVE("^UTILITY($J,")=""
SET ZTDESC="Condition file inquire"
DO ^%ZTLOAD
GOTO EXIT
ENTSK ;
+1 SET QAMQUIT=0
SET QAMCTXT=""
KILL QAMUNDL
SET $PIECE(QAMUNDL,"=",81)=""
USE IO
+2 FOR
SET QAMCTXT=$ORDER(^UTILITY($JOB,743.3,QAMCTXT))
if QAMCTXT=""!QAMQUIT
QUIT
FOR QAMD0=0:0
SET QAMD0=$ORDER(^UTILITY($JOB,743.3,QAMCTXT,QAMD0))
if QAMD0'>0!QAMQUIT
QUIT
DO LOOP
EXIT ;
+1 WRITE !
DO ^%ZISC
XIT KILL %ZIS,DIR,DIW,DIWF,DIWL,DIWR,DIWT,DN,POP,QA,QAM,QAMAUTO,QAMCOND,QAMCTXT,QAMD0,QAMD1,QAMELEM,QAMFOUND,QAMPAGE,QAMQUIT,QAMUNDL,QAQQUIT,X,Y,ZTRTN,ZTSAVE,^UTILITY($JOB,743.3),^UTILITY($JOB,"W"),^UTILITY($JOB,"QAMPINQ4")
+1 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 QUIT
LOOP ;
+1 SET QAM=$SELECT($DATA(^QA(743.3,QAMD0,0))#2:^(0),1:"")
if QAM=""
QUIT
SET QAMCOND=$PIECE(QAM,"^")
SET QAMAUTO=$SELECT($PIECE(QAM,"^",2):"YES",1:"NO")
+2 KILL ^UTILITY($JOB,"QAMPINQ4")
FOR QAMD1=0:0
SET QAMD1=$ORDER(^QA(743.3,QAMD0,"ELEM",QAMD1))
if QAMD1'>0
QUIT
SET QA=+^QA(743.3,QAMD0,"ELEM",QAMD1,0)
SET QAM=$SELECT($DATA(^QA(743.4,QA,0))#2:$PIECE(^(0),"^"),1:QA)
SET ^UTILITY($JOB,"QAMPINQ4",QAM)=""
+3 SET QAMPAGE=1
DO HEAD
WRITE !,"CONDITION: ",QAMCOND,?44,"AUTO ENROLL: ",QAMAUTO,!!,"DESCRIPTION:"
+4 SET QAMFOUND=0
SET DIWL=6
SET DIWR=75
SET DIWF="W"
KILL ^UTILITY($JOB,"W")
+5 FOR QAMD1=0:0
SET QAMD1=$ORDER(^QA(743.3,QAMD0,"DESC",QAMD1))
if QAMD1'>0!QAMQUIT
QUIT
SET X=^QA(743.3,QAMD0,"DESC",QAMD1,0)
SET QAMFOUND=1
DO ^DIWP
if $ORDER(^QA(743.3,QAMD0,"DESC",QAMD1))
DO PAUSE
+6 IF 'QAMFOUND
SET X="Sorry, no description found for this condition."
DO ^DIWP
DO PAUSE
+7 if QAMQUIT
QUIT
DO ^DIWW
DO PAUSE
if QAMQUIT
QUIT
+8 WRITE !,"DATA ELEMENTS:"
DO PAUSE
if QAMQUIT
QUIT
+9 SET QAMELEM=""
FOR
SET QAMELEM=$ORDER(^UTILITY($JOB,"QAMPINQ4",QAMELEM))
if QAMELEM=""!QAMQUIT
QUIT
WRITE !?5,QAMELEM
if $ORDER(^UTILITY($JOB,"QAMPINQ4",QAMELEM))]""
DO PAUSE
+10 IF 'QAMQUIT
WRITE !!,QAMUNDL
DO WAIT
+11 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
