source: FOIAVistA/trunk/r/AUTOMATED_MED_INFO_EXCHANGE-DVBA-DVBC/DVBALD.m@ 813

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
 ;