source: FOIAVistA/trunk/r/AUTOMATED_MED_INFO_EXCHANGE-DVBA-DVBC/DVBALD1.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 2.8 KB
Line 
1DVBALD1 ;ALB/JLU;extension of DVBALD;9/19/94
2 ;;2.7;AMIE;;Apr 10, 1995
3 ;
4ADD(WHO) ;this is used by both the add and create actions of List Man
5 ;discharge.
6 K DVBAQUIT
7 S VAR(1,0)="0,0,0,2,1^"_$S(WHO="AD":"You may now add to the default list of discharge types.",1:"You may now select a new list of discharge types.")
8 S VAR(2,0)="0,0,0,1,0^Both 'active' and 'inactive' discharge types can be selected."
9 S VAR(3,0)="0,0,0,1:2,0^If help or a list is needed enter a '?'"
10 D WR^DVBAUTL4("VAR")
11 K VAR
12 S DVBIEDSC=$$DSCTIEN^DVBAUTL6("DISCHARGE") ;gets the IFN of "discharge"
13 I DVBIEDSC<1 DO Q
14 .S VAR(1,0)="1,0,0,2,0^No discharge type MAS Movement Transaction type was found"
15 .S VAR(2,0)="0,0,0,1,0^Contact your site manager."
16 .D WR^DVBAUTL4("VAR")
17 .S DVBAQUIT=1
18 .K VAR
19 .Q
20 F DO Q:$D(DVBAQUIT) ;loop to keep asking for movement types
21 .S DIC="^DG(405.2,",DIC(0)="AEMQZ"
22 .S DIC("S")="I DVBIEDSC=$P(^(0),U,2)!(+Y=18)!(+Y=40)!(+Y=43) I '$D(^TMP(""DVBA"",$J,""DUP"",+Y))"
23 .D ^DIC
24 .I +Y>0 DO
25 ..I $$CHECKDUP(+Y) Q ;checks for duplicates not really needed but
26 ..D SETARAY(Y)
27 ..Q
28 .I +Y<1 S DVBAQUIT=1
29 .Q
30 K DVBIEDSC
31 Q
32 ;
33CHECKDUP(A) ;checks if an entry has already been selected. if yes returns a 1
34 I $D(^TMP("DVBA",$J,"DUP",+Y)) DO Q 1
35 .S VAR(1,0)="1,0,0,2,0^This discharge type has already been selected."
36 .D WR^DVBAUTL4("VAR")
37 .K VAR
38 .Q
39 E Q 0
40 ;
41SETARAY(A) ;sets the necessary listmanager and global arrays for this
42 ;selection
43 ;A is the IEN of the discharge type and the second piece is the
44 ;external value
45 N TEXT
46 S VALMCNT=VALMCNT+1
47 S TEXT=$$SETFLD^VALM1(VALMCNT,"","ITEM")
48 S TEXT=$$SETFLD^VALM1($P(A,U,2),TEXT,"DISCHARGE TYPE")
49 S TEXT=$$SETFLD^VALM1(+A,TEXT,"DISCHARGE CODE")
50 S DVBA=$$CHECK^DVBAUTL6(+A)
51 I DVBA=0 S TEXT=$$SETFLD^VALM1("INACTIVE",TEXT,"STATUS")
52 S @VALMAR@(VALMCNT,0)=TEXT
53 S @VALMAR@("IDX",VALMCNT,VALMCNT)=""
54 S ^TMP("DVBA",$J,"DUP",+A)=""
55 S @VALMAR@("FND",VALMCNT,+A)=""
56 Q
57 ;
58DELETE ;This entry point allows the users to delete from the list of discharge
59 ;types
60 K DVBAQUIT
61 F DO Q:$D(DVBAQUIT)
62 .D RE^VALM4
63 .S VALMNOD=$G(XQORNOD(0))
64 .D EN^VALM2(VALMNOD,"O")
65 .I '$O(VALMY("")) S DVBAQUIT=1 Q
66 .S DVBA=""
67 .F S DVBA=$O(VALMY(DVBA)) Q:DVBA="" DO
68 ..S DVBB=$O(@VALMAR@("FND",DVBA,0))
69 ..K ^TMP("DVBA",$J,"DUP",DVBB)
70 ..K @VALMAR@("FND",DVBA,DVBB)
71 ..K @VALMAR@(DVBA,0)
72 ..K @VALMAR@("IDX",DVBA)
73 ..Q
74 .D RELIST
75 .Q
76 K DVBA,DVBB
77 Q
78 ;
79RELIST ;re-organizes the list after a deletion
80 N DVBA,DVBOLD,DVBOLDC
81 S VALMCNT=0,DVBA=""
82 F S DVBA=$O(@VALMAR@(DVBA)) Q:'DVBA DO
83 .S VALMCNT=VALMCNT+1
84 .S DVBOLD=$$SETFLD^VALM1(VALMCNT,@VALMAR@(DVBA,0),"ITEM")
85 .S DVBOLDC=$O(@VALMAR@("FND",DVBA,0))
86 .K @VALMAR@(DVBA,0)
87 .K @VALMAR@("IDX",DVBA)
88 .K @VALMAR@("FND",DVBA)
89 .S @VALMAR@(VALMCNT,0)=DVBOLD
90 .S @VALMAR@("IDX",VALMCNT,VALMCNT)=""
91 .S @VALMAR@("FND",VALMCNT,DVBOLDC)=""
92 .Q
93 Q
Note: See TracBrowser for help on using the repository browser.