DVBALD ;ALB/JLU;List Man created routine ; 01-AUG-1994
;;2.7;AMIE;;Apr 10, 1995
EN ; -- main entry point for DVBA DISCHARGE TYPES
D EN^VALM("DVBA DISCHARGE TYPES")
Q
;
HDR ; -- header code
S VALMHDR(1)="This is a list of the default discharge types."
S VALMHDR(2)="Some of these types may not be active at this site."
Q
;
INIT ; -- init variables and list array
N DVBX,DVBY
K ^TMP("AMIE",$J),^TMP("DVBA",$J)
S VALMCNT=0
F DVBX=1:1 S DVBY=$T(TEXT+DVBX) S DVBY=$P(DVBY,";;",2) Q:DVBY="END" D SETARAY^DVBALD1(DVBY)
Q
;
TEXT ;these are the default discharge types
;;10^TRANSFER OUT
;;18^READMISSION TO NHCU/DOMICILIARY
;;31^TO NHCU FROM HOSP
;;32^TO DOM FROM HOSP
;;33^TO NHCU FROM DOM
;;34^DISCHARGE TO CNH
;;35^VA NHCU TO CNH
;;40^TO ASIH
;;41^FROM ASIH
;;43^TO ASIH (OTHER FACILITY)
;;END
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
D CLEAR^VALM1
K ^TMP("AMIE",$J),DVBAQUIT,VALMCK,VALMNOD
Q
;
EXPND ; -- expand code
Q
;
ADD ;this is the code for the ADD action in the discharge List Man
D FULL^VALM1
D ADD^DVBALD1("AD")
S VALMBCK="R"
Q
;
DELETE ;this is the code for the DELETE action in the discharge List Man
D FULL^VALM1
D DELETE^DVBALD1
S VALMBCK="R"
Q
;
CREATE ;this is the code for the CREATE action in the discharge List Man
D FULL^VALM1
K ^TMP("AMIE",$J),^TMP("DVBA",$J)
S VALMCNT=0
D ADD^DVBALD1("CL")
I '$D(@VALMAR@(1)) DO
.S VAR(1,0)="0,0,0,2,0^No new discharge types were selected."
.S VAR(2,0)="0,0,0,1,0^I will go back to the default list."
.D WR^DVBAUTL4("VAR")
.K VAR
.D PAUSE^VALM1
.D INIT
.Q
S VALMBCK="R"
Q
;
ACCEPT ;this line tag is for the acceptance of the discharge list.
S DVBACEPT=1
S VALMCK="Q"
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBALD 1794 printed Dec 13, 2024@01:41:17 Page 2
DVBALD ;ALB/JLU;List Man created routine ; 01-AUG-1994
+1 ;;2.7;AMIE;;Apr 10, 1995
EN ; -- main entry point for DVBA DISCHARGE TYPES
+1 DO EN^VALM("DVBA DISCHARGE TYPES")
+2 QUIT
+3 ;
HDR ; -- header code
+1 SET VALMHDR(1)="This is a list of the default discharge types."
+2 SET VALMHDR(2)="Some of these types may not be active at this site."
+3 QUIT
+4 ;
INIT ; -- init variables and list array
+1 NEW DVBX,DVBY
+2 KILL ^TMP("AMIE",$JOB),^TMP("DVBA",$JOB)
+3 SET VALMCNT=0
+4 FOR DVBX=1:1
SET DVBY=$TEXT(TEXT+DVBX)
SET DVBY=$PIECE(DVBY,";;",2)
if DVBY="END"
QUIT
DO SETARAY^DVBALD1(DVBY)
+5 QUIT
+6 ;
TEXT ;these are the default discharge types
+1 ;;10^TRANSFER OUT
+2 ;;18^READMISSION TO NHCU/DOMICILIARY
+3 ;;31^TO NHCU FROM HOSP
+4 ;;32^TO DOM FROM HOSP
+5 ;;33^TO NHCU FROM DOM
+6 ;;34^DISCHARGE TO CNH
+7 ;;35^VA NHCU TO CNH
+8 ;;40^TO ASIH
+9 ;;41^FROM ASIH
+10 ;;43^TO ASIH (OTHER FACILITY)
+11 ;;END
+12 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 DO CLEAR^VALM1
+2 KILL ^TMP("AMIE",$JOB),DVBAQUIT,VALMCK,VALMNOD
+3 QUIT
+4 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
ADD ;this is the code for the ADD action in the discharge List Man
+1 DO FULL^VALM1
+2 DO ADD^DVBALD1("AD")
+3 SET VALMBCK="R"
+4 QUIT
+5 ;
DELETE ;this is the code for the DELETE action in the discharge List Man
+1 DO FULL^VALM1
+2 DO DELETE^DVBALD1
+3 SET VALMBCK="R"
+4 QUIT
+5 ;
CREATE ;this is the code for the CREATE action in the discharge List Man
+1 DO FULL^VALM1
+2 KILL ^TMP("AMIE",$JOB),^TMP("DVBA",$JOB)
+3 SET VALMCNT=0
+4 DO ADD^DVBALD1("CL")
+5 IF '$DATA(@VALMAR@(1))
Begin DoDot:1
+6 SET VAR(1,0)="0,0,0,2,0^No new discharge types were selected."
+7 SET VAR(2,0)="0,0,0,1,0^I will go back to the default list."
+8 DO WR^DVBAUTL4("VAR")
+9 KILL VAR
+10 DO PAUSE^VALM1
+11 DO INIT
+12 QUIT
End DoDot:1
+13 SET VALMBCK="R"
+14 QUIT
+15 ;
ACCEPT ;this line tag is for the acceptance of the discharge list.
+1 SET DVBACEPT=1
+2 SET VALMCK="Q"
+3 QUIT
+4 ;
