| [613] | 1 | DVBAUTL8 ;ALB/GTS-AMIE 7131 UTILITIES ;8 DEC 94
 | 
|---|
 | 2 |  ;;2.7;AMIE;**5**;Apr 10, 1995
 | 
|---|
 | 3 |  ;
 | 
|---|
 | 4 | NEWCHK ;** Check for the addition of a report to 7131
 | 
|---|
 | 5 |  ;**  This tag is called from DIVUPDT^DVBAUTL2.  It checks for a new
 | 
|---|
 | 6 |  ;**   report division and sets up the DR string if the reports Division
 | 
|---|
 | 7 |  ;**   and Transfer Date fields need to be updated.  NEWCHK is called if
 | 
|---|
 | 8 |  ;**   the report array status piece has a status of 'P' (Pending)
 | 
|---|
 | 9 |  ;
 | 
|---|
 | 10 |  I $D(DVBANEW) D SETDR^DVBAUTL7 ;**New 7131 - update Div/Tran Dte flds
 | 
|---|
 | 11 |  I '$D(DVBANEW) DO  ;**Edit 7131 - If report added, update Div/Tran Dte
 | 
|---|
 | 12 |  .I LPPCE=1,($P(NODE6,U,9)="") D SETDR^DVBAUTL7
 | 
|---|
 | 13 |  .I LPPCE=2,($P(NODE6,U,11)="") D SETDR^DVBAUTL7
 | 
|---|
 | 14 |  .I LPPCE=3,($P(NODE6,U,13)="") D SETDR^DVBAUTL7
 | 
|---|
 | 15 |  .I LPPCE=4,($P(NODE6,U,15)="") D SETDR^DVBAUTL7
 | 
|---|
 | 16 |  .I LPPCE=5,($P(NODE6,U,17)="") D SETDR^DVBAUTL7
 | 
|---|
 | 17 |  .I LPPCE=6,($P(NODE6,U,19)="") D SETDR^DVBAUTL7
 | 
|---|
 | 18 |  .I LPPCE=7,($P(NODE6,U,21)="") D SETDR^DVBAUTL7
 | 
|---|
 | 19 |  .I LPPCE=8,($P(NODE6,U,23)="") D SETDR^DVBAUTL7
 | 
|---|
 | 20 |  .I LPPCE=9,($P(NODE6,U,7)="") D SETDR^DVBAUTL7
 | 
|---|
 | 21 |  .I LPPCE=10,($P(NODE6,U,28)="") D SETDR^DVBAUTL7
 | 
|---|
 | 22 |  Q
 | 
|---|
 | 23 |  ;
 | 
|---|
 | 24 | CLRCHK ;** Edit 7131 - Check for deselection of report
 | 
|---|
 | 25 |  ;**  This tag is called from DIVUPDT^DVBAUTL2.  It checks for the
 | 
|---|
 | 26 |  ;**   deselection of a report on a previously entered 7131.  If a
 | 
|---|
 | 27 |  ;**   report has been deselected, the Division and Tran Date fields
 | 
|---|
 | 28 |  ;**   are cleared.
 | 
|---|
 | 29 |  ;
 | 
|---|
 | 30 |  I '$D(DVBANEW) DO
 | 
|---|
 | 31 |  .I LPPCE=1,($P(NODE6,U,9)'="") D CLEARDR^DVBAUTL7
 | 
|---|
 | 32 |  .I LPPCE=2,($P(NODE6,U,11)'="") D CLEARDR^DVBAUTL7
 | 
|---|
 | 33 |  .I LPPCE=3,($P(NODE6,U,13)'="") D CLEARDR^DVBAUTL7
 | 
|---|
 | 34 |  .I LPPCE=4,($P(NODE6,U,15)'="") D CLEARDR^DVBAUTL7
 | 
|---|
 | 35 |  .I LPPCE=5,($P(NODE6,U,17)'="") D CLEARDR^DVBAUTL7
 | 
|---|
 | 36 |  .I LPPCE=6,($P(NODE6,U,19)'="") D CLEARDR^DVBAUTL7
 | 
|---|
 | 37 |  .I LPPCE=7,($P(NODE6,U,21)'="") D CLEARDR^DVBAUTL7
 | 
|---|
 | 38 |  .I LPPCE=8,($P(NODE6,U,23)'="") D CLEARDR^DVBAUTL7
 | 
|---|
 | 39 |  .I LPPCE=9,($P(NODE6,U,7)'="") D CLEARDR^DVBAUTL7
 | 
|---|
 | 40 |  .I LPPCE=10,($P(NODE6,U,28)'="") D CLEARDR^DVBAUTL7
 | 
|---|
 | 41 |  Q
 | 
|---|
 | 42 |  ;
 | 
|---|
 | 43 | ASIHALRT ;**Warn user of ASIH admission
 | 
|---|
 | 44 |  S VAR(1,0)="1,0,0,2,0^The admission you selected is an ASIH admission."
 | 
|---|
 | 45 |  S VAR(2,0)="0,0,0,1,0^This means the veteran was admitted from a Nursing"
 | 
|---|
 | 46 |  S VAR(3,0)="0,0,0,1,0^ Home or Domiciliary.  It is suggested that you"
 | 
|---|
 | 47 |  S VAR(4,0)="0,0,0,1,0^ review the veteran's claim folder before requesting"
 | 
|---|
 | 48 |  S VAR(5,0)="0,0,0,1:1,0^ a 7131."
 | 
|---|
 | 49 |  D WR^DVBAUTL4("VAR")
 | 
|---|
 | 50 |  K VAR
 | 
|---|
 | 51 |  Q
 | 
|---|