source: WorldVistAEHR/trunk/r/AUTOMATED_MED_INFO_EXCHANGE-DVBA-DVBC/DVBALD.m@ 1789

Last change on this file since 1789 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.7 KB
RevLine 
[613]1DVBALD ;ALB/JLU;List Man created routine ; 01-AUG-1994
2 ;;2.7;AMIE;;Apr 10, 1995
3EN ; -- main entry point for DVBA DISCHARGE TYPES
4 D EN^VALM("DVBA DISCHARGE TYPES")
5 Q
6 ;
7HDR ; -- header code
8 S VALMHDR(1)="This is a list of the default discharge types."
9 S VALMHDR(2)="Some of these types may not be active at this site."
10 Q
11 ;
12INIT ; -- init variables and list array
13 N DVBX,DVBY
14 K ^TMP("AMIE",$J),^TMP("DVBA",$J)
15 S VALMCNT=0
16 F DVBX=1:1 S DVBY=$T(TEXT+DVBX) S DVBY=$P(DVBY,";;",2) Q:DVBY="END" D SETARAY^DVBALD1(DVBY)
17 Q
18 ;
19TEXT ;these are the default discharge types
20 ;;10^TRANSFER OUT
21 ;;18^READMISSION TO NHCU/DOMICILIARY
22 ;;31^TO NHCU FROM HOSP
23 ;;32^TO DOM FROM HOSP
24 ;;33^TO NHCU FROM DOM
25 ;;34^DISCHARGE TO CNH
26 ;;35^VA NHCU TO CNH
27 ;;40^TO ASIH
28 ;;41^FROM ASIH
29 ;;43^TO ASIH (OTHER FACILITY)
30 ;;END
31 ;
32HELP ; -- help code
33 S X="?" D DISP^XQORM1 W !!
34 Q
35 ;
36EXIT ; -- exit code
37 D CLEAR^VALM1
38 K ^TMP("AMIE",$J),DVBAQUIT,VALMCK,VALMNOD
39 Q
40 ;
41EXPND ; -- expand code
42 Q
43 ;
44ADD ;this is the code for the ADD action in the discharge List Man
45 D FULL^VALM1
46 D ADD^DVBALD1("AD")
47 S VALMBCK="R"
48 Q
49 ;
50DELETE ;this is the code for the DELETE action in the discharge List Man
51 D FULL^VALM1
52 D DELETE^DVBALD1
53 S VALMBCK="R"
54 Q
55 ;
56CREATE ;this is the code for the CREATE action in the discharge List Man
57 D FULL^VALM1
58 K ^TMP("AMIE",$J),^TMP("DVBA",$J)
59 S VALMCNT=0
60 D ADD^DVBALD1("CL")
61 I '$D(@VALMAR@(1)) DO
62 .S VAR(1,0)="0,0,0,2,0^No new discharge types were selected."
63 .S VAR(2,0)="0,0,0,1,0^I will go back to the default list."
64 .D WR^DVBAUTL4("VAR")
65 .K VAR
66 .D PAUSE^VALM1
67 .D INIT
68 .Q
69 S VALMBCK="R"
70 Q
71 ;
72ACCEPT ;this line tag is for the acceptance of the discharge list.
73 S DVBACEPT=1
74 S VALMCK="Q"
75 Q
76 ;
Note: See TracBrowser for help on using the repository browser.