| [613] | 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
 | 
|---|