Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBCNEAMI

IBCNEAMI.m

Go to the documentation of this file.
  1. IBCNEAMI ;DAOU/ESG - IIV AUTO MATCH INPUT TRANSFORM ;06-JUN-2002
  1. ;;2.0;INTEGRATED BILLING;**184**;21-MAR-94
  1. ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. ;
  1. ITAM ; Input Transform Code for the .01 field - auto match value
  1. NEW MSG,MSGNUM,AMHIT,INSNAME
  1. I $L(X)>30 D ERRMSG("Response is too long. 30 characters maximum.") K X G ITAMX
  1. I $L(X)<3 D ERRMSG("Response is too short. 3 characters minimum.") K X G ITAMX
  1. I X["*",$L($TR(X,"*"))<4 D ERRMSG("Wildcarded entries must have at least 4 non-wildcard characters.") K X G ITAMX
  1. ;
  1. S X=$$UP^XLFSTR(X) ; make it all uppercase
  1. S X=$$TRIM^XLFSTR(X) ; strip leading & trailing spaces
  1. ;
  1. ; Translate multiple asterisks into a single asterisk
  1. I X["**" F S X=$P(X,"**",1)_"*"_$P(X,"**",2,999) Q:X'["**"
  1. ;
  1. I $G(DIUTIL)="VERIFY FIELDS" G ITAMX
  1. ;
  1. I X["*" D
  1. . D ICH(X,1) ; procedure builds a scratch global of hits
  1. . ;
  1. . ; check to see if no hits at all, display message, then quit
  1. . I '$D(^TMP($J,"IBCNEAME ICH")) D Q
  1. .. S MSG(1)=" For your information, no insurance company names or synonyms passed"
  1. .. S MSG(2)=" a pattern match on '"_X_"'."
  1. .. S MSG(3)=""
  1. .. S MSG(1,"F")="!!"
  1. .. DO EN^DDIOL(.MSG)
  1. .. Q
  1. . ;
  1. . ; At this point, we know we got some hits
  1. . S MSG(1)=" For your information, the following insurance company names and"
  1. . S MSG(2)=" synonyms passed a pattern match on '"_X_"':"
  1. . S MSG(3)=""
  1. . S MSG(1,"F")="!!"
  1. . S AMHIT="",MSGNUM=3
  1. . F S AMHIT=$O(^TMP($J,"IBCNEAME ICH",AMHIT)) Q:AMHIT="" D
  1. .. ;
  1. .. ; If the $D at this level is either 1 or 11, then we want to
  1. .. ; display the data. If the $D at this level is a 10, then we
  1. .. ; don't want to display this data at this time.
  1. .. ;
  1. .. I $D(^TMP($J,"IBCNEAME ICH",AMHIT))'=10 D
  1. ... S MSGNUM=MSGNUM+1
  1. ... S MSG(MSGNUM)=" "_AMHIT
  1. ... Q
  1. .. S INSNAME=""
  1. .. F S INSNAME=$O(^TMP($J,"IBCNEAME ICH",AMHIT,INSNAME)) Q:INSNAME="" D
  1. ... S MSGNUM=MSGNUM+1
  1. ... S MSG(MSGNUM)=" "_AMHIT_" (Synonym for "_INSNAME_")"
  1. ... Q
  1. .. Q
  1. . S MSGNUM=MSGNUM+1
  1. . S MSG(MSGNUM)="" ; one more blank line on the screen
  1. . DO EN^DDIOL(.MSG)
  1. . KILL ^TMP($J,"IBCNEAME ICH") ; clean up scratch global
  1. . Q
  1. ;
  1. ITAMX ;
  1. Q
  1. ;
  1. ITIC ; Input Transform Code for the .02 field - ins company name
  1. ; This field must be a valid, active insurance company name
  1. I $L(X)>30 D ERRMSG("Response is too long. 30 characters maximum.") K X G ITICX
  1. S X=$$UP^XLFSTR(X)
  1. S X=$$TRIM^XLFSTR(X)
  1. ;
  1. I $G(DIUTIL)="VERIFY FIELDS" G ITICX
  1. ;
  1. ; Call the IB insurance company lister function
  1. S X=$$DICINS^IBCNBU1(X,1,10)
  1. ;
  1. ; Make sure the user chose a valid insurance company name
  1. I X=0!(X=-1) D ERRMSG("You must choose a valid insurance company name. Enter ?? for more info.") K X G ITICX
  1. ITICX ;
  1. Q
  1. ;
  1. ERRMSG(Z) ; Display an error message
  1. D EN^DDIOL(Z,"","!!")
  1. ERRMSGX ;
  1. Q
  1. ;
  1. ICH(AMV,ACTIVE) ; Insurance Company Hits
  1. ; This procedure will return a global array of insurance company
  1. ; names and synonyms that passed a pattern match of a given
  1. ; wildcarded auto-match entry.
  1. ;
  1. ; Input
  1. ; AMV auto match value with *'s
  1. ; ACTIVE 0/1 flag indicating to screen for active insurance
  1. ; companies (default is 0 - don't screen)
  1. ; Output
  1. ; ^TMP($J,"IBCNEAME ICH",name) = ""
  1. ; ^TMP($J,"IBCNEAME ICH",synonym,name) = ""
  1. ;
  1. NEW IBSUB,INSIEN,INSNAME,INSTXT,NOMATCH,SEED,STOP
  1. KILL ^TMP($J,"IBCNEAME ICH")
  1. I AMV'["*" G ICHX ; no wildcard characters
  1. I $L($TR(AMV,"*"))<4 G ICHX ; not enough non-wildcard characters
  1. S ACTIVE=$G(ACTIVE,0) ; active/inactive flag - default 0
  1. ;
  1. ; build the NOMATCH check
  1. D AMC^IBCNEUT1("INSTXT",AMV,.NOMATCH,0)
  1. ;
  1. F IBSUB="B","C" D
  1. . S SEED=$P(AMV,"*",1),INSTXT=""
  1. . I SEED'="" S INSTXT=$O(^DIC(36,IBSUB,SEED),-1)
  1. . F S INSTXT=$O(^DIC(36,IBSUB,INSTXT)) Q:INSTXT="" Q:(SEED'=""&($E(INSTXT,1,$L(SEED))'=SEED)) D
  1. .. I @NOMATCH Q
  1. .. S (INSIEN,STOP)=0 ; loop thru ien's below
  1. .. F S INSIEN=$O(^DIC(36,IBSUB,INSTXT,INSIEN)) Q:'INSIEN D Q:STOP
  1. ... I ACTIVE,$P($G(^DIC(36,INSIEN,0)),U,5) Q ; inactive
  1. ... I ACTIVE,$P($G(^DIC(36,INSIEN,5)),U,1) Q ; sched. for deletion
  1. ... S INSNAME=$P($G(^DIC(36,INSIEN,0)),U,1) Q:INSNAME=""
  1. ... ;
  1. ... ; If looping thru names, we can stop here
  1. ... I IBSUB="B" S ^TMP($J,"IBCNEAME ICH",INSTXT)="",STOP=1 Q
  1. ... ;
  1. ... ; Looping thru synonyms...keep going
  1. ... S ^TMP($J,"IBCNEAME ICH",INSTXT,INSNAME)=""
  1. ... Q
  1. .. Q
  1. . Q
  1. ICHX ;
  1. Q
  1. ;