DVBAUTL8 ;ALB/GTS-AMIE 7131 UTILITIES ;8 DEC 94
;;2.7;AMIE;**5**;Apr 10, 1995
;
NEWCHK ;** Check for the addition of a report to 7131
;** This tag is called from DIVUPDT^DVBAUTL2. It checks for a new
;** report division and sets up the DR string if the reports Division
;** and Transfer Date fields need to be updated. NEWCHK is called if
;** the report array status piece has a status of 'P' (Pending)
;
I $D(DVBANEW) D SETDR^DVBAUTL7 ;**New 7131 - update Div/Tran Dte flds
I '$D(DVBANEW) DO ;**Edit 7131 - If report added, update Div/Tran Dte
.I LPPCE=1,($P(NODE6,U,9)="") D SETDR^DVBAUTL7
.I LPPCE=2,($P(NODE6,U,11)="") D SETDR^DVBAUTL7
.I LPPCE=3,($P(NODE6,U,13)="") D SETDR^DVBAUTL7
.I LPPCE=4,($P(NODE6,U,15)="") D SETDR^DVBAUTL7
.I LPPCE=5,($P(NODE6,U,17)="") D SETDR^DVBAUTL7
.I LPPCE=6,($P(NODE6,U,19)="") D SETDR^DVBAUTL7
.I LPPCE=7,($P(NODE6,U,21)="") D SETDR^DVBAUTL7
.I LPPCE=8,($P(NODE6,U,23)="") D SETDR^DVBAUTL7
.I LPPCE=9,($P(NODE6,U,7)="") D SETDR^DVBAUTL7
.I LPPCE=10,($P(NODE6,U,28)="") D SETDR^DVBAUTL7
Q
;
CLRCHK ;** Edit 7131 - Check for deselection of report
;** This tag is called from DIVUPDT^DVBAUTL2. It checks for the
;** deselection of a report on a previously entered 7131. If a
;** report has been deselected, the Division and Tran Date fields
;** are cleared.
;
I '$D(DVBANEW) DO
.I LPPCE=1,($P(NODE6,U,9)'="") D CLEARDR^DVBAUTL7
.I LPPCE=2,($P(NODE6,U,11)'="") D CLEARDR^DVBAUTL7
.I LPPCE=3,($P(NODE6,U,13)'="") D CLEARDR^DVBAUTL7
.I LPPCE=4,($P(NODE6,U,15)'="") D CLEARDR^DVBAUTL7
.I LPPCE=5,($P(NODE6,U,17)'="") D CLEARDR^DVBAUTL7
.I LPPCE=6,($P(NODE6,U,19)'="") D CLEARDR^DVBAUTL7
.I LPPCE=7,($P(NODE6,U,21)'="") D CLEARDR^DVBAUTL7
.I LPPCE=8,($P(NODE6,U,23)'="") D CLEARDR^DVBAUTL7
.I LPPCE=9,($P(NODE6,U,7)'="") D CLEARDR^DVBAUTL7
.I LPPCE=10,($P(NODE6,U,28)'="") D CLEARDR^DVBAUTL7
Q
;
ASIHALRT ;**Warn user of ASIH admission
S VAR(1,0)="1,0,0,2,0^The admission you selected is an ASIH admission."
S VAR(2,0)="0,0,0,1,0^This means the veteran was admitted from a Nursing"
S VAR(3,0)="0,0,0,1,0^ Home or Domiciliary. It is suggested that you"
S VAR(4,0)="0,0,0,1,0^ review the veteran's claim folder before requesting"
S VAR(5,0)="0,0,0,1:1,0^ a 7131."
D WR^DVBAUTL4("VAR")
K VAR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBAUTL8 2339 printed Oct 16, 2024@17:43:15 Page 2
DVBAUTL8 ;ALB/GTS-AMIE 7131 UTILITIES ;8 DEC 94
+1 ;;2.7;AMIE;**5**;Apr 10, 1995
+2 ;
NEWCHK ;** Check for the addition of a report to 7131
+1 ;** This tag is called from DIVUPDT^DVBAUTL2. It checks for a new
+2 ;** report division and sets up the DR string if the reports Division
+3 ;** and Transfer Date fields need to be updated. NEWCHK is called if
+4 ;** the report array status piece has a status of 'P' (Pending)
+5 ;
+6 ;**New 7131 - update Div/Tran Dte flds
IF $DATA(DVBANEW)
DO SETDR^DVBAUTL7
+7 ;**Edit 7131 - If report added, update Div/Tran Dte
IF '$DATA(DVBANEW)
Begin DoDot:1
+8 IF LPPCE=1
IF ($PIECE(NODE6,U,9)="")
DO SETDR^DVBAUTL7
+9 IF LPPCE=2
IF ($PIECE(NODE6,U,11)="")
DO SETDR^DVBAUTL7
+10 IF LPPCE=3
IF ($PIECE(NODE6,U,13)="")
DO SETDR^DVBAUTL7
+11 IF LPPCE=4
IF ($PIECE(NODE6,U,15)="")
DO SETDR^DVBAUTL7
+12 IF LPPCE=5
IF ($PIECE(NODE6,U,17)="")
DO SETDR^DVBAUTL7
+13 IF LPPCE=6
IF ($PIECE(NODE6,U,19)="")
DO SETDR^DVBAUTL7
+14 IF LPPCE=7
IF ($PIECE(NODE6,U,21)="")
DO SETDR^DVBAUTL7
+15 IF LPPCE=8
IF ($PIECE(NODE6,U,23)="")
DO SETDR^DVBAUTL7
+16 IF LPPCE=9
IF ($PIECE(NODE6,U,7)="")
DO SETDR^DVBAUTL7
+17 IF LPPCE=10
IF ($PIECE(NODE6,U,28)="")
DO SETDR^DVBAUTL7
End DoDot:1
+18 QUIT
+19 ;
CLRCHK ;** Edit 7131 - Check for deselection of report
+1 ;** This tag is called from DIVUPDT^DVBAUTL2. It checks for the
+2 ;** deselection of a report on a previously entered 7131. If a
+3 ;** report has been deselected, the Division and Tran Date fields
+4 ;** are cleared.
+5 ;
+6 IF '$DATA(DVBANEW)
Begin DoDot:1
+7 IF LPPCE=1
IF ($PIECE(NODE6,U,9)'="")
DO CLEARDR^DVBAUTL7
+8 IF LPPCE=2
IF ($PIECE(NODE6,U,11)'="")
DO CLEARDR^DVBAUTL7
+9 IF LPPCE=3
IF ($PIECE(NODE6,U,13)'="")
DO CLEARDR^DVBAUTL7
+10 IF LPPCE=4
IF ($PIECE(NODE6,U,15)'="")
DO CLEARDR^DVBAUTL7
+11 IF LPPCE=5
IF ($PIECE(NODE6,U,17)'="")
DO CLEARDR^DVBAUTL7
+12 IF LPPCE=6
IF ($PIECE(NODE6,U,19)'="")
DO CLEARDR^DVBAUTL7
+13 IF LPPCE=7
IF ($PIECE(NODE6,U,21)'="")
DO CLEARDR^DVBAUTL7
+14 IF LPPCE=8
IF ($PIECE(NODE6,U,23)'="")
DO CLEARDR^DVBAUTL7
+15 IF LPPCE=9
IF ($PIECE(NODE6,U,7)'="")
DO CLEARDR^DVBAUTL7
+16 IF LPPCE=10
IF ($PIECE(NODE6,U,28)'="")
DO CLEARDR^DVBAUTL7
End DoDot:1
+17 QUIT
+18 ;
ASIHALRT ;**Warn user of ASIH admission
+1 SET VAR(1,0)="1,0,0,2,0^The admission you selected is an ASIH admission."
+2 SET VAR(2,0)="0,0,0,1,0^This means the veteran was admitted from a Nursing"
+3 SET VAR(3,0)="0,0,0,1,0^ Home or Domiciliary. It is suggested that you"
+4 SET VAR(4,0)="0,0,0,1,0^ review the veteran's claim folder before requesting"
+5 SET VAR(5,0)="0,0,0,1:1,0^ a 7131."
+6 DO WR^DVBAUTL4("VAR")
+7 KILL VAR
+8 QUIT
