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

IBCNEUT1.m

Go to the documentation of this file.
  1. IBCNEUT1 ;DAOU/ESG - IIV MISC. UTILITIES ;03-JUN-2002
  1. ;;2.0;INTEGRATED BILLING;**184,497,506,601**;21-MAR-94;Build 14
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ; Can't be called from the top
  1. Q
  1. ;
  1. FO(VALUE,LENGTH,JUSTIFY,FILL,TRUNC) ; Formatted output function
  1. ;
  1. ; Input parameters:
  1. ; VALUE the data to get formatted (required)
  1. ; LENGTH the resulting length of the formatted string (required)
  1. ; JUSTIFY "L" or "R" to indicate left or right justification
  1. ; Default is "L" if not passed
  1. ; FILL the character to fill in the spaces
  1. ; Default is a space if not passed
  1. ; TRUNC Whether or not to truncate Value if its longer than length
  1. ; Default is Yes, to truncate if not passed
  1. ;
  1. NEW PAD,Z
  1. I LENGTH>245 S LENGTH=245
  1. S JUSTIFY=$G(JUSTIFY,"L") ; default Left
  1. S FILL=$E($G(FILL)_" ") ; default space
  1. S TRUNC=$G(TRUNC,1) ; default true
  1. S $P(PAD,FILL,LENGTH-$L(VALUE)+1)=""
  1. S Z=""
  1. ;
  1. ; Check for JUSTIFY being "R" first
  1. I JUSTIFY["R" D G FOXIT
  1. . I $L(VALUE)'>LENGTH S Z=PAD_VALUE Q
  1. . I 'TRUNC S Z=VALUE Q
  1. . S Z=$E(VALUE,$L(VALUE)-LENGTH+1,$L(VALUE)) Q
  1. . Q
  1. ;
  1. ; JUSTIFY is "L" below
  1. I $L(VALUE)'>LENGTH S Z=$E(VALUE_PAD,1,LENGTH) G FOXIT
  1. I 'TRUNC S Z=VALUE G FOXIT
  1. S Z=$E(VALUE,1,LENGTH)
  1. ;
  1. FOXIT ;
  1. Q Z
  1. ;
  1. ;
  1. AMLOOK(NAME,ERRFLG,LIST) ; Look-up an ins. co. name in Auto Match
  1. ;
  1. ; Input parameters
  1. ; NAME Insurance company name to look for (required)
  1. ; ERRFLG Error flag to determine whether or not to return
  1. ; an array of all hits (optional)
  1. ; LIST The array to be built - passed by reference
  1. ; (optional)
  1. ; LIST(ins co name)=auto match value
  1. ;
  1. ; Output
  1. ; The value of this function is either 0 or 1.
  1. ; 0 - no matches in the Auto Match file for this name
  1. ; 1 - at least one match was found in the Auto Match file
  1. ;
  1. NEW FOUND,AMIEN,INSNAME,AMV,AMVSTART,NOMATCH
  1. S FOUND=0 ; default to not found
  1. KILL LIST ; initialize results array
  1. S ERRFLG=+$G(ERRFLG) ; ERRFLG default is 0 if not present
  1. S NAME=$$TRIM^XLFSTR($G(NAME)) ; strip leading/trailing spaces
  1. I NAME="" G AMLOOKX ; get out if NAME not present
  1. ;
  1. ; First look for direct hits in the Auto Match file
  1. S AMIEN=$O(^IBCN(365.11,"B",NAME,""))
  1. I AMIEN D
  1. . S FOUND=1
  1. . I 'ERRFLG Q
  1. . S INSNAME=$P($G(^IBCN(365.11,AMIEN,0)),U,2)
  1. . I INSNAME'="" S LIST(INSNAME)=NAME
  1. . Q
  1. ;
  1. ; If we found one and we're not building the array, then exit
  1. I FOUND,'ERRFLG G AMLOOKX
  1. ;
  1. ; Use the first character of the NAME as a seed value to start
  1. ; looping through the Auto Match entries. Only need to look at
  1. ; entries with the "*" wildcard character.
  1. S AMV=$E(NAME)
  1. F S AMV=$O(^IBCN(365.11,"B",AMV)) Q:$E(AMV)'=$E(NAME) D I FOUND,'ERRFLG Q
  1. . I AMV'["*" Q ; only looking for wildcarded entries
  1. . ;
  1. . ; Ensure that the first part of NAME is the same as the first
  1. . ; part of the Auto Match value.
  1. . S AMVSTART=$P(AMV,"*",1)
  1. . I AMVSTART'="",$E(NAME,1,$L(AMVSTART))'=AMVSTART Q
  1. . ;
  1. . ; Build the NOMATCH variable and check it
  1. . D AMC("NAME",AMV,.NOMATCH,0)
  1. . I @NOMATCH Q
  1. . ;
  1. . ; We've got a match so process this accordingly
  1. . S FOUND=1
  1. . I 'ERRFLG Q
  1. . S AMIEN=$O(^IBCN(365.11,"B",AMV,""))
  1. . S INSNAME=$P($G(^IBCN(365.11,+AMIEN,0)),U,2)
  1. . I INSNAME'="" S LIST(INSNAME)=AMV
  1. . Q
  1. ;
  1. ; If we found one and we're not building the array, then exit
  1. I FOUND,'ERRFLG G AMLOOKX
  1. ;
  1. ; Now we need to look at the Auto Match entries which start with
  1. ; the "*" wildcard character.
  1. S AMV="*"
  1. F S AMV=$O(^IBCN(365.11,"B",AMV)) Q:$E(AMV)'="*" D I FOUND,'ERRFLG Q
  1. . D AMC("NAME",AMV,.NOMATCH,0) ; build the NOMATCH variable
  1. . I @NOMATCH Q ; check it
  1. . S FOUND=1 ; We've got a match
  1. . I 'ERRFLG Q
  1. . S AMIEN=$O(^IBCN(365.11,"B",AMV,""))
  1. . S INSNAME=$P($G(^IBCN(365.11,+AMIEN,0)),U,2)
  1. . I INSNAME'="" S LIST(INSNAME)=AMV
  1. . Q
  1. ;
  1. AMLOOKX ;
  1. Q FOUND
  1. ;
  1. ;
  1. AMC(NAME,AMV,MATCH,FLAG) ; Auto Match check function
  1. ;
  1. ; NAME - literal variable name to be matched; enclosed in quotes
  1. ; AMV - Auto Match Value to be pattern matched
  1. ; MATCH - Variable passed by reference; returns condition check command
  1. ; FLAG - if 1, then pattern match check is positive (default)
  1. ; - if 0, then pattern match check is negative
  1. ;
  1. NEW NUMPCE,J,PCE,PCE1
  1. S FLAG=$G(FLAG,1)
  1. S MATCH=NAME_$S('FLAG:"'?",1:"?")
  1. S NUMPCE=$L(AMV,"*")
  1. F J=1:1:NUMPCE D
  1. . S PCE=$P(AMV,"*",J),PCE1=""
  1. . I PCE'="" S PCE1="1"""_PCE_""""
  1. . S MATCH=MATCH_PCE1
  1. . I J'=NUMPCE S MATCH=MATCH_".E"
  1. . Q
  1. AMCX ;
  1. Q
  1. ;
  1. ;
  1. AMSEL(AMARRAY) ; Select an insurance company name from an Auto Match hit list
  1. ;
  1. ; Input
  1. ; Array of Auto Match hits. The structure of this array is the
  1. ; same as that returned by the call to $$AMLOOK above.
  1. ; AMARRAY(ins co name) = Auto Match value
  1. ;
  1. ; Output
  1. ; Insurance Company name (subscript of input array), or
  1. ; -1 if user entered "^" or timed out, or
  1. ; 0 if user didn't select any of these names
  1. ; No changes are made to the array.
  1. ;
  1. NEW SEL,NM,CNT,MSG,MSGNUM,CH,TXT
  1. NEW DIR,X,Y,DIRUT,DTOUT,DUOUT,DIROUT
  1. S SEL=0
  1. I '$D(AMARRAY) G AMSELX ; Get out if array not passed in
  1. ;
  1. ; Display the contents of the array
  1. S MSG(1)="Results of Auto Match search"
  1. S MSG(2)=""
  1. S MSG(3)=" "_$$FO("Insurance Company Name",30)_" Auto Match Value"
  1. S MSG(4)=" "_$$FO("----------------------",30)_" ----------------"
  1. S MSG(1,"F")="!!"
  1. S NM="",MSGNUM=$O(MSG(""),-1),CNT=0,CH=""
  1. F S NM=$O(AMARRAY(NM)) Q:NM="" D
  1. . S CNT=CNT+1
  1. . S TXT=$$FO(NM,30)_" "_AMARRAY(NM)
  1. . S MSGNUM=MSGNUM+1
  1. . S MSG(MSGNUM)=" "_TXT
  1. . I $L(CH)>440 Q
  1. . I CH="" S CH=CNT_":"_TXT ; building the set of codes string
  1. . E S CH=CH_";"_CNT_":"_TXT ; for the DIR reader later on
  1. . Q
  1. ;
  1. ; Get out if there are no entries in the list
  1. I 'CNT G AMSELX
  1. ;
  1. ; One more blank line in the display
  1. S MSGNUM=MSGNUM+1
  1. S MSG(MSGNUM)=""
  1. ;
  1. ; Display the entries in the list
  1. DO EN^DDIOL(.MSG)
  1. ;
  1. ; Ask the first question
  1. S DIR(0)="YO"
  1. S DIR("A")="Would you like to select this insurance company"
  1. I CNT>1 S DIR("A")="Would you like to select one of these insurance companies"
  1. S DIR("B")="Yes"
  1. D ^DIR K DIR
  1. I $D(DIRUT) S SEL=-1 G AMSELX
  1. I 'Y S SEL=0 G AMSELX
  1. ;
  1. ; User said Yes to the above question
  1. ; Get out if there is only one entry in the array
  1. I CNT=1 S SEL=$O(AMARRAY("")) G AMSELX
  1. ;
  1. ; At this point we know there are multiple entries in the list
  1. S DIR(0)="SO^"_CH
  1. S DIR("A")="Please choose an insurance company"
  1. D ^DIR K DIR
  1. I $D(DIRUT) S SEL=-1 G AMSELX
  1. I 'Y S SEL=0 G AMSELX
  1. S SEL=$$TRIM^XLFSTR($E(Y(0),1,30),"R") ; strip trailing spaces
  1. AMSELX ;
  1. Q SEL
  1. ;
  1. LENCHK(VAL,MAX,NUMFLG) ; check value length, called from input transforms on eIV fields
  1. ; VAL - value to check
  1. ; MAX - max. allowed length for free text field, or max. value for numeric field
  1. ; NUMFLG - 1 if field is numeric, 0 if free text
  1. ;
  1. ; returns 1 if length is acceptable, 0 otherwise
  1. N RES
  1. S RES=1
  1. ; check IB site parameter
  1. I '+$P($G(^IBE(350.9,1,62)),U) G LENCHKX
  1. I $S(NUMFLG:VAL,1:$L(VAL))>MAX S RES=0
  1. LENCHKX ;
  1. Q RES
  1. ;
  1. CODECK(VAL) ; validate the response for the output transforms on the CODE (.01) field in the IIV Status Table (#365.15) file.
  1. ; VAL - value to translate
  1. ; OUT - output value based up the value entered.
  1. ;
  1. N IN,OUT,STR1,STR2,IP,AP
  1. S IN=$E(VAL)
  1. S STR1="Response Received"
  1. S STR2="Problem Identified"
  1. S IP="Inactive Policy"
  1. S AP="Active Policy"
  1. ; IB*2*601/DM added IN="M"
  1. S OUT=$S(IN="D":STR1_", "_IP,IN="B":STR2,IN="A":STR1_", "_AP,IN="E":STR1_", "_AP_" (Escalated)",IN="Q":"Inquiry Sent, Awaiting Response",IN="U":STR1_", Ambiguous Answer",IN="C":STR2_", Communication Failure",IN="M":STR1_", MBI Received",1:"")
  1. CODECKX ;
  1. Q OUT
  1. ;