| 1 | DVBALD ;ALB/JLU;List Man created routine ; 01-AUG-1994
 | 
|---|
| 2 |  ;;2.7;AMIE;;Apr 10, 1995
 | 
|---|
| 3 | EN ; -- main entry point for DVBA DISCHARGE TYPES
 | 
|---|
| 4 |  D EN^VALM("DVBA DISCHARGE TYPES")
 | 
|---|
| 5 |  Q
 | 
|---|
| 6 |  ;
 | 
|---|
| 7 | HDR ; -- 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 |  ;
 | 
|---|
| 12 | INIT ; -- 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 |  ;
 | 
|---|
| 19 | TEXT ;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 |  ;
 | 
|---|
| 32 | HELP ; -- help code
 | 
|---|
| 33 |  S X="?" D DISP^XQORM1 W !!
 | 
|---|
| 34 |  Q
 | 
|---|
| 35 |  ;
 | 
|---|
| 36 | EXIT ; -- exit code
 | 
|---|
| 37 |  D CLEAR^VALM1
 | 
|---|
| 38 |  K ^TMP("AMIE",$J),DVBAQUIT,VALMCK,VALMNOD
 | 
|---|
| 39 |  Q
 | 
|---|
| 40 |  ;
 | 
|---|
| 41 | EXPND ; -- expand code
 | 
|---|
| 42 |  Q
 | 
|---|
| 43 |  ;
 | 
|---|
| 44 | ADD ;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 |  ;
 | 
|---|
| 50 | DELETE ;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 |  ;
 | 
|---|
| 56 | CREATE ;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 |  ;
 | 
|---|
| 72 | ACCEPT ;this line tag is for the acceptance of the discharge list.
 | 
|---|
| 73 |  S DVBACEPT=1
 | 
|---|
| 74 |  S VALMCK="Q"
 | 
|---|
| 75 |  Q
 | 
|---|
| 76 |  ;
 | 
|---|