1 | QACALRT2 ;HISC/DAD-RESEND/KILL ALERT ;7/12/95 15:20
|
---|
2 | ;;2.0;Patient Representative;**9**;07/25/1995
|
---|
3 | ;
|
---|
4 | F D Q:QACD0'>0
|
---|
5 | . K DIC S DIC="^QA(745.1,",DIC(0)="AEMNQZ"
|
---|
6 | . S DIC("A")="Select CONTACT NUMBER: "
|
---|
7 | . S DIC("S")="I ($P(^QA(745.1,+Y,7),""^"",2)=""O""),(($D(^XUSEC(""QAC EDIT"",DUZ))#2)!(DUZ=$P(^QA(745.1,+Y,0),U,7)))"
|
---|
8 | . W ! D ^DIC S QACD0=+Y
|
---|
9 | . I QACD0'>0 Q
|
---|
10 | . F D Q:QACVA200'>0
|
---|
11 | .. K DIR S DIR(0)="POA^200:AEMNQZ",DIR("A")="Select REFER CONTACT TO: "
|
---|
12 | .. S DIR("?")="^D HELP^QACALRT2"
|
---|
13 | .. W ! D ^DIR S QACVA200=+$G(Y),QACVA200(0)=$G(Y(0,0))
|
---|
14 | .. I $D(DIRUT) Q
|
---|
15 | .. D ALERT
|
---|
16 | .. Q
|
---|
17 | . Q
|
---|
18 | EXIT ;
|
---|
19 | K D0,D1,DA,DD,DIC,DIK,DINUM,DIR,DIRUT,DLAYGO,DO,DTOUT,DUOUT,QACACTN
|
---|
20 | K QACD0,QACD1,QACLINE,QACQUIT,QACREMOV,QACVA200,X,Y
|
---|
21 | Q
|
---|
22 | ;
|
---|
23 | ALERT ;
|
---|
24 | K DIR S DIR(0)="SOM^S:Send alert;K:Kill alert;"
|
---|
25 | S DIR("A")="Alert action"
|
---|
26 | S DIR("?",1)=" Enter (S)end to generate a new alert."
|
---|
27 | S DIR("?",2)=" Enter (K)ill to kill a pre-existing alert."
|
---|
28 | S DIR("?")=" Enter a code from the list above."
|
---|
29 | W ! D ^DIR S QACACTN=$G(Y)
|
---|
30 | I $D(DIRUT) Q
|
---|
31 | I QACACTN="S" D SET^QACALRT0(QACVA200,QACD0) Q
|
---|
32 | I QACACTN="K" D KILL^QACALRT0(QACVA200,QACD0) Q
|
---|
33 | HELP ;
|
---|
34 | W !!,"Entries in the REFER CONTACT TO field:"
|
---|
35 | I $O(^QA(745.1,QACD0,11,0))'>0 W !?3,"None" Q
|
---|
36 | S QACD1=0 K ^TMP("QACALRT2",$J)
|
---|
37 | F S QACD1=$O(^QA(745.1,QACD0,11,QACD1)) Q:QACD1'>0 D
|
---|
38 | . S QACVA200=+$P($G(^QA(745.1,QACD0,11,QACD1,0)),U)
|
---|
39 | . S QACVA200(0)=$P($G(^VA(200,QACVA200,0)),U)
|
---|
40 | . I QACVA200(0)]"" S ^TMP("QACALRT2",$J,QACVA200)=QACVA200(0)
|
---|
41 | . Q
|
---|
42 | S (QACVA200,QACQUIT)=0,QACLINE=$Y
|
---|
43 | F S QACVA200=$O(^TMP("QACALRT2",$J,QACVA200)) Q:QACVA200'>0!QACQUIT D
|
---|
44 | . W !?3,QACVA200,?19,^TMP("QACALRT2",$J,QACVA200)
|
---|
45 | . I $Y>(IOSL+QACLINE-3) D
|
---|
46 | .. W !,"Press RETURN to continue or '^' to exit: "
|
---|
47 | .. R QACQUIT:DTIME S:'$T QACQUIT=U S QACQUIT=$S($E(QACQUIT)=U:1,1:0)
|
---|
48 | .. S QACLINE=$Y
|
---|
49 | .. Q
|
---|
50 | . Q
|
---|
51 | K ^TMP("QACALRT2",$J)
|
---|
52 | Q
|
---|