- IBCNEAMI ;DAOU/ESG - IIV AUTO MATCH INPUT TRANSFORM ;06-JUN-2002
- ;;2.0;INTEGRATED BILLING;**184**;21-MAR-94
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- ITAM ; Input Transform Code for the .01 field - auto match value
- NEW MSG,MSGNUM,AMHIT,INSNAME
- I $L(X)>30 D ERRMSG("Response is too long. 30 characters maximum.") K X G ITAMX
- I $L(X)<3 D ERRMSG("Response is too short. 3 characters minimum.") K X G ITAMX
- I X["*",$L($TR(X,"*"))<4 D ERRMSG("Wildcarded entries must have at least 4 non-wildcard characters.") K X G ITAMX
- ;
- S X=$$UP^XLFSTR(X) ; make it all uppercase
- S X=$$TRIM^XLFSTR(X) ; strip leading & trailing spaces
- ;
- ; Translate multiple asterisks into a single asterisk
- I X["**" F S X=$P(X,"**",1)_"*"_$P(X,"**",2,999) Q:X'["**"
- ;
- I $G(DIUTIL)="VERIFY FIELDS" G ITAMX
- ;
- I X["*" D
- . D ICH(X,1) ; procedure builds a scratch global of hits
- . ;
- . ; check to see if no hits at all, display message, then quit
- . I '$D(^TMP($J,"IBCNEAME ICH")) D Q
- .. S MSG(1)=" For your information, no insurance company names or synonyms passed"
- .. S MSG(2)=" a pattern match on '"_X_"'."
- .. S MSG(3)=""
- .. S MSG(1,"F")="!!"
- .. DO EN^DDIOL(.MSG)
- .. Q
- . ;
- . ; At this point, we know we got some hits
- . S MSG(1)=" For your information, the following insurance company names and"
- . S MSG(2)=" synonyms passed a pattern match on '"_X_"':"
- . S MSG(3)=""
- . S MSG(1,"F")="!!"
- . S AMHIT="",MSGNUM=3
- . F S AMHIT=$O(^TMP($J,"IBCNEAME ICH",AMHIT)) Q:AMHIT="" D
- .. ;
- .. ; If the $D at this level is either 1 or 11, then we want to
- .. ; display the data. If the $D at this level is a 10, then we
- .. ; don't want to display this data at this time.
- .. ;
- .. I $D(^TMP($J,"IBCNEAME ICH",AMHIT))'=10 D
- ... S MSGNUM=MSGNUM+1
- ... S MSG(MSGNUM)=" "_AMHIT
- ... Q
- .. S INSNAME=""
- .. F S INSNAME=$O(^TMP($J,"IBCNEAME ICH",AMHIT,INSNAME)) Q:INSNAME="" D
- ... S MSGNUM=MSGNUM+1
- ... S MSG(MSGNUM)=" "_AMHIT_" (Synonym for "_INSNAME_")"
- ... Q
- .. Q
- . S MSGNUM=MSGNUM+1
- . S MSG(MSGNUM)="" ; one more blank line on the screen
- . DO EN^DDIOL(.MSG)
- . KILL ^TMP($J,"IBCNEAME ICH") ; clean up scratch global
- . Q
- ;
- ITAMX ;
- Q
- ;
- ITIC ; Input Transform Code for the .02 field - ins company name
- ; This field must be a valid, active insurance company name
- I $L(X)>30 D ERRMSG("Response is too long. 30 characters maximum.") K X G ITICX
- S X=$$UP^XLFSTR(X)
- S X=$$TRIM^XLFSTR(X)
- ;
- I $G(DIUTIL)="VERIFY FIELDS" G ITICX
- ;
- ; Call the IB insurance company lister function
- S X=$$DICINS^IBCNBU1(X,1,10)
- ;
- ; Make sure the user chose a valid insurance company name
- I X=0!(X=-1) D ERRMSG("You must choose a valid insurance company name. Enter ?? for more info.") K X G ITICX
- ITICX ;
- Q
- ;
- ERRMSG(Z) ; Display an error message
- D EN^DDIOL(Z,"","!!")
- ERRMSGX ;
- Q
- ;
- ICH(AMV,ACTIVE) ; Insurance Company Hits
- ; This procedure will return a global array of insurance company
- ; names and synonyms that passed a pattern match of a given
- ; wildcarded auto-match entry.
- ;
- ; Input
- ; AMV auto match value with *'s
- ; ACTIVE 0/1 flag indicating to screen for active insurance
- ; companies (default is 0 - don't screen)
- ; Output
- ; ^TMP($J,"IBCNEAME ICH",name) = ""
- ; ^TMP($J,"IBCNEAME ICH",synonym,name) = ""
- ;
- NEW IBSUB,INSIEN,INSNAME,INSTXT,NOMATCH,SEED,STOP
- KILL ^TMP($J,"IBCNEAME ICH")
- I AMV'["*" G ICHX ; no wildcard characters
- I $L($TR(AMV,"*"))<4 G ICHX ; not enough non-wildcard characters
- S ACTIVE=$G(ACTIVE,0) ; active/inactive flag - default 0
- ;
- ; build the NOMATCH check
- D AMC^IBCNEUT1("INSTXT",AMV,.NOMATCH,0)
- ;
- F IBSUB="B","C" D
- . S SEED=$P(AMV,"*",1),INSTXT=""
- . I SEED'="" S INSTXT=$O(^DIC(36,IBSUB,SEED),-1)
- . F S INSTXT=$O(^DIC(36,IBSUB,INSTXT)) Q:INSTXT="" Q:(SEED'=""&($E(INSTXT,1,$L(SEED))'=SEED)) D
- .. I @NOMATCH Q
- .. S (INSIEN,STOP)=0 ; loop thru ien's below
- .. F S INSIEN=$O(^DIC(36,IBSUB,INSTXT,INSIEN)) Q:'INSIEN D Q:STOP
- ... I ACTIVE,$P($G(^DIC(36,INSIEN,0)),U,5) Q ; inactive
- ... I ACTIVE,$P($G(^DIC(36,INSIEN,5)),U,1) Q ; sched. for deletion
- ... S INSNAME=$P($G(^DIC(36,INSIEN,0)),U,1) Q:INSNAME=""
- ... ;
- ... ; If looping thru names, we can stop here
- ... I IBSUB="B" S ^TMP($J,"IBCNEAME ICH",INSTXT)="",STOP=1 Q
- ... ;
- ... ; Looping thru synonyms...keep going
- ... S ^TMP($J,"IBCNEAME ICH",INSTXT,INSNAME)=""
- ... Q
- .. Q
- . Q
- ICHX ;
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNEAMI 4540 printed Jan 18, 2025@03:15:35 Page 2
- IBCNEAMI ;DAOU/ESG - IIV AUTO MATCH INPUT TRANSFORM ;06-JUN-2002
- +1 ;;2.0;INTEGRATED BILLING;**184**;21-MAR-94
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 ;
- ITAM ; Input Transform Code for the .01 field - auto match value
- +1 NEW MSG,MSGNUM,AMHIT,INSNAME
- +2 IF $LENGTH(X)>30
- DO ERRMSG("Response is too long. 30 characters maximum.")
- KILL X
- GOTO ITAMX
- +3 IF $LENGTH(X)<3
- DO ERRMSG("Response is too short. 3 characters minimum.")
- KILL X
- GOTO ITAMX
- +4 IF X["*"
- IF $LENGTH($TRANSLATE(X,"*"))<4
- DO ERRMSG("Wildcarded entries must have at least 4 non-wildcard characters.")
- KILL X
- GOTO ITAMX
- +5 ;
- +6 ; make it all uppercase
- SET X=$$UP^XLFSTR(X)
- +7 ; strip leading & trailing spaces
- SET X=$$TRIM^XLFSTR(X)
- +8 ;
- +9 ; Translate multiple asterisks into a single asterisk
- +10 IF X["**"
- FOR
- SET X=$PIECE(X,"**",1)_"*"_$PIECE(X,"**",2,999)
- if X'["**"
- QUIT
- +11 ;
- +12 IF $GET(DIUTIL)="VERIFY FIELDS"
- GOTO ITAMX
- +13 ;
- +14 IF X["*"
- Begin DoDot:1
- +15 ; procedure builds a scratch global of hits
- DO ICH(X,1)
- +16 ;
- +17 ; check to see if no hits at all, display message, then quit
- +18 IF '$DATA(^TMP($JOB,"IBCNEAME ICH"))
- Begin DoDot:2
- +19 SET MSG(1)=" For your information, no insurance company names or synonyms passed"
- +20 SET MSG(2)=" a pattern match on '"_X_"'."
- +21 SET MSG(3)=""
- +22 SET MSG(1,"F")="!!"
- +23 DO EN^DDIOL(.MSG)
- +24 QUIT
- End DoDot:2
- QUIT
- +25 ;
- +26 ; At this point, we know we got some hits
- +27 SET MSG(1)=" For your information, the following insurance company names and"
- +28 SET MSG(2)=" synonyms passed a pattern match on '"_X_"':"
- +29 SET MSG(3)=""
- +30 SET MSG(1,"F")="!!"
- +31 SET AMHIT=""
- SET MSGNUM=3
- +32 FOR
- SET AMHIT=$ORDER(^TMP($JOB,"IBCNEAME ICH",AMHIT))
- if AMHIT=""
- QUIT
- Begin DoDot:2
- +33 ;
- +34 ; If the $D at this level is either 1 or 11, then we want to
- +35 ; display the data. If the $D at this level is a 10, then we
- +36 ; don't want to display this data at this time.
- +37 ;
- +38 IF $DATA(^TMP($JOB,"IBCNEAME ICH",AMHIT))'=10
- Begin DoDot:3
- +39 SET MSGNUM=MSGNUM+1
- +40 SET MSG(MSGNUM)=" "_AMHIT
- +41 QUIT
- End DoDot:3
- +42 SET INSNAME=""
- +43 FOR
- SET INSNAME=$ORDER(^TMP($JOB,"IBCNEAME ICH",AMHIT,INSNAME))
- if INSNAME=""
- QUIT
- Begin DoDot:3
- +44 SET MSGNUM=MSGNUM+1
- +45 SET MSG(MSGNUM)=" "_AMHIT_" (Synonym for "_INSNAME_")"
- +46 QUIT
- End DoDot:3
- +47 QUIT
- End DoDot:2
- +48 SET MSGNUM=MSGNUM+1
- +49 ; one more blank line on the screen
- SET MSG(MSGNUM)=""
- +50 DO EN^DDIOL(.MSG)
- +51 ; clean up scratch global
- KILL ^TMP($JOB,"IBCNEAME ICH")
- +52 QUIT
- End DoDot:1
- +53 ;
- ITAMX ;
- +1 QUIT
- +2 ;
- ITIC ; Input Transform Code for the .02 field - ins company name
- +1 ; This field must be a valid, active insurance company name
- +2 IF $LENGTH(X)>30
- DO ERRMSG("Response is too long. 30 characters maximum.")
- KILL X
- GOTO ITICX
- +3 SET X=$$UP^XLFSTR(X)
- +4 SET X=$$TRIM^XLFSTR(X)
- +5 ;
- +6 IF $GET(DIUTIL)="VERIFY FIELDS"
- GOTO ITICX
- +7 ;
- +8 ; Call the IB insurance company lister function
- +9 SET X=$$DICINS^IBCNBU1(X,1,10)
- +10 ;
- +11 ; Make sure the user chose a valid insurance company name
- +12 IF X=0!(X=-1)
- DO ERRMSG("You must choose a valid insurance company name. Enter ?? for more info.")
- KILL X
- GOTO ITICX
- ITICX ;
- +1 QUIT
- +2 ;
- ERRMSG(Z) ; Display an error message
- +1 DO EN^DDIOL(Z,"","!!")
- ERRMSGX ;
- +1 QUIT
- +2 ;
- ICH(AMV,ACTIVE) ; Insurance Company Hits
- +1 ; This procedure will return a global array of insurance company
- +2 ; names and synonyms that passed a pattern match of a given
- +3 ; wildcarded auto-match entry.
- +4 ;
- +5 ; Input
- +6 ; AMV auto match value with *'s
- +7 ; ACTIVE 0/1 flag indicating to screen for active insurance
- +8 ; companies (default is 0 - don't screen)
- +9 ; Output
- +10 ; ^TMP($J,"IBCNEAME ICH",name) = ""
- +11 ; ^TMP($J,"IBCNEAME ICH",synonym,name) = ""
- +12 ;
- +13 NEW IBSUB,INSIEN,INSNAME,INSTXT,NOMATCH,SEED,STOP
- +14 KILL ^TMP($JOB,"IBCNEAME ICH")
- +15 ; no wildcard characters
- IF AMV'["*"
- GOTO ICHX
- +16 ; not enough non-wildcard characters
- IF $LENGTH($TRANSLATE(AMV,"*"))<4
- GOTO ICHX
- +17 ; active/inactive flag - default 0
- SET ACTIVE=$GET(ACTIVE,0)
- +18 ;
- +19 ; build the NOMATCH check
- +20 DO AMC^IBCNEUT1("INSTXT",AMV,.NOMATCH,0)
- +21 ;
- +22 FOR IBSUB="B","C"
- Begin DoDot:1
- +23 SET SEED=$PIECE(AMV,"*",1)
- SET INSTXT=""
- +24 IF SEED'=""
- SET INSTXT=$ORDER(^DIC(36,IBSUB,SEED),-1)
- +25 FOR
- SET INSTXT=$ORDER(^DIC(36,IBSUB,INSTXT))
- if INSTXT=""
- QUIT
- if (SEED'=""&($EXTRACT(INSTXT,1,$LENGTH(SEED))'=SEED))
- QUIT
- Begin DoDot:2
- +26 IF @NOMATCH
- QUIT
- +27 ; loop thru ien's below
- SET (INSIEN,STOP)=0
- +28 FOR
- SET INSIEN=$ORDER(^DIC(36,IBSUB,INSTXT,INSIEN))
- if 'INSIEN
- QUIT
- Begin DoDot:3
- +29 ; inactive
- IF ACTIVE
- IF $PIECE($GET(^DIC(36,INSIEN,0)),U,5)
- QUIT
- +30 ; sched. for deletion
- IF ACTIVE
- IF $PIECE($GET(^DIC(36,INSIEN,5)),U,1)
- QUIT
- +31 SET INSNAME=$PIECE($GET(^DIC(36,INSIEN,0)),U,1)
- if INSNAME=""
- QUIT
- +32 ;
- +33 ; If looping thru names, we can stop here
- +34 IF IBSUB="B"
- SET ^TMP($JOB,"IBCNEAME ICH",INSTXT)=""
- SET STOP=1
- QUIT
- +35 ;
- +36 ; Looping thru synonyms...keep going
- +37 SET ^TMP($JOB,"IBCNEAME ICH",INSTXT,INSNAME)=""
- +38 QUIT
- End DoDot:3
- if STOP
- QUIT
- +39 QUIT
- End DoDot:2
- +40 QUIT
- End DoDot:1
- ICHX ;
- +1 QUIT
- +2 ;