source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCNEAMC.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: 5.1 KB
Line 
1IBCNEAMC ;DAOU/ESG - IIV AUTO MATCH BUFFER LISTING ;11-JUN-2002
2 ;;2.0;INTEGRATED BILLING;**184,252**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5EN ; -- main entry point for IBCNE AUTO MATCH BUFFER LIST
6 NEW IBCNENIL,COL,CTRLCOL,FINISH,POP,VALMBCK,X,%DT
7 D EN^VALM("IBCNE AUTO MATCH BUFFER LIST")
8 Q
9 ;
10HDR ; -- header code
11 S VALMHDR(1)="These are Insurance Company names from the Insurance Buffer file that do not"
12 S VALMHDR(2)="exist in the Insurance Company file (either as Names or as Synonyms). They"
13 S VALMHDR(3)="also do not exist or pattern match with any entry in the Auto Match file."
14 Q
15 ;
16INIT ; -- init variables and list array
17 NEW ENTDATE,IBBUFDA,BUFFNAME
18 KILL ^TMP($J,"IBCNEAMC")
19 S IBCNENIL=0 ; initialize the no data flag
20 S ENTDATE=0
21 F S ENTDATE=$O(^IBA(355.33,"AEST","E",ENTDATE)) Q:'ENTDATE S IBBUFDA=0 F S IBBUFDA=$O(^IBA(355.33,"AEST","E",ENTDATE,IBBUFDA)) Q:'IBBUFDA D
22 . S BUFFNAME=$$TRIM($P($G(^IBA(355.33,IBBUFDA,20)),U,1))
23 . I BUFFNAME="" Q ; no name in buffer file
24 . I $D(^DIC(36,"B",BUFFNAME)) Q ; insurance company name
25 . I $D(^DIC(36,"C",BUFFNAME)) Q ; insurance company synonym
26 . I $$AMLOOK^IBCNEUT1(BUFFNAME) Q ; Auto Match file lookup
27 . S ^TMP($J,"IBCNEAMC",2,BUFFNAME)="" ; name not found so add it
28 . Q
29 ; Now build the ListMan array for display
30 S BUFFNAME="",VALMCNT=0
31 F S BUFFNAME=$O(^TMP($J,"IBCNEAMC",2,BUFFNAME)) Q:BUFFNAME="" D
32 . S VALMCNT=VALMCNT+1
33 . S ^TMP($J,"IBCNEAMC",1,VALMCNT,0)=$J(VALMCNT,4)_" "_BUFFNAME
34 . S ^TMP($J,"IBCNEAMC",3,VALMCNT)=BUFFNAME
35 . Q
36 ;
37 ; Check to see if there's no data
38 I 'VALMCNT D
39 . S IBCNENIL=1 ; no data flag is true
40 . S ^TMP($J,"IBCNEAMC",1,1,0)=""
41 . S ^TMP($J,"IBCNEAMC",1,2,0)=""
42 . S ^TMP($J,"IBCNEAMC",1,3,0)=" There is no data to display."
43 . S VALMCNT=3
44 . Q
45INITX ;
46 Q
47 ;
48 ; For speed reasons, code taken from TRIM^XLFSTR
49TRIM(X,SIDE,CHAR) ; Trim chars from left/right of string
50 NEW LEFT,RIGHT
51 I X="" Q X
52 S SIDE=$G(SIDE,"LR"),CHAR=$G(CHAR," "),LEFT=1,RIGHT=$L(X)
53 I X=CHAR Q ""
54 I SIDE["R" F RIGHT=$L(X):-1:1 Q:$E(X,RIGHT)'=CHAR
55 I SIDE["L" F LEFT=1:1:$L(X) Q:$E(X,LEFT)'=CHAR
56 Q $E(X,LEFT,RIGHT)
57 ;
58 ;
59HELP ; -- help code
60 D FULL^VALM1
61 W !!," There are three main actions you may take on this screen."
62 W !," You may select an action by typing in the first character of the action."
63 W !!," Select Entry"
64 W !," You choose a single insurance company name from the list."
65 W !," This name becomes the default Auto Match value for a new"
66 W !," Auto Match entry. You may then associate this Auto Match value"
67 W !," with a valid insurance company name."
68 W !!," Auto Match Enter/Edit"
69 W !," This action will take you to the Enter/Edit Auto Match Entries"
70 W !," option. You may add, edit, or delete multiple Auto Match"
71 W !," entries in this option."
72 W !!," Exit"
73 W !," Exit out of this option."
74 D PAUSE^VALM1
75 S VALMBCK="R"
76HELPX ;
77 Q
78 ;
79 ;
80EXIT ; -- exit code
81 KILL ^TMP($J,"IBCNEAMC")
82 Q
83 ;
84 ;
85SELECT ; -- select an entry from the list
86 NEW STOP,AMIEN,NEWENTRY,BUFFNAME,INSNM
87 NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
88 D FULL^VALM1
89 ;
90 ; Check for Auto Match security key before allowing selection
91 I '$$KCHK^XUSRB("IBCNE IIV AUTO MATCH") D G SELECTX
92 . W !!?5,"You don't hold the proper security key to access this function."
93 . W !?5,"The necessary key is IBCNE IIV AUTO MATCH. Please see your manager."
94 . D PAUSE^VALM1
95 . Q
96 ;
97 ; Make sure there is something there
98 I IBCNENIL D G SELECTX
99 . W !!?5,"There are no entries in the list."
100 . D PAUSE^VALM1
101 . Q
102 ;
103 S DIR(0)="NO^1:"_VALMCNT_":0"
104 S DIR("A")="Select Entry"
105 S DIR("?",1)=" Please enter the line number corresponding to the insurance company name."
106 S DIR("?",2)=" The valid range of line numbers is displayed in the prompt."
107 S DIR("?",3)=" "
108 S DIR("?",4)=" The insurance company name you select will be used as the default response for"
109 S DIR("?",5)=" a new Auto Match entry. You may either accept this entry as is or you may"
110 S DIR("?")=" modify it by changing the spelling or by adding wildcard characters."
111 D ^DIR K DIR
112 I 'Y G SELECTX
113 S BUFFNAME=$G(^TMP($J,"IBCNEAMC",3,Y))
114 I BUFFNAME="" W ! G SELECTX
115 W " ",BUFFNAME,!
116 ;
117 D LOOKUP I STOP G SELECTX ;Prompt user for Insurance Co.
118 I $D(^IBCN(365.11,"B",BUFFNAME)) D G SELECTX ; has entry been added?
119 . W !!,BUFFNAME," has already been added to the Auto Match file."
120 . S DIR(0)="E" D ^DIR K DIR
121 . D INIT ; refresh listing
122 D AMADD^IBCNEUT6(INSNM,BUFFNAME)
123 D INIT
124SELECTX ;
125 S VALMBCK="R"
126 Q
127 ;
128LOOKUP ; Prompt for associated Insurance Company
129 S STOP=0
130 S DIC=36,DIC(0)="AEMVZ"
131 D ^DIC
132 I Y<1!$D(DTOUT)!$D(DUOUT) S STOP=1 G LOOKX
133 S INSNM=$P(Y(0),U)
134LOOKX Q
135 ;
136LINK ; -- link to the Auto Match Enter/Edit option
137 D FULL^VALM1
138 ;
139 ; Check for Auto Match security key before allowing selection
140 I '$$KCHK^XUSRB("IBCNE IIV AUTO MATCH") D G LINKX
141 . W !!?5,"You don't hold the proper security key to access this function."
142 . W !?5,"The necessary key is IBCNE IIV AUTO MATCH. Please see your manager."
143 . D PAUSE^VALM1
144 . Q
145 ;
146 D ENTER^IBCNEAME
147LINKX ;
148 D INIT S VALMBCK="R"
149 Q
150 ;
Note: See TracBrowser for help on using the repository browser.