source: WorldVistAEHR/trunk/r/AUTOMATED_MED_INFO_EXCHANGE-DVBA-DVBC/DVBAUTL8.m@ 1093

Last change on this file since 1093 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.2 KB
RevLine 
[613]1DVBAUTL8 ;ALB/GTS-AMIE 7131 UTILITIES ;8 DEC 94
2 ;;2.7;AMIE;**5**;Apr 10, 1995
3 ;
4NEWCHK ;** 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 ;
24CLRCHK ;** 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 ;
43ASIHALRT ;**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
Note: See TracBrowser for help on using the repository browser.