source: WorldVistAEHR/trunk/r/PATIENT_REPRESENTATIVE-QAC/QACALRT2.m@ 1096

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

initial load of WorldVistAEHR

File size: 1.8 KB
RevLine 
[613]1QACALRT2 ;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
18EXIT ;
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 ;
23ALERT ;
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
33HELP ;
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
Note: See TracBrowser for help on using the repository browser.