IBCNINSU ;AITC/TAZ - GENERAL INSURANCE UTILITIES ;8/20/20 12:46p.m.
;;2.0;INTEGRATED BILLING;**668,687,713,737**;21-MAR-94;Build 19
;;Per VA Directive 6402, this routine should not be modified.
;
PAYER(PIEN,APP,FLDS,FLGS,ARRAY) ;Payer Data Retrieval
;INPUT
; * = required input
; * PIEN - Payer IEN
; APP - EIV - Returns all fields for Payer Level and EIV level of file (overrides FLDS)
; - IIU - Returns all fields for Payer Level and IIU level of file (overrides FLDS)
; * FLDS - Required only if APP is null; If APP is populated this parameter is ignored
; - A single field number
; - A list of field numbers, separated by semicolons
; - A range of field numbers, in the form M:N, where M and N are the end points of the inclusive range.
; All field numbers within this range are retrieved.
; - * for all fields at the top level (no sub-multiple record).
; - ** for all fields including all fields and data in sub-multiple fields.
; - Field number of a multiple followed by an * to indicate all fields and records in the sub-multiple
; for that field.
; FLGS - E Returns External values in nodes ending with "E".
; - I Returns Internal values in nodes ending with "I".
; - NULL Returns External values.
; * ARRAY - Name of the Array that will contain the data (passed by reference)
;
;OUTPUT
; ARRAY - Data requested is returned in the array that was passed by reference
;
N APPIEN,APPIENI,IENS
I '$G(PIEN) S ARRAY(0)="Payer IEN is null or invalid" G PAYERX
I $G(APP)="",($G(FLDS)="") S ARRAY(0)="No fields requested." G PAYERX
S FLGS=$G(FLGS)
I $G(APP)'="" D G PAYERX
. S APPIEN=$$FIND1^DIC(365.13,,,APP) I 'APPIEN S ARRAY(0)="Invalid Application" Q
. S APPIENI=$O(^IBE(365.12,PIEN,1,"B",APPIEN,"")) ; Get the app's internal id for the current payer.
. ; Get all fields at Top Level
. S IENS=PIEN_",",FLDS="*"
. D GETS^DIQ(365.12,IENS,FLDS,FLGS,"ARRAY")
. ; Get all fields at Application Level
. S IENS=APPIENI_","_IENS,FLDS=".01:5.01" ;ignores the log data (history of the settings)
. D GETS^DIQ(365.121,IENS,FLDS,FLGS,"ARRAY")
S IENS=PIEN_","
D GETS^DIQ(365.12,IENS,FLDS,FLGS,"ARRAY")
;
PAYERX ; Exit subroutine
Q
;
PYRDEACT(PIEN) ;Check if payer is deactivated
;INPUT
; PIEN - Payer IEN
;OUTPUT
; DEACTIVATE - Payer Deactivated (Internal Format)
; 0 - No
; 1 - Yes
; DATE/TIME DEACTIVATE - Date and Time the Payer was deactivated (Internal Fileman Format)
;
N PYRARR,IENS
S IENS=PIEN_","
D PAYER(PIEN,,".07;.08","I",.PYRARR)
;
Q PYRARR(365.12,IENS,.07,"I")_U_PYRARR(365.12,IENS,.08,"I")
;
STOP() ; Determine if user wants to exit out of the whole option
; Init vars
N DIR,DIRUT,STOP,X,Y
;
W !
S DIR(0)="Y"
S DIR("A")="Do you want to exit out of this option entirely"
S DIR("B")="YES"
S DIR("?",1)=" Enter YES to immediately exit out of this option."
S DIR("?")=" Enter NO to return to the previous question."
D ^DIR K DIR
I $D(DIRUT) S (STOP,Y)=1 G STOPX
I 'Y S STOP=0
;
STOPX ; STOP exit pt
Q Y
;
FOREIGN(VALUE,PIECES,BLANK) ; check for ASCII chars outside (32-126 inclusive)
;INPUT:
; VALUE = the string/field to check
; PIECES = populate if a subcomponent has to be checked (defaults as 1)
; BLANK = populated if the value is to be cleared out if foreign char
; is encountered (1 tells program to clear out field if it cotains foreign)
;
; I VALUE had a character, in the pieces that were to be examined, that is
; outside of the ASCII range (32-126) a 1 is returned; otherwise returns ZERO
;
N BAD,DONE,IBI,IBY,PCE,STRNG,XX
S IBY="",BAD=0
I '$G(PIECES) S PIECES=1
F PCE=1:1:$L(PIECES,";") S XX=$P(PIECES,";",PCE) D
. S STRNG=$P(VALUE,HLECH,XX),DONE=0
. I STRNG'="" F IBI=1:1 S IBY=$E(STRNG,IBI) Q:IBY="" D Q:DONE
.. I $A(IBY)<32!($A(IBY)>126) D Q
... S (DONE,BAD)=1 ;Foreign character found
... I $G(BLANK) S $P(VALUE,HLECH,XX)=""
Q BAD
;
FILTER(STR,FLT) ; Filter Insurance Name, Group Name or Number
;IBFLT A^B^C
; A - 1 - Search for Name(s) that begin with
; the specified text (case insensitive)
; 2 - Search for Name(s) that contain
; the specified text (case insensitive)
; 3 - Search for Name(s) in a specified
; range (inclusive, case insensitive)
; 4 - Search for Name(s) that are blank (null)
; 5 - Filter by Selected Payer only (ONLY used by 'eIV Auto Update Report' (IBCNERPF)) ;IB*737/CKB
; B - Begin with text if A=1, Contains Text if A=2 or
; the range start if A=3
; C - Range End text (only present when A=3)
;OUTPUT:
; OK - 0 - Does not match Filter, do not include
; 1 - Matches Filter, include
;
N BEG,CHR,END,OK,TYPE,YY
S STR=$$UP^XLFSTR(STR)
S TYPE=$P(FLT,U,1)
S BEG=$$UP^XLFSTR($P(FLT,U,2))
S END=$$UP^XLFSTR($P(FLT,U,3))
S OK=0
;IB*737/CKB - added Payer (TYPE=5)
;Payer
I TYPE=5 S OK=1 G FILTERX
;Blank
I TYPE=4 D G FILTERX
. I STR="" S OK=1
;Test begins with
I TYPE=1 D G FILTERX
. I ($E(STR,1,$L(BEG))=BEG) S OK=1
;Test contains
I TYPE=2 D G FILTERX
. I (STR[BEG) S OK=1
;Test range
I TYPE=3 D G FILTERX
. N XX
. S XX=$E(STR,1,$L(BEG))
. I XX=BEG D Q
.. S YY=$E(STR,1,$L(END)) I YY]END Q
.. S OK=1 ;Matches begining characters of BEG - include
. I XX']BEG Q ;Preceeds Beg search
. S XX=$E(STR,1,$L(END))
. I XX=END S OK=1 Q ;Matches beginning characters of END - include
. I XX]END Q ;Follows End search
. S OK=1
FILTERX ; Exit
Q OK
;
VALIDDT(X) ; Check for validate date (internal form of the date) ;IB*737/CKB
; Input: X - internal date, FM format
; Returns: Y - if date if NOT valid, returns -1
; if the date is "" (null), returns a "" (null)
; if valid date, returns the internal date
N %DT,Y
Q:X="" ""
S %DT="X" D ^%DT
Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNINSU 6202 printed Nov 22, 2024@17:26:01 Page 2
IBCNINSU ;AITC/TAZ - GENERAL INSURANCE UTILITIES ;8/20/20 12:46p.m.
+1 ;;2.0;INTEGRATED BILLING;**668,687,713,737**;21-MAR-94;Build 19
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
PAYER(PIEN,APP,FLDS,FLGS,ARRAY) ;Payer Data Retrieval
+1 ;INPUT
+2 ; * = required input
+3 ; * PIEN - Payer IEN
+4 ; APP - EIV - Returns all fields for Payer Level and EIV level of file (overrides FLDS)
+5 ; - IIU - Returns all fields for Payer Level and IIU level of file (overrides FLDS)
+6 ; * FLDS - Required only if APP is null; If APP is populated this parameter is ignored
+7 ; - A single field number
+8 ; - A list of field numbers, separated by semicolons
+9 ; - A range of field numbers, in the form M:N, where M and N are the end points of the inclusive range.
+10 ; All field numbers within this range are retrieved.
+11 ; - * for all fields at the top level (no sub-multiple record).
+12 ; - ** for all fields including all fields and data in sub-multiple fields.
+13 ; - Field number of a multiple followed by an * to indicate all fields and records in the sub-multiple
+14 ; for that field.
+15 ; FLGS - E Returns External values in nodes ending with "E".
+16 ; - I Returns Internal values in nodes ending with "I".
+17 ; - NULL Returns External values.
+18 ; * ARRAY - Name of the Array that will contain the data (passed by reference)
+19 ;
+20 ;OUTPUT
+21 ; ARRAY - Data requested is returned in the array that was passed by reference
+22 ;
+23 NEW APPIEN,APPIENI,IENS
+24 IF '$GET(PIEN)
SET ARRAY(0)="Payer IEN is null or invalid"
GOTO PAYERX
+25 IF $GET(APP)=""
IF ($GET(FLDS)="")
SET ARRAY(0)="No fields requested."
GOTO PAYERX
+26 SET FLGS=$GET(FLGS)
+27 IF $GET(APP)'=""
Begin DoDot:1
+28 SET APPIEN=$$FIND1^DIC(365.13,,,APP)
IF 'APPIEN
SET ARRAY(0)="Invalid Application"
QUIT
+29 ; Get the app's internal id for the current payer.
SET APPIENI=$ORDER(^IBE(365.12,PIEN,1,"B",APPIEN,""))
+30 ; Get all fields at Top Level
+31 SET IENS=PIEN_","
SET FLDS="*"
+32 DO GETS^DIQ(365.12,IENS,FLDS,FLGS,"ARRAY")
+33 ; Get all fields at Application Level
+34 ;ignores the log data (history of the settings)
SET IENS=APPIENI_","_IENS
SET FLDS=".01:5.01"
+35 DO GETS^DIQ(365.121,IENS,FLDS,FLGS,"ARRAY")
End DoDot:1
GOTO PAYERX
+36 SET IENS=PIEN_","
+37 DO GETS^DIQ(365.12,IENS,FLDS,FLGS,"ARRAY")
+38 ;
PAYERX ; Exit subroutine
+1 QUIT
+2 ;
PYRDEACT(PIEN) ;Check if payer is deactivated
+1 ;INPUT
+2 ; PIEN - Payer IEN
+3 ;OUTPUT
+4 ; DEACTIVATE - Payer Deactivated (Internal Format)
+5 ; 0 - No
+6 ; 1 - Yes
+7 ; DATE/TIME DEACTIVATE - Date and Time the Payer was deactivated (Internal Fileman Format)
+8 ;
+9 NEW PYRARR,IENS
+10 SET IENS=PIEN_","
+11 DO PAYER(PIEN,,".07;.08","I",.PYRARR)
+12 ;
+13 QUIT PYRARR(365.12,IENS,.07,"I")_U_PYRARR(365.12,IENS,.08,"I")
+14 ;
STOP() ; Determine if user wants to exit out of the whole option
+1 ; Init vars
+2 NEW DIR,DIRUT,STOP,X,Y
+3 ;
+4 WRITE !
+5 SET DIR(0)="Y"
+6 SET DIR("A")="Do you want to exit out of this option entirely"
+7 SET DIR("B")="YES"
+8 SET DIR("?",1)=" Enter YES to immediately exit out of this option."
+9 SET DIR("?")=" Enter NO to return to the previous question."
+10 DO ^DIR
KILL DIR
+11 IF $DATA(DIRUT)
SET (STOP,Y)=1
GOTO STOPX
+12 IF 'Y
SET STOP=0
+13 ;
STOPX ; STOP exit pt
+1 QUIT Y
+2 ;
FOREIGN(VALUE,PIECES,BLANK) ; check for ASCII chars outside (32-126 inclusive)
+1 ;INPUT:
+2 ; VALUE = the string/field to check
+3 ; PIECES = populate if a subcomponent has to be checked (defaults as 1)
+4 ; BLANK = populated if the value is to be cleared out if foreign char
+5 ; is encountered (1 tells program to clear out field if it cotains foreign)
+6 ;
+7 ; I VALUE had a character, in the pieces that were to be examined, that is
+8 ; outside of the ASCII range (32-126) a 1 is returned; otherwise returns ZERO
+9 ;
+10 NEW BAD,DONE,IBI,IBY,PCE,STRNG,XX
+11 SET IBY=""
SET BAD=0
+12 IF '$GET(PIECES)
SET PIECES=1
+13 FOR PCE=1:1:$LENGTH(PIECES,";")
SET XX=$PIECE(PIECES,";",PCE)
Begin DoDot:1
+14 SET STRNG=$PIECE(VALUE,HLECH,XX)
SET DONE=0
+15 IF STRNG'=""
FOR IBI=1:1
SET IBY=$EXTRACT(STRNG,IBI)
if IBY=""
QUIT
Begin DoDot:2
+16 IF $ASCII(IBY)<32!($ASCII(IBY)>126)
Begin DoDot:3
+17 ;Foreign character found
SET (DONE,BAD)=1
+18 IF $GET(BLANK)
SET $PIECE(VALUE,HLECH,XX)=""
End DoDot:3
QUIT
End DoDot:2
if DONE
QUIT
End DoDot:1
+19 QUIT BAD
+20 ;
FILTER(STR,FLT) ; Filter Insurance Name, Group Name or Number
+1 ;IBFLT A^B^C
+2 ; A - 1 - Search for Name(s) that begin with
+3 ; the specified text (case insensitive)
+4 ; 2 - Search for Name(s) that contain
+5 ; the specified text (case insensitive)
+6 ; 3 - Search for Name(s) in a specified
+7 ; range (inclusive, case insensitive)
+8 ; 4 - Search for Name(s) that are blank (null)
+9 ; 5 - Filter by Selected Payer only (ONLY used by 'eIV Auto Update Report' (IBCNERPF)) ;IB*737/CKB
+10 ; B - Begin with text if A=1, Contains Text if A=2 or
+11 ; the range start if A=3
+12 ; C - Range End text (only present when A=3)
+13 ;OUTPUT:
+14 ; OK - 0 - Does not match Filter, do not include
+15 ; 1 - Matches Filter, include
+16 ;
+17 NEW BEG,CHR,END,OK,TYPE,YY
+18 SET STR=$$UP^XLFSTR(STR)
+19 SET TYPE=$PIECE(FLT,U,1)
+20 SET BEG=$$UP^XLFSTR($PIECE(FLT,U,2))
+21 SET END=$$UP^XLFSTR($PIECE(FLT,U,3))
+22 SET OK=0
+23 ;IB*737/CKB - added Payer (TYPE=5)
+24 ;Payer
+25 IF TYPE=5
SET OK=1
GOTO FILTERX
+26 ;Blank
+27 IF TYPE=4
Begin DoDot:1
+28 IF STR=""
SET OK=1
End DoDot:1
GOTO FILTERX
+29 ;Test begins with
+30 IF TYPE=1
Begin DoDot:1
+31 IF ($EXTRACT(STR,1,$LENGTH(BEG))=BEG)
SET OK=1
End DoDot:1
GOTO FILTERX
+32 ;Test contains
+33 IF TYPE=2
Begin DoDot:1
+34 IF (STR[BEG)
SET OK=1
End DoDot:1
GOTO FILTERX
+35 ;Test range
+36 IF TYPE=3
Begin DoDot:1
+37 NEW XX
+38 SET XX=$EXTRACT(STR,1,$LENGTH(BEG))
+39 IF XX=BEG
Begin DoDot:2
+40 SET YY=$EXTRACT(STR,1,$LENGTH(END))
IF YY]END
QUIT
+41 ;Matches begining characters of BEG - include
SET OK=1
End DoDot:2
QUIT
+42 ;Preceeds Beg search
IF XX']BEG
QUIT
+43 SET XX=$EXTRACT(STR,1,$LENGTH(END))
+44 ;Matches beginning characters of END - include
IF XX=END
SET OK=1
QUIT
+45 ;Follows End search
IF XX]END
QUIT
+46 SET OK=1
End DoDot:1
GOTO FILTERX
FILTERX ; Exit
+1 QUIT OK
+2 ;
VALIDDT(X) ; Check for validate date (internal form of the date) ;IB*737/CKB
+1 ; Input: X - internal date, FM format
+2 ; Returns: Y - if date if NOT valid, returns -1
+3 ; if the date is "" (null), returns a "" (null)
+4 ; if valid date, returns the internal date
+5 NEW %DT,Y
+6 if X=""
QUIT ""
+7 SET %DT="X"
DO ^%DT
+8 QUIT Y
