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

IBCNEUT6.m

Go to the documentation of this file.
  1. IBCNEUT6 ;DAOU/ESG - IIV MISC. UTILITIES ;14-AUG-2002
  1. ;;2.0;INTEGRATED BILLING;**184,252,271,566,668,687**;21-MAR-94;Build 88
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ; Can't be called from the top
  1. ;
  1. ; IA 10076 - To access ^XUSEC global for security key check
  1. Q
  1. ;
  1. AMCHECK ; This procedure will examine the insurance company names in the
  1. ; Auto Match file (#365.11) to make sure there is still at least
  1. ; one active insurance company with that name. If there isn't,
  1. ; then the Auto Match entries for that insurance company name
  1. ; will be deleted.
  1. ;
  1. NEW NAME,INSIEN,FOUNDACT,DA,DIK,DIC,X,Y,%
  1. S NAME=""
  1. F S NAME=$O(^IBCN(365.11,"C",NAME)) Q:NAME="" D
  1. . ;
  1. . ; For this Auto Match ins co name, see if there is an active ins co
  1. . S INSIEN=0,FOUNDACT=0
  1. . F S INSIEN=$O(^DIC(36,"B",NAME,INSIEN)) Q:'INSIEN I $$ACTIVE^IBCNEUT4(INSIEN) S FOUNDACT=1 Q
  1. . ;
  1. . ; If an active ins co was found, then we're OK so quit
  1. . I FOUNDACT Q
  1. . ;
  1. . ; Otherwise, we need to delete all Auto Match entries for this name
  1. . S DA=0,DIK="^IBCN(365.11,"
  1. . F S DA=$O(^IBCN(365.11,"C",NAME,DA)) Q:'DA D ^DIK
  1. . Q
  1. AMCHKX ;
  1. Q
  1. ;
  1. ;
  1. AMADD(INSNAME,IBCNEXT1) ; Conditionally add an Auto Match entry based on user input
  1. ; Input Parameters:
  1. ; INSNAME is a valid, active insurance company name
  1. ; IBCNEXT1 is the existing entry in the ins co name field in the
  1. ; buffer. This may be used as the Auto Match value for
  1. ; a new auto match entry.
  1. ;
  1. NEW AMDATA,AMIEN,AMERROR
  1. NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
  1. NEW D,D0,D1,DA,DB,DC,DDH,DE,DG,DH,DI,DIC,DIE,DIEL,DIFLD,DIG,DIH
  1. NEW DIK,DILN,DIPA,DISYS,DIV,DK,DL,DM,DN,DOV,DP,DQ,DR,DU,DV,DZ
  1. ;
  1. ;/vd-IB*2.0*687 - Changed the following line to address the renaming of the Security Key.
  1. ;I '$$KCHK^XUSRB("IBCNE EIV MAINTENANCE") G AMADDX
  1. I '$D(^XUSEC("IBCNE EIV IIU MAINTENANCE",DUZ)) G AMADDX ;IA 10076
  1. ;
  1. S IBCNEXT1=$$UP^XLFSTR(IBCNEXT1) ; all uppercase
  1. S IBCNEXT1=$$TRIM^XLFSTR(IBCNEXT1) ; lead/trail spaces
  1. I IBCNEXT1="" G AMADDX ; must exist
  1. I $L(IBCNEXT1)>30!($L(IBCNEXT1)<3) G AMADDX ; too long or too short
  1. I IBCNEXT1=INSNAME G AMADDX ; cannot equal the name
  1. I $D(^IBCN(365.11,"B",IBCNEXT1)) G AMADDX ; already in Auto Match
  1. I $D(^DIC(36,"B",IBCNEXT1)) G AMADDX ; already an ins co name
  1. I $D(^DIC(36,"C",IBCNEXT1)) G AMADDX ; already a synonym
  1. I IBCNEXT1["*" G AMADDX ; no wildcards allowed
  1. ;
  1. S DIR(0)="YO"
  1. S DIR("A",1)=" "
  1. S DIR("A",2)="Do you want to add an Auto Match entry that associates"
  1. S DIR("A")=IBCNEXT1_" with "_INSNAME
  1. S DIR("B")="No"
  1. S DIR("?",1)=" The Auto Match Value is "_IBCNEXT1_"."
  1. S DIR("?",2)="The Insurance Company Name is "_INSNAME_"."
  1. S DIR("?",3)=" "
  1. S DIR("?",4)="Please enter NO if you do not want to associate these two values together"
  1. S DIR("?",5)="in the Auto Match file."
  1. S DIR("?",6)=" "
  1. S DIR("?",7)="Please enter YES if you do want to create an Auto Match entry for these"
  1. S DIR("?",8)="two values. If you enter YES, then you will have the chance to modify"
  1. S DIR("?")="the Auto Match Value."
  1. D ^DIR K DIR
  1. D EN^DDIOL(,,"!!")
  1. ;
  1. ; If user didn't say Yes, then we exit
  1. I 'Y G AMADDX
  1. ; To allow for edits to the .01 field and not the .02 field,
  1. ; Add this new entry first and then edit only the .01 field.
  1. S AMDATA(365.11,"+1,",.01)=IBCNEXT1
  1. S AMDATA(365.11,"+1,",.02)=INSNAME
  1. S AMDATA(365.11,"+1,",.03)=$$NOW^XLFDT
  1. S AMDATA(365.11,"+1,",.04)=DUZ
  1. S AMDATA(365.11,"+1,",.05)=$$NOW^XLFDT
  1. S AMDATA(365.11,"+1,",.06)=DUZ
  1. S AMDATA(365.11,"+1,",.07)=IBCNEXT1
  1. S AMDATA(365.11,"+1,",.08)=INSNAME
  1. D UPDATE^DIE("","AMDATA","AMIEN","AMERROR")
  1. ;
  1. I $D(AMERROR) G AMADDX ; FileMan error so get out
  1. S AMIEN=+$G(AMIEN(1)) ; internal entry number created
  1. I 'AMIEN G AMADDX ; if IEN not there get out
  1. ;
  1. ; Here we have to edit the entry to allow for the opportunity to
  1. ; change something
  1. S DIE=365.11,DA=AMIEN,DR=".01;.05////"_$$NOW^XLFDT_";.06////"_DUZ
  1. D ^DIE
  1. ;
  1. ; Display the confirmation message to the user
  1. S AMDATA=$G(^IBCN(365.11,AMIEN,0))
  1. I AMDATA'="" D EN^DDIOL($P(AMDATA,U,1)_" is now associated with "_$P(AMDATA,U,2)_".",,"!!?3")
  1. D EN^DDIOL(,,"!!")
  1. AMADDX ;
  1. Q
  1. ;
  1. PYRFLTR() ;
  1. ; Function to assist with filtering items in custom payer
  1. ; lookups for most popular list. This logic is used in the
  1. ; DIC("S") definition for the lookup
  1. ;
  1. ;IB*2.0*668/TAZ - This functionality is no longer used and will be removed with a future User Story.
  1. Q 0
  1. ;
  1. NEW IBDATA,IBPIEN,IBPNM,IBAIEN,IBADATA,OK
  1. ;
  1. S OK=1
  1. ;
  1. S IBDATA=^(0) ; Naked reference from DIC call
  1. S IBPIEN=$G(Y) I IBPIEN="" S OK=0 G XPFLTR
  1. ;
  1. ; Set Payer Name and IEN
  1. S IBPNM=$P(IBDATA,U,1) I IBPNM="" S OK=0 G XPFLTR
  1. ;
  1. ; Set Payer Application IEN (365.13)
  1. ; Quit if IIV not defined for payer
  1. S IBAIEN=$$PYRAPP^IBCNEUT5("IIV",IBPIEN) I IBAIEN="" S OK=0 G XPFLTR
  1. ;
  1. ; Get IIV application specific data
  1. S IBADATA=$G(^IBE(365.12,IBPIEN,1,IBAIEN,0)) I IBADATA="" S OK=0 G XPFLTR
  1. ;
  1. ; Filter if Deactivated
  1. I +$P(IBADATA,U,11) S OK=0 G XPFLTR
  1. ;
  1. ; Filter if ID Inq Req ID and SSN is not ID
  1. I +$P(IBADATA,U,8),'$P(IBADATA,U,9) S OK=0 G XPFLTR
  1. ;
  1. ; Filter if already in the list
  1. I $D(^TMP($J,"IBJPI3-IENS",IBPIEN)) S OK=0 G XPFLTR
  1. ;
  1. XPFLTR Q OK
  1. ;
  1. DSPLINE() ;
  1. ; Format display text for custom Most Pop. payer lookup
  1. ;
  1. N ITEMDATA,DISPSTR,IBAIEN,IBADATA,PYRIEN,PADLEN
  1. ;
  1. ; Initialize the data for the item to be displayed
  1. ; Naked reference is referencing the DIC data
  1. S ITEMDATA=^(0)
  1. ;
  1. ; Initialize Display string
  1. S DISPSTR=""
  1. ;
  1. ; Payer IEN is passed from DIC as Y
  1. S PYRIEN=+$G(Y) I 'PYRIEN G EXDSP
  1. ;
  1. ; Set Payer Application IEN (365.13)
  1. S IBAIEN=$$PYRAPP^IBCNEUT5("IIV",PYRIEN) I IBAIEN="" G EXDSP
  1. ;
  1. ; Get IIV Application specific data
  1. S IBADATA=$G(^IBE(365.12,PYRIEN,1,IBAIEN,0)) I IBADATA="" G EXDSP
  1. ;
  1. ; Pad start of display data, adjusting for payer name length
  1. S PADLEN=$L($E($P($G(ITEMDATA),U),1,30))
  1. S DISPSTR=DISPSTR_$$FO^IBCNEUT1("",31-PADLEN,"L")
  1. ;
  1. ; Add National and Local active flags
  1. S DISPSTR=DISPSTR_" National: "_$$FO^IBCNEUT1($S('$P(IBADATA,U,2):"Inactive",1:"Active"),8)
  1. S DISPSTR=DISPSTR_" Local: "_$$FO^IBCNEUT1($S('$P(IBADATA,U,3):"Inactive",1:"Active"),8)
  1. EXDSP ;
  1. Q DISPSTR
  1. ;
  1. ;/vd-IB*2.0*687 - Added the following module of code for use by input templates
  1. CKAPS(IBPYR) ; Utility allow only for Payers that are active and have a valid IIV
  1. ; and/or IIU Payer application.
  1. ; OUTPUT:
  1. ; 0 = Not a valid Payer
  1. ; 1 = Valid Payer (Active and has either an IIV or IIU Payer Application)
  1. Q:'IBPYR 0
  1. I '$$PYRAPP^IBCNEUT5("EIV",+IBPYR),'$$PYRAPP^IBCNEUT5("IIU",+IBPYR) Q 0 ; Invalid Payer Application.
  1. Q 1
  1. ;