source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCNEAMI.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: 4.3 KB
Line 
1IBCNEAMI ;DAOU/ESG - IIV AUTO MATCH INPUT TRANSFORM ;06-JUN-2002
2 ;;2.0;INTEGRATED BILLING;**184**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5ITAM ; Input Transform Code for the .01 field - auto match value
6 NEW MSG,MSGNUM,AMHIT,INSNAME
7 I $L(X)>30 D ERRMSG("Response is too long. 30 characters maximum.") K X G ITAMX
8 I $L(X)<3 D ERRMSG("Response is too short. 3 characters minimum.") K X G ITAMX
9 I X["*",$L($TR(X,"*"))<4 D ERRMSG("Wildcarded entries must have at least 4 non-wildcard characters.") K X G ITAMX
10 ;
11 S X=$$UP^XLFSTR(X) ; make it all uppercase
12 S X=$$TRIM^XLFSTR(X) ; strip leading & trailing spaces
13 ;
14 ; Translate multiple asterisks into a single asterisk
15 I X["**" F S X=$P(X,"**",1)_"*"_$P(X,"**",2,999) Q:X'["**"
16 ;
17 I $G(DIUTIL)="VERIFY FIELDS" G ITAMX
18 ;
19 I X["*" D
20 . D ICH(X,1) ; procedure builds a scratch global of hits
21 . ;
22 . ; check to see if no hits at all, display message, then quit
23 . I '$D(^TMP($J,"IBCNEAME ICH")) D Q
24 .. S MSG(1)=" For your information, no insurance company names or synonyms passed"
25 .. S MSG(2)=" a pattern match on '"_X_"'."
26 .. S MSG(3)=""
27 .. S MSG(1,"F")="!!"
28 .. DO EN^DDIOL(.MSG)
29 .. Q
30 . ;
31 . ; At this point, we know we got some hits
32 . S MSG(1)=" For your information, the following insurance company names and"
33 . S MSG(2)=" synonyms passed a pattern match on '"_X_"':"
34 . S MSG(3)=""
35 . S MSG(1,"F")="!!"
36 . S AMHIT="",MSGNUM=3
37 . F S AMHIT=$O(^TMP($J,"IBCNEAME ICH",AMHIT)) Q:AMHIT="" D
38 .. ;
39 .. ; If the $D at this level is either 1 or 11, then we want to
40 .. ; display the data. If the $D at this level is a 10, then we
41 .. ; don't want to display this data at this time.
42 .. ;
43 .. I $D(^TMP($J,"IBCNEAME ICH",AMHIT))'=10 D
44 ... S MSGNUM=MSGNUM+1
45 ... S MSG(MSGNUM)=" "_AMHIT
46 ... Q
47 .. S INSNAME=""
48 .. F S INSNAME=$O(^TMP($J,"IBCNEAME ICH",AMHIT,INSNAME)) Q:INSNAME="" D
49 ... S MSGNUM=MSGNUM+1
50 ... S MSG(MSGNUM)=" "_AMHIT_" (Synonym for "_INSNAME_")"
51 ... Q
52 .. Q
53 . S MSGNUM=MSGNUM+1
54 . S MSG(MSGNUM)="" ; one more blank line on the screen
55 . DO EN^DDIOL(.MSG)
56 . KILL ^TMP($J,"IBCNEAME ICH") ; clean up scratch global
57 . Q
58 ;
59ITAMX ;
60 Q
61 ;
62ITIC ; Input Transform Code for the .02 field - ins company name
63 ; This field must be a valid, active insurance company name
64 I $L(X)>30 D ERRMSG("Response is too long. 30 characters maximum.") K X G ITICX
65 S X=$$UP^XLFSTR(X)
66 S X=$$TRIM^XLFSTR(X)
67 ;
68 I $G(DIUTIL)="VERIFY FIELDS" G ITICX
69 ;
70 ; Call the IB insurance company lister function
71 S X=$$DICINS^IBCNBU1(X,1,10)
72 ;
73 ; Make sure the user chose a valid insurance company name
74 I X=0!(X=-1) D ERRMSG("You must choose a valid insurance company name. Enter ?? for more info.") K X G ITICX
75ITICX ;
76 Q
77 ;
78ERRMSG(Z) ; Display an error message
79 D EN^DDIOL(Z,"","!!")
80ERRMSGX ;
81 Q
82 ;
83ICH(AMV,ACTIVE) ; Insurance Company Hits
84 ; This procedure will return a global array of insurance company
85 ; names and synonyms that passed a pattern match of a given
86 ; wildcarded auto-match entry.
87 ;
88 ; Input
89 ; AMV auto match value with *'s
90 ; ACTIVE 0/1 flag indicating to screen for active insurance
91 ; companies (default is 0 - don't screen)
92 ; Output
93 ; ^TMP($J,"IBCNEAME ICH",name) = ""
94 ; ^TMP($J,"IBCNEAME ICH",synonym,name) = ""
95 ;
96 NEW IBSUB,INSIEN,INSNAME,INSTXT,NOMATCH,SEED,STOP
97 KILL ^TMP($J,"IBCNEAME ICH")
98 I AMV'["*" G ICHX ; no wildcard characters
99 I $L($TR(AMV,"*"))<4 G ICHX ; not enough non-wildcard characters
100 S ACTIVE=$G(ACTIVE,0) ; active/inactive flag - default 0
101 ;
102 ; build the NOMATCH check
103 D AMC^IBCNEUT1("INSTXT",AMV,.NOMATCH,0)
104 ;
105 F IBSUB="B","C" D
106 . S SEED=$P(AMV,"*",1),INSTXT=""
107 . I SEED'="" S INSTXT=$O(^DIC(36,IBSUB,SEED),-1)
108 . F S INSTXT=$O(^DIC(36,IBSUB,INSTXT)) Q:INSTXT="" Q:(SEED'=""&($E(INSTXT,1,$L(SEED))'=SEED)) D
109 .. I @NOMATCH Q
110 .. S (INSIEN,STOP)=0 ; loop thru ien's below
111 .. F S INSIEN=$O(^DIC(36,IBSUB,INSTXT,INSIEN)) Q:'INSIEN D Q:STOP
112 ... I ACTIVE,$P($G(^DIC(36,INSIEN,0)),U,5) Q ; inactive
113 ... I ACTIVE,$P($G(^DIC(36,INSIEN,5)),U,1) Q ; sched. for deletion
114 ... S INSNAME=$P($G(^DIC(36,INSIEN,0)),U,1) Q:INSNAME=""
115 ... ;
116 ... ; If looping thru names, we can stop here
117 ... I IBSUB="B" S ^TMP($J,"IBCNEAME ICH",INSTXT)="",STOP=1 Q
118 ... ;
119 ... ; Looping thru synonyms...keep going
120 ... S ^TMP($J,"IBCNEAME ICH",INSTXT,INSNAME)=""
121 ... Q
122 .. Q
123 . Q
124ICHX ;
125 Q
126 ;
Note: See TracBrowser for help on using the repository browser.