| 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
|
|---|
