IBCNEUT1 ;DAOU/ESG - IIV MISC. UTILITIES ;03-JUN-2002
;;2.0;INTEGRATED BILLING;**184,497,506,601**;21-MAR-94;Build 14
;;Per VA Directive 6402, this routine should not be modified.
;
; Can't be called from the top
Q
;
FO(VALUE,LENGTH,JUSTIFY,FILL,TRUNC) ; Formatted output function
;
; Input parameters:
; VALUE the data to get formatted (required)
; LENGTH the resulting length of the formatted string (required)
; JUSTIFY "L" or "R" to indicate left or right justification
; Default is "L" if not passed
; FILL the character to fill in the spaces
; Default is a space if not passed
; TRUNC Whether or not to truncate Value if its longer than length
; Default is Yes, to truncate if not passed
;
NEW PAD,Z
I LENGTH>245 S LENGTH=245
S JUSTIFY=$G(JUSTIFY,"L") ; default Left
S FILL=$E($G(FILL)_" ") ; default space
S TRUNC=$G(TRUNC,1) ; default true
S $P(PAD,FILL,LENGTH-$L(VALUE)+1)=""
S Z=""
;
; Check for JUSTIFY being "R" first
I JUSTIFY["R" D G FOXIT
. I $L(VALUE)'>LENGTH S Z=PAD_VALUE Q
. I 'TRUNC S Z=VALUE Q
. S Z=$E(VALUE,$L(VALUE)-LENGTH+1,$L(VALUE)) Q
. Q
;
; JUSTIFY is "L" below
I $L(VALUE)'>LENGTH S Z=$E(VALUE_PAD,1,LENGTH) G FOXIT
I 'TRUNC S Z=VALUE G FOXIT
S Z=$E(VALUE,1,LENGTH)
;
FOXIT ;
Q Z
;
;
AMLOOK(NAME,ERRFLG,LIST) ; Look-up an ins. co. name in Auto Match
;
; Input parameters
; NAME Insurance company name to look for (required)
; ERRFLG Error flag to determine whether or not to return
; an array of all hits (optional)
; LIST The array to be built - passed by reference
; (optional)
; LIST(ins co name)=auto match value
;
; Output
; The value of this function is either 0 or 1.
; 0 - no matches in the Auto Match file for this name
; 1 - at least one match was found in the Auto Match file
;
NEW FOUND,AMIEN,INSNAME,AMV,AMVSTART,NOMATCH
S FOUND=0 ; default to not found
KILL LIST ; initialize results array
S ERRFLG=+$G(ERRFLG) ; ERRFLG default is 0 if not present
S NAME=$$TRIM^XLFSTR($G(NAME)) ; strip leading/trailing spaces
I NAME="" G AMLOOKX ; get out if NAME not present
;
; First look for direct hits in the Auto Match file
S AMIEN=$O(^IBCN(365.11,"B",NAME,""))
I AMIEN D
. S FOUND=1
. I 'ERRFLG Q
. S INSNAME=$P($G(^IBCN(365.11,AMIEN,0)),U,2)
. I INSNAME'="" S LIST(INSNAME)=NAME
. Q
;
; If we found one and we're not building the array, then exit
I FOUND,'ERRFLG G AMLOOKX
;
; Use the first character of the NAME as a seed value to start
; looping through the Auto Match entries. Only need to look at
; entries with the "*" wildcard character.
S AMV=$E(NAME)
F S AMV=$O(^IBCN(365.11,"B",AMV)) Q:$E(AMV)'=$E(NAME) D I FOUND,'ERRFLG Q
. I AMV'["*" Q ; only looking for wildcarded entries
. ;
. ; Ensure that the first part of NAME is the same as the first
. ; part of the Auto Match value.
. S AMVSTART=$P(AMV,"*",1)
. I AMVSTART'="",$E(NAME,1,$L(AMVSTART))'=AMVSTART Q
. ;
. ; Build the NOMATCH variable and check it
. D AMC("NAME",AMV,.NOMATCH,0)
. I @NOMATCH Q
. ;
. ; We've got a match so process this accordingly
. S FOUND=1
. I 'ERRFLG Q
. S AMIEN=$O(^IBCN(365.11,"B",AMV,""))
. S INSNAME=$P($G(^IBCN(365.11,+AMIEN,0)),U,2)
. I INSNAME'="" S LIST(INSNAME)=AMV
. Q
;
; If we found one and we're not building the array, then exit
I FOUND,'ERRFLG G AMLOOKX
;
; Now we need to look at the Auto Match entries which start with
; the "*" wildcard character.
S AMV="*"
F S AMV=$O(^IBCN(365.11,"B",AMV)) Q:$E(AMV)'="*" D I FOUND,'ERRFLG Q
. D AMC("NAME",AMV,.NOMATCH,0) ; build the NOMATCH variable
. I @NOMATCH Q ; check it
. S FOUND=1 ; We've got a match
. I 'ERRFLG Q
. S AMIEN=$O(^IBCN(365.11,"B",AMV,""))
. S INSNAME=$P($G(^IBCN(365.11,+AMIEN,0)),U,2)
. I INSNAME'="" S LIST(INSNAME)=AMV
. Q
;
AMLOOKX ;
Q FOUND
;
;
AMC(NAME,AMV,MATCH,FLAG) ; Auto Match check function
;
; NAME - literal variable name to be matched; enclosed in quotes
; AMV - Auto Match Value to be pattern matched
; MATCH - Variable passed by reference; returns condition check command
; FLAG - if 1, then pattern match check is positive (default)
; - if 0, then pattern match check is negative
;
NEW NUMPCE,J,PCE,PCE1
S FLAG=$G(FLAG,1)
S MATCH=NAME_$S('FLAG:"'?",1:"?")
S NUMPCE=$L(AMV,"*")
F J=1:1:NUMPCE D
. S PCE=$P(AMV,"*",J),PCE1=""
. I PCE'="" S PCE1="1"""_PCE_""""
. S MATCH=MATCH_PCE1
. I J'=NUMPCE S MATCH=MATCH_".E"
. Q
AMCX ;
Q
;
;
AMSEL(AMARRAY) ; Select an insurance company name from an Auto Match hit list
;
; Input
; Array of Auto Match hits. The structure of this array is the
; same as that returned by the call to $$AMLOOK above.
; AMARRAY(ins co name) = Auto Match value
;
; Output
; Insurance Company name (subscript of input array), or
; -1 if user entered "^" or timed out, or
; 0 if user didn't select any of these names
; No changes are made to the array.
;
NEW SEL,NM,CNT,MSG,MSGNUM,CH,TXT
NEW DIR,X,Y,DIRUT,DTOUT,DUOUT,DIROUT
S SEL=0
I '$D(AMARRAY) G AMSELX ; Get out if array not passed in
;
; Display the contents of the array
S MSG(1)="Results of Auto Match search"
S MSG(2)=""
S MSG(3)=" "_$$FO("Insurance Company Name",30)_" Auto Match Value"
S MSG(4)=" "_$$FO("----------------------",30)_" ----------------"
S MSG(1,"F")="!!"
S NM="",MSGNUM=$O(MSG(""),-1),CNT=0,CH=""
F S NM=$O(AMARRAY(NM)) Q:NM="" D
. S CNT=CNT+1
. S TXT=$$FO(NM,30)_" "_AMARRAY(NM)
. S MSGNUM=MSGNUM+1
. S MSG(MSGNUM)=" "_TXT
. I $L(CH)>440 Q
. I CH="" S CH=CNT_":"_TXT ; building the set of codes string
. E S CH=CH_";"_CNT_":"_TXT ; for the DIR reader later on
. Q
;
; Get out if there are no entries in the list
I 'CNT G AMSELX
;
; One more blank line in the display
S MSGNUM=MSGNUM+1
S MSG(MSGNUM)=""
;
; Display the entries in the list
DO EN^DDIOL(.MSG)
;
; Ask the first question
S DIR(0)="YO"
S DIR("A")="Would you like to select this insurance company"
I CNT>1 S DIR("A")="Would you like to select one of these insurance companies"
S DIR("B")="Yes"
D ^DIR K DIR
I $D(DIRUT) S SEL=-1 G AMSELX
I 'Y S SEL=0 G AMSELX
;
; User said Yes to the above question
; Get out if there is only one entry in the array
I CNT=1 S SEL=$O(AMARRAY("")) G AMSELX
;
; At this point we know there are multiple entries in the list
S DIR(0)="SO^"_CH
S DIR("A")="Please choose an insurance company"
D ^DIR K DIR
I $D(DIRUT) S SEL=-1 G AMSELX
I 'Y S SEL=0 G AMSELX
S SEL=$$TRIM^XLFSTR($E(Y(0),1,30),"R") ; strip trailing spaces
AMSELX ;
Q SEL
;
LENCHK(VAL,MAX,NUMFLG) ; check value length, called from input transforms on eIV fields
; VAL - value to check
; MAX - max. allowed length for free text field, or max. value for numeric field
; NUMFLG - 1 if field is numeric, 0 if free text
;
; returns 1 if length is acceptable, 0 otherwise
N RES
S RES=1
; check IB site parameter
I '+$P($G(^IBE(350.9,1,62)),U) G LENCHKX
I $S(NUMFLG:VAL,1:$L(VAL))>MAX S RES=0
LENCHKX ;
Q RES
;
CODECK(VAL) ; validate the response for the output transforms on the CODE (.01) field in the IIV Status Table (#365.15) file.
; VAL - value to translate
; OUT - output value based up the value entered.
;
N IN,OUT,STR1,STR2,IP,AP
S IN=$E(VAL)
S STR1="Response Received"
S STR2="Problem Identified"
S IP="Inactive Policy"
S AP="Active Policy"
; IB*2*601/DM added IN="M"
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:"")
CODECKX ;
Q OUT
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNEUT1 8146 printed Dec 13, 2024@02:15:30 Page 2
IBCNEUT1 ;DAOU/ESG - IIV MISC. UTILITIES ;03-JUN-2002
+1 ;;2.0;INTEGRATED BILLING;**184,497,506,601**;21-MAR-94;Build 14
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; Can't be called from the top
+5 QUIT
+6 ;
FO(VALUE,LENGTH,JUSTIFY,FILL,TRUNC) ; Formatted output function
+1 ;
+2 ; Input parameters:
+3 ; VALUE the data to get formatted (required)
+4 ; LENGTH the resulting length of the formatted string (required)
+5 ; JUSTIFY "L" or "R" to indicate left or right justification
+6 ; Default is "L" if not passed
+7 ; FILL the character to fill in the spaces
+8 ; Default is a space if not passed
+9 ; TRUNC Whether or not to truncate Value if its longer than length
+10 ; Default is Yes, to truncate if not passed
+11 ;
+12 NEW PAD,Z
+13 IF LENGTH>245
SET LENGTH=245
+14 ; default Left
SET JUSTIFY=$GET(JUSTIFY,"L")
+15 ; default space
SET FILL=$EXTRACT($GET(FILL)_" ")
+16 ; default true
SET TRUNC=$GET(TRUNC,1)
+17 SET $PIECE(PAD,FILL,LENGTH-$LENGTH(VALUE)+1)=""
+18 SET Z=""
+19 ;
+20 ; Check for JUSTIFY being "R" first
+21 IF JUSTIFY["R"
Begin DoDot:1
+22 IF $LENGTH(VALUE)'>LENGTH
SET Z=PAD_VALUE
QUIT
+23 IF 'TRUNC
SET Z=VALUE
QUIT
+24 SET Z=$EXTRACT(VALUE,$LENGTH(VALUE)-LENGTH+1,$LENGTH(VALUE))
QUIT
+25 QUIT
End DoDot:1
GOTO FOXIT
+26 ;
+27 ; JUSTIFY is "L" below
+28 IF $LENGTH(VALUE)'>LENGTH
SET Z=$EXTRACT(VALUE_PAD,1,LENGTH)
GOTO FOXIT
+29 IF 'TRUNC
SET Z=VALUE
GOTO FOXIT
+30 SET Z=$EXTRACT(VALUE,1,LENGTH)
+31 ;
FOXIT ;
+1 QUIT Z
+2 ;
+3 ;
AMLOOK(NAME,ERRFLG,LIST) ; Look-up an ins. co. name in Auto Match
+1 ;
+2 ; Input parameters
+3 ; NAME Insurance company name to look for (required)
+4 ; ERRFLG Error flag to determine whether or not to return
+5 ; an array of all hits (optional)
+6 ; LIST The array to be built - passed by reference
+7 ; (optional)
+8 ; LIST(ins co name)=auto match value
+9 ;
+10 ; Output
+11 ; The value of this function is either 0 or 1.
+12 ; 0 - no matches in the Auto Match file for this name
+13 ; 1 - at least one match was found in the Auto Match file
+14 ;
+15 NEW FOUND,AMIEN,INSNAME,AMV,AMVSTART,NOMATCH
+16 ; default to not found
SET FOUND=0
+17 ; initialize results array
KILL LIST
+18 ; ERRFLG default is 0 if not present
SET ERRFLG=+$GET(ERRFLG)
+19 ; strip leading/trailing spaces
SET NAME=$$TRIM^XLFSTR($GET(NAME))
+20 ; get out if NAME not present
IF NAME=""
GOTO AMLOOKX
+21 ;
+22 ; First look for direct hits in the Auto Match file
+23 SET AMIEN=$ORDER(^IBCN(365.11,"B",NAME,""))
+24 IF AMIEN
Begin DoDot:1
+25 SET FOUND=1
+26 IF 'ERRFLG
QUIT
+27 SET INSNAME=$PIECE($GET(^IBCN(365.11,AMIEN,0)),U,2)
+28 IF INSNAME'=""
SET LIST(INSNAME)=NAME
+29 QUIT
End DoDot:1
+30 ;
+31 ; If we found one and we're not building the array, then exit
+32 IF FOUND
IF 'ERRFLG
GOTO AMLOOKX
+33 ;
+34 ; Use the first character of the NAME as a seed value to start
+35 ; looping through the Auto Match entries. Only need to look at
+36 ; entries with the "*" wildcard character.
+37 SET AMV=$EXTRACT(NAME)
+38 FOR
SET AMV=$ORDER(^IBCN(365.11,"B",AMV))
if $EXTRACT(AMV)'=$EXTRACT(NAME)
QUIT
Begin DoDot:1
+39 ; only looking for wildcarded entries
IF AMV'["*"
QUIT
+40 ;
+41 ; Ensure that the first part of NAME is the same as the first
+42 ; part of the Auto Match value.
+43 SET AMVSTART=$PIECE(AMV,"*",1)
+44 IF AMVSTART'=""
IF $EXTRACT(NAME,1,$LENGTH(AMVSTART))'=AMVSTART
QUIT
+45 ;
+46 ; Build the NOMATCH variable and check it
+47 DO AMC("NAME",AMV,.NOMATCH,0)
+48 IF @NOMATCH
QUIT
+49 ;
+50 ; We've got a match so process this accordingly
+51 SET FOUND=1
+52 IF 'ERRFLG
QUIT
+53 SET AMIEN=$ORDER(^IBCN(365.11,"B",AMV,""))
+54 SET INSNAME=$PIECE($GET(^IBCN(365.11,+AMIEN,0)),U,2)
+55 IF INSNAME'=""
SET LIST(INSNAME)=AMV
+56 QUIT
End DoDot:1
IF FOUND
IF 'ERRFLG
QUIT
+57 ;
+58 ; If we found one and we're not building the array, then exit
+59 IF FOUND
IF 'ERRFLG
GOTO AMLOOKX
+60 ;
+61 ; Now we need to look at the Auto Match entries which start with
+62 ; the "*" wildcard character.
+63 SET AMV="*"
+64 FOR
SET AMV=$ORDER(^IBCN(365.11,"B",AMV))
if $EXTRACT(AMV)'="*"
QUIT
Begin DoDot:1
+65 ; build the NOMATCH variable
DO AMC("NAME",AMV,.NOMATCH,0)
+66 ; check it
IF @NOMATCH
QUIT
+67 ; We've got a match
SET FOUND=1
+68 IF 'ERRFLG
QUIT
+69 SET AMIEN=$ORDER(^IBCN(365.11,"B",AMV,""))
+70 SET INSNAME=$PIECE($GET(^IBCN(365.11,+AMIEN,0)),U,2)
+71 IF INSNAME'=""
SET LIST(INSNAME)=AMV
+72 QUIT
End DoDot:1
IF FOUND
IF 'ERRFLG
QUIT
+73 ;
AMLOOKX ;
+1 QUIT FOUND
+2 ;
+3 ;
AMC(NAME,AMV,MATCH,FLAG) ; Auto Match check function
+1 ;
+2 ; NAME - literal variable name to be matched; enclosed in quotes
+3 ; AMV - Auto Match Value to be pattern matched
+4 ; MATCH - Variable passed by reference; returns condition check command
+5 ; FLAG - if 1, then pattern match check is positive (default)
+6 ; - if 0, then pattern match check is negative
+7 ;
+8 NEW NUMPCE,J,PCE,PCE1
+9 SET FLAG=$GET(FLAG,1)
+10 SET MATCH=NAME_$SELECT('FLAG:"'?",1:"?")
+11 SET NUMPCE=$LENGTH(AMV,"*")
+12 FOR J=1:1:NUMPCE
Begin DoDot:1
+13 SET PCE=$PIECE(AMV,"*",J)
SET PCE1=""
+14 IF PCE'=""
SET PCE1="1"""_PCE_""""
+15 SET MATCH=MATCH_PCE1
+16 IF J'=NUMPCE
SET MATCH=MATCH_".E"
+17 QUIT
End DoDot:1
AMCX ;
+1 QUIT
+2 ;
+3 ;
AMSEL(AMARRAY) ; Select an insurance company name from an Auto Match hit list
+1 ;
+2 ; Input
+3 ; Array of Auto Match hits. The structure of this array is the
+4 ; same as that returned by the call to $$AMLOOK above.
+5 ; AMARRAY(ins co name) = Auto Match value
+6 ;
+7 ; Output
+8 ; Insurance Company name (subscript of input array), or
+9 ; -1 if user entered "^" or timed out, or
+10 ; 0 if user didn't select any of these names
+11 ; No changes are made to the array.
+12 ;
+13 NEW SEL,NM,CNT,MSG,MSGNUM,CH,TXT
+14 NEW DIR,X,Y,DIRUT,DTOUT,DUOUT,DIROUT
+15 SET SEL=0
+16 ; Get out if array not passed in
IF '$DATA(AMARRAY)
GOTO AMSELX
+17 ;
+18 ; Display the contents of the array
+19 SET MSG(1)="Results of Auto Match search"
+20 SET MSG(2)=""
+21 SET MSG(3)=" "_$$FO("Insurance Company Name",30)_" Auto Match Value"
+22 SET MSG(4)=" "_$$FO("----------------------",30)_" ----------------"
+23 SET MSG(1,"F")="!!"
+24 SET NM=""
SET MSGNUM=$ORDER(MSG(""),-1)
SET CNT=0
SET CH=""
+25 FOR
SET NM=$ORDER(AMARRAY(NM))
if NM=""
QUIT
Begin DoDot:1
+26 SET CNT=CNT+1
+27 SET TXT=$$FO(NM,30)_" "_AMARRAY(NM)
+28 SET MSGNUM=MSGNUM+1
+29 SET MSG(MSGNUM)=" "_TXT
+30 IF $LENGTH(CH)>440
QUIT
+31 ; building the set of codes string
IF CH=""
SET CH=CNT_":"_TXT
+32 ; for the DIR reader later on
IF '$TEST
SET CH=CH_";"_CNT_":"_TXT
+33 QUIT
End DoDot:1
+34 ;
+35 ; Get out if there are no entries in the list
+36 IF 'CNT
GOTO AMSELX
+37 ;
+38 ; One more blank line in the display
+39 SET MSGNUM=MSGNUM+1
+40 SET MSG(MSGNUM)=""
+41 ;
+42 ; Display the entries in the list
+43 DO EN^DDIOL(.MSG)
+44 ;
+45 ; Ask the first question
+46 SET DIR(0)="YO"
+47 SET DIR("A")="Would you like to select this insurance company"
+48 IF CNT>1
SET DIR("A")="Would you like to select one of these insurance companies"
+49 SET DIR("B")="Yes"
+50 DO ^DIR
KILL DIR
+51 IF $DATA(DIRUT)
SET SEL=-1
GOTO AMSELX
+52 IF 'Y
SET SEL=0
GOTO AMSELX
+53 ;
+54 ; User said Yes to the above question
+55 ; Get out if there is only one entry in the array
+56 IF CNT=1
SET SEL=$ORDER(AMARRAY(""))
GOTO AMSELX
+57 ;
+58 ; At this point we know there are multiple entries in the list
+59 SET DIR(0)="SO^"_CH
+60 SET DIR("A")="Please choose an insurance company"
+61 DO ^DIR
KILL DIR
+62 IF $DATA(DIRUT)
SET SEL=-1
GOTO AMSELX
+63 IF 'Y
SET SEL=0
GOTO AMSELX
+64 ; strip trailing spaces
SET SEL=$$TRIM^XLFSTR($EXTRACT(Y(0),1,30),"R")
AMSELX ;
+1 QUIT SEL
+2 ;
LENCHK(VAL,MAX,NUMFLG) ; check value length, called from input transforms on eIV fields
+1 ; VAL - value to check
+2 ; MAX - max. allowed length for free text field, or max. value for numeric field
+3 ; NUMFLG - 1 if field is numeric, 0 if free text
+4 ;
+5 ; returns 1 if length is acceptable, 0 otherwise
+6 NEW RES
+7 SET RES=1
+8 ; check IB site parameter
+9 IF '+$PIECE($GET(^IBE(350.9,1,62)),U)
GOTO LENCHKX
+10 IF $SELECT(NUMFLG:VAL,1:$LENGTH(VAL))>MAX
SET RES=0
LENCHKX ;
+1 QUIT RES
+2 ;
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
+2 ; OUT - output value based up the value entered.
+3 ;
+4 NEW IN,OUT,STR1,STR2,IP,AP
+5 SET IN=$EXTRACT(VAL)
+6 SET STR1="Response Received"
+7 SET STR2="Problem Identified"
+8 SET IP="Inactive Policy"
+9 SET AP="Active Policy"
+10 ; IB*2*601/DM added IN="M"
+11 SET OUT=$SELECT(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:"")
CODECKX ;
+1 QUIT OUT
+2 ;
