DVBAUTL6.m

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 ---DVBAUTL6   1324     printed  Feb 18, 2025@23:08:44                                                                                                                                                                                                    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       ;