[613] | 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 | ;
|
---|