| 1 | DVBAUTL6 ;ALB/JLU;UTILITY ROUTINE;9/15/94
 | 
|---|
| 2 |  ;;2.7;AMIE;;Apr 10, 1995
 | 
|---|
| 3 |  ;
 | 
|---|
| 4 | DSCIFN(A) ;returns the IFN of the discarge type in A. from file 405.2
 | 
|---|
| 5 |  ;
 | 
|---|
| 6 |  N DIC,X
 | 
|---|
| 7 |  S DIC="^DG(405.2,",DIC(0)="XMZ"
 | 
|---|
| 8 |  S X=A
 | 
|---|
| 9 |  D ^DIC
 | 
|---|
| 10 |  Q +Y
 | 
|---|
| 11 |  ;
 | 
|---|
| 12 | DSCTIEN(A) ;returns the IEN of the discharge type in file 405.3
 | 
|---|
| 13 |  N DIC,X
 | 
|---|
| 14 |  S DIC="^DG(405.3,",DIC(0)="XMZ"
 | 
|---|
| 15 |  S X=A
 | 
|---|
| 16 |  D ^DIC
 | 
|---|
| 17 |  Q +Y
 | 
|---|
| 18 |  ;
 | 
|---|
| 19 | CHECK(A) ;used in the lookup screen of the discharge report to check for
 | 
|---|
| 20 |  ;active facility movement types for the particular MAS movement types.
 | 
|---|
| 21 |  ;A is the MAS movement type
 | 
|---|
| 22 |  ;
 | 
|---|
| 23 |  N DVBA,DVBFOUND
 | 
|---|
| 24 |  S DVBA=""
 | 
|---|
| 25 |  F  S DVBA=$O(^DG(405.1,"AM",A,DVBA)) Q:'DVBA!($D(DVBFOUND))  DO
 | 
|---|
| 26 |  .I '$D(^DG(405.1,DVBA,0)) Q
 | 
|---|
| 27 |  .I $P(^DG(405.1,DVBA,0),U,4)=1 S DVBFOUND=1
 | 
|---|
| 28 |  .Q
 | 
|---|
| 29 |  I $D(DVBFOUND) Q 1
 | 
|---|
| 30 |  E  Q 0
 | 
|---|
| 31 |  ;
 | 
|---|
| 32 | LOCK(Y) ;locks the record.
 | 
|---|
| 33 |  ;called by dvbaren1, dvbarl21, dvbareg1
 | 
|---|
| 34 |  L +^DVB(396,+Y):2
 | 
|---|
| 35 |  I '$T DO  Q 0
 | 
|---|
| 36 |  .S VAR(1,0)="1,0,0,2,0^Record is currently in use!"
 | 
|---|
| 37 |  .D WR^DVBAUTL4("VAR")
 | 
|---|
| 38 |  .K VAR
 | 
|---|
| 39 |  .D PAUSE^DVBCUTL4
 | 
|---|
| 40 |  Q 1
 | 
|---|
| 41 |  ;
 | 
|---|
| 42 | UNLOCK(Y) ;unlocks the global
 | 
|---|
| 43 |  ;called by dvbaren1, dvbarl21, dvbareg1
 | 
|---|
| 44 |  L -^DVB(396,+Y)
 | 
|---|
| 45 |  Q
 | 
|---|
| 46 |  ;
 | 
|---|
| 47 | ERR(A) ;displays an error message to the user called from DVBAREG1
 | 
|---|
| 48 |  N VAR
 | 
|---|
| 49 |  S VAR(1,0)="1,0,0,2:2,0^There is no Admission or Non Admission information"_$S(A>0:" for this date range!",1:".")
 | 
|---|
| 50 |  D WR^DVBAUTL4("VAR")
 | 
|---|
| 51 |  K VAR
 | 
|---|
| 52 |  D CONTMES^DVBCUTL4
 | 
|---|
| 53 |  Q
 | 
|---|
| 54 |  ;
 | 
|---|