DVBAUTL6 ;ALB/JLU;UTILITY ROUTINE;9/15/94
;;2.7;AMIE;;Apr 10, 1995
;
DSCIFN(A) ;returns the IFN of the discarge type in A. from file 405.2
;
N DIC,X
S DIC="^DG(405.2,",DIC(0)="XMZ"
S X=A
D ^DIC
Q +Y
;
DSCTIEN(A) ;returns the IEN of the discharge type in file 405.3
N DIC,X
S DIC="^DG(405.3,",DIC(0)="XMZ"
S X=A
D ^DIC
Q +Y
;
CHECK(A) ;used in the lookup screen of the discharge report to check for
;active facility movement types for the particular MAS movement types.
;A is the MAS movement type
;
N DVBA,DVBFOUND
S DVBA=""
F S DVBA=$O(^DG(405.1,"AM",A,DVBA)) Q:'DVBA!($D(DVBFOUND)) DO
.I '$D(^DG(405.1,DVBA,0)) Q
.I $P(^DG(405.1,DVBA,0),U,4)=1 S DVBFOUND=1
.Q
I $D(DVBFOUND) Q 1
E Q 0
;
LOCK(Y) ;locks the record.
;called by dvbaren1, dvbarl21, dvbareg1
L +^DVB(396,+Y):2
I '$T DO Q 0
.S VAR(1,0)="1,0,0,2,0^Record is currently in use!"
.D WR^DVBAUTL4("VAR")
.K VAR
.D PAUSE^DVBCUTL4
Q 1
;
UNLOCK(Y) ;unlocks the global
;called by dvbaren1, dvbarl21, dvbareg1
L -^DVB(396,+Y)
Q
;
ERR(A) ;displays an error message to the user called from DVBAREG1
N VAR
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:".")
D WR^DVBAUTL4("VAR")
K VAR
D CONTMES^DVBCUTL4
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBAUTL6 1324 printed Dec 13, 2024@01:42:21 Page 2
DVBAUTL6 ;ALB/JLU;UTILITY ROUTINE;9/15/94
+1 ;;2.7;AMIE;;Apr 10, 1995
+2 ;
DSCIFN(A) ;returns the IFN of the discarge type in A. from file 405.2
+1 ;
+2 NEW DIC,X
+3 SET DIC="^DG(405.2,"
SET DIC(0)="XMZ"
+4 SET X=A
+5 DO ^DIC
+6 QUIT +Y
+7 ;
DSCTIEN(A) ;returns the IEN of the discharge type in file 405.3
+1 NEW DIC,X
+2 SET DIC="^DG(405.3,"
SET DIC(0)="XMZ"
+3 SET X=A
+4 DO ^DIC
+5 QUIT +Y
+6 ;
CHECK(A) ;used in the lookup screen of the discharge report to check for
+1 ;active facility movement types for the particular MAS movement types.
+2 ;A is the MAS movement type
+3 ;
+4 NEW DVBA,DVBFOUND
+5 SET DVBA=""
+6 FOR
SET DVBA=$ORDER(^DG(405.1,"AM",A,DVBA))
if 'DVBA!($DATA(DVBFOUND))
QUIT
Begin DoDot:1
+7 IF '$DATA(^DG(405.1,DVBA,0))
QUIT
+8 IF $PIECE(^DG(405.1,DVBA,0),U,4)=1
SET DVBFOUND=1
+9 QUIT
End DoDot:1
+10 IF $DATA(DVBFOUND)
QUIT 1
+11 IF '$TEST
QUIT 0
+12 ;
LOCK(Y) ;locks the record.
+1 ;called by dvbaren1, dvbarl21, dvbareg1
+2 LOCK +^DVB(396,+Y):2
+3 IF '$TEST
Begin DoDot:1
+4 SET VAR(1,0)="1,0,0,2,0^Record is currently in use!"
+5 DO WR^DVBAUTL4("VAR")
+6 KILL VAR
+7 DO PAUSE^DVBCUTL4
End DoDot:1
QUIT 0
+8 QUIT 1
+9 ;
UNLOCK(Y) ;unlocks the global
+1 ;called by dvbaren1, dvbarl21, dvbareg1
+2 LOCK -^DVB(396,+Y)
+3 QUIT
+4 ;
ERR(A) ;displays an error message to the user called from DVBAREG1
+1 NEW VAR
+2 SET VAR(1,0)="1,0,0,2:2,0^There is no Admission or Non Admission information"_$SELECT(A>0:" for this date range!",1:".")
+3 DO WR^DVBAUTL4("VAR")
+4 KILL VAR
+5 DO CONTMES^DVBCUTL4
+6 QUIT
+7 ;
