source: WorldVistAEHR/trunk/r/CLINICAL_MONITORING_SYSTEM-QAM/QAMPINQ4.m@ 1605

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

initial load of WorldVistAEHR

File size: 2.0 KB
RevLine 
[613]1QAMPINQ4 ;HISC/DAD-INQUIRE: CONDITION FILE ;11/13/92 08:23
2 ;;1.0;Clinical Monitoring System;;09/13/1993
3EN1 D XIT S QAQDIC="^QA(743.3,",QAQDIC(0)="AEMNQ",QAQDIC("A")="Select CONDITION: ",QAQUTIL=743.3 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^QAMPINQ4",ZTSAVE("^UTILITY($J,")="",ZTDESC="Condition file inquire" D ^%ZTLOAD G EXIT
5ENTSK ;
6 S QAMQUIT=0,QAMCTXT="" K QAMUNDL S $P(QAMUNDL,"=",81)="" U IO
7 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
8EXIT ;
9 W ! D ^%ZISC
10XIT 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")
11 S:$D(ZTQUEUED) ZTREQ="@"
12 Q
13LOOP ;
14 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")
15 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)=""
16 S QAMPAGE=1 D HEAD W !,"CONDITION: ",QAMCOND,?44,"AUTO ENROLL: ",QAMAUTO,!!,"DESCRIPTION:"
17 S QAMFOUND=0,DIWL=6,DIWR=75,DIWF="W" K ^UTILITY($J,"W")
18 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))
19 I 'QAMFOUND S X="Sorry, no description found for this condition." D ^DIWP,PAUSE
20 Q:QAMQUIT D ^DIWW,PAUSE Q:QAMQUIT
21 W !,"DATA ELEMENTS:" D PAUSE Q:QAMQUIT
22 S QAMELEM="" F S QAMELEM=$O(^UTILITY($J,"QAMPINQ4",QAMELEM)) Q:QAMELEM=""!QAMQUIT W !?5,QAMELEM D:$O(^UTILITY($J,"QAMPINQ4",QAMELEM))]"" PAUSE
23 I 'QAMQUIT W !!,QAMUNDL D WAIT
24 Q
25PAUSE Q:$Y'>(IOSL-4) D WAIT,HEAD:'QAMQUIT
26 Q
27HEAD W:(QAMPAGE>1)!($E(IOST)="C") @IOF,!,QAMUNDL,! S QAMPAGE=QAMPAGE+1
28 Q
29WAIT I $E(IOST)="C" K DIR S DIR(0)="E" D ^DIR S QAMQUIT=$S(Y'>0:1,1:0)
30 Q
Note: See TracBrowser for help on using the repository browser.