- 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 Jan 18, 2025@02:43:37 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