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

IBCNBCD1.m

Go to the documentation of this file. 
  1. IBCNBCD1 ;ALB/AWC - MCCF FY14 Display Annual Benefits from Insurance Buffer entry ;25 Feb 2015
  1.  ;;2.0;INTEGRATED BILLING;**528**;21-MAR-94;Build 163
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  ;* Note:  The following Input Parameters descriptions are used for routines IBCNBCD1, IBCNBCD2, IBCNBCD3 and IBCNBCD4
  1.  ;
  1.  ;Input Parameters:
  1.  ;  DFN     : Internal number of an entry in the PATIENT File (#2)
  1.  ;  IBDFN   : Internal number of an entry in the PATIENT File (#2)
  1.  ;  IBBUFDA : Insurance Verification Processor DA
  1.  ;  IBGRPDA : Insurance Group Plan DA
  1.  ;  IBPOLDA : Insurance Group Plan Policy DA
  1.  ;  IBQ     : Variable used to Quit (1=No, 0=Yes, ^=YES)
  1.  ;  IBERR   : Variable used if error ocurred (If set then error ocurred)
  1.  ;  IBLIST  : Global to hold Annual Benefits information (Populate using indirecton)
  1.  ;  IBHOLD  : Global to hold Annual Benefits information (Populate using indirecton)
  1.  ;  IBIEN   : Variable to hold Annual Benefit record IEN
  1.  ;  IBDA    : Variable to hold Annual Benefit record DA
  1.  ;  IBDATE  : Variable used to hold user selected/entered Date
  1.  ;  IBSYS   : (*** DO NOT KILL ***) Global to hold VistA System Annual Benefits record for comparison (Populate using indirecton)
  1.  ;  IBASAV  : Global used to save off data used for comparison
  1.  ;  IBGSAV  : Global to hold Annual Benefits information for comparison (Populate using indirecton)
  1.  ;  IBFLDS  : Variable to hold Annual Benefits field numbers
  1.  ;  IBRTYP  : Read Type and Input modifiers^Input Parameters^Input Transform (Required)
  1.  ;  IBPROM  : Prompt text that user will see
  1.  ;  IBDFLT  : Default response
  1.  ;  IBHELP  : Help text to display
  1.  ;  IBSCRN  : Screen for pointer, set-of-code, and list/range reads
  1.  ;  IBCOMM  : Global to hold Coverage Limitations comments (Populated using indirection)
  1.  ;  IBSIEN  : Patient Insurance Subfile IEN's
  1.  ;  IBRIEN  : Patient Insurance Subfile IEN's
  1.  ;  IBFNAM  : File name used in variable pointer
  1.  ;  IBRESULT: Array to return FM error message if there are errors when filing data
  1.  ;  IBTYPE  : - 1 = Merge (only buffer data moved to blank fields in ins file, no replace)
  1.  ;              2 = Overwrite (all buffer data moved to ins file, replace existing data)
  1.  ;              3 = Replace (all buffer data including null move to ins file)
  1.  ;              4 = Individually Accept (Skip Blanks) (user accepts individual diffs b/w buffer data and existing file data (excl blanks) to overwrite flds (or addr grp) in existing file)
  1.  ;  IBTXT   : Text use to display to screen or reports
  1.  ;  IBDATA  : Indirection variable to hold data in ^TMP( global
  1.  ;  IBDTL   : Indirection variable to hold dates in ^TMP( global
  1.  ;  IBDR    : Variable to hold DR value
  1.  ;  IBCAT   : Standard IENS indicating internal entry numbers
  1.  ;  IBPL    : Plan Coverage Limitation DA values
  1.  ;  IBPLAN  : Indirection variable to hold Plan Coverage Limitation data held in the ^TMP( global
  1.  ;  IBVAL   : Patient's relationship code
  1.  ;  IBSEL   : 
  1.  ;  IBEXTDA : ifn of insurance entry to update (#36,355.3,2)
  1.  ;  RESULT  : Output array to return FM error message if there are errors when filing the buffer data
  1.  ;  SKPBLANK: Flag - If set to 1, then when skipping blanks, display skipped items without bold
  1.  ;
  1. ANNBEN(IBBUFDA,IBGRPDA,IBASAV,IBQ,IBERR) ; Annual Benefits Entry point. - Called from routine ACANB^IBCNBAA
  1.  N IBDA,IBIEN,IBDTL,IBDATA,IBHOLD,IBDATE,IBLK,IBOUT,IBEDIT,IBPOL
  1.  S IBPOL=$$GET1^DIQ(355.3,IBGRPDA_",",2.01,,,"IBERR") I $D(IBERR) W !,"Error... ANNBEN-IBCNBCD1  Cannot get Policy field: "_2.01 D PAUSE^VALM1 Q 
  1.  ;
  1.  F  S IBQ=$$ASKREV() Q:IBQ'=1!($D(DTOUT))  D  Q:$D(IBERR)
  1.  . ;
  1.  . ; -- display list of dates for annual benefits
  1.  . D ABDTS(IBGRPDA,.IBDTL)
  1.  . ;
  1.  . ; -- prompt user to select a annual benefit year
  1.  . S IBDATE=$$ASKYR() Q:($E(IBDATE)=U)!($D(DTOUT))
  1.  . ;
  1.  . S IBIEN=0
  1.  . ; -- get the annual benefits data for selected date
  1.  . D ABDATA(IBDATE,.IBIEN,.IBDTL,.IBDATA,.IBERR) Q:$D(IBERR)
  1.  . ;
  1.  . ; -- user selected a date from the display list
  1.  . I +IBIEN D  Q
  1.  . . ;
  1.  . . ; -- display the annual benefits for selected year
  1.  . . S IBOUT=$$ABDISP^IBCNBCD3(IBIEN,.IBDATA,IBPOL) I IBOUT D ABCLN Q
  1.  . . ;
  1.  . . ; -- edit annual benefits
  1.  . . S IBEDIT=$$EDTYR(IBDATE) I IBEDIT D ABEDIT(IBIEN,.IBASAV,.IBDATA,IBDATE,IBPOL,.IBERR),ABCLN
  1.  . ;
  1.  . ; -- user entered a new date not found in the display list
  1.  . I 'IBIEN D ABDCRE(IBGRPDA,.IBIEN,.IBDATE,.IBASAV,.IBHOLD,.IBDATA,.IBERR)
  1.  ;
  1.  D ABCLN
  1.  Q
  1.  ;
  1. ABDTS(IBGRPDA,IBDTL) ; Display a list of Annual Benefits Years to select
  1.  N IBIEN,IBRET,IBDT,IBIDT,IBXDT
  1.  ;
  1.  S IBDTL=$NA(^TMP("IBCNBCD1 ABLIST DATES",$J))
  1.  K @IBDTL
  1.  ;
  1.  S IBDT=""
  1.  F  S IBDT=$O(^IBA(355.4,"APY",IBGRPDA,IBDT)) Q:IBDT']""  D
  1.  . ;
  1.  . ; -- annual benefits record IEN
  1.  . S IBIEN=$O(^IBA(355.4,"APY",IBGRPDA,IBDT,0))
  1.  . ;
  1.  . ; -- convert fileman date to external date
  1.  . S IBIDT=-(IBDT) D DT^DILF("E",IBIDT,.IBRET) S IBXDT=$G(IBRET(0))
  1.  . ;
  1.  . ; -- put dates in assending order  -  example: S @IBDTL@(nncyyddmm,IEN)=mmm dd, yyyy
  1.  . I IBXDT["JAN" S @IBDTL@(11_IBIDT,IBIEN)=IBXDT Q
  1.  . I IBXDT["FEB" S @IBDTL@(12_IBIDT,IBIEN)=IBXDT Q
  1.  . I IBXDT["MAR" S @IBDTL@(13_IBIDT,IBIEN)=IBXDT Q
  1.  . I IBXDT["APR" S @IBDTL@(14_IBIDT,IBIEN)=IBXDT Q
  1.  . I IBXDT["MAY" S @IBDTL@(15_IBIDT,IBIEN)=IBXDT Q
  1.  . I IBXDT["JUN" S @IBDTL@(16_IBIDT,IBIEN)=IBXDT Q
  1.  . I IBXDT["JUL" S @IBDTL@(17_IBIDT,IBIEN)=IBXDT Q
  1.  . I IBXDT["AUG" S @IBDTL@(18_IBIDT,IBIEN)=IBXDT Q
  1.  . I IBXDT["SEP" S @IBDTL@(19_IBIDT,IBIEN)=IBXDT Q
  1.  . I IBXDT["OCT" S @IBDTL@(20_IBIDT,IBIEN)=IBXDT Q
  1.  . I IBXDT["NOV" S @IBDTL@(21_IBIDT,IBIEN)=IBXDT Q
  1.  . I IBXDT["DEC" S @IBDTL@(22_IBIDT,IBIEN)=IBXDT
  1.  ;
  1.  W !!,"Benefit year:",!
  1.  F IBDT=0:0 S IBDT=$O(@IBDTL@(IBDT)) Q:IBDT'>0  S IBIEN=$O(@IBDTL@(IBDT,0)) W ?2,@IBDTL@(IBDT,IBIEN),!
  1.  Q
  1.  ;
  1. ABDATA(IBDATE,IBIEN,IBDTL,IBDATA,IBERR) ; get the annual benefits data for the user selected date
  1.  N IBI,IBDT,IBOUT,IBFLDS
  1.  ;
  1.  S IBDATA=$NA(^TMP("IBCNBCD1 ABDATA DATA",$J))
  1.  K @IBDATA
  1.  ;
  1.  D ABGFLD(.IBFLDS)
  1.  ;
  1.  S IBI="",IBDT=+IBDATE,IBOUT=0
  1.  F  S IBI=$O(@IBDTL@(IBI)) Q:IBI']""!(IBOUT)!($D(IBERR))  D
  1.  . ;
  1.  . ; -- populate the IBDATA temp global with the annual benefits data
  1.  . I $E(IBI,3,$L(IBI))=IBDT D
  1.  . . S IBIEN=$O(@IBDTL@(IBI,0))
  1.  . . D GETS^DIQ(355.4,IBIEN_",",.IBFLDS,"IE",.IBDATA,"IBERR") I $D(IBERR) W !,"***Error...ABDATTA^IBCNBCD1 Cannot retrieve Annual Benefits data fields." D PAUSE^VALM1 Q
  1.  . . S IBOUT=1
  1.  Q
  1.  ;
  1. ABDCRE(IBGRPDA,IBIEN,IBDATE,IBASAV,IBHOLD,IBDATA,IBERR) ; Display/Edit Annual Benefits for newly created date
  1.  N X,Y,DA,DIC,DIE,DO,IBDTL,DLAYGO,DIRUT
  1.  ;
  1.  ; -- ask user to create new benifit year
  1.  I '$$CREYR(IBDATE) Q
  1.  ;
  1.  S DIC="^IBA(355.4,",DIC(0)="L",DLAYGO=355.4,X=+IBDATE
  1.  D FILE^DICN I +Y<0 S IBERR=1 W !,!,"***Error... ABDCRE^IBCNBCD1 - Cannot Create New Annual Benefit Record" D PAUSE^VALM1 Q
  1.  ;
  1.  ; -- update the stub record
  1.  S (IBIEN,DA)=+Y,DIE="^IBA(355.4,",DR=".02///"_IBGRPDA
  1.  ;
  1.  D ^DIE K DIC,DIE,DA,DR
  1.  ;
  1.  ; -- put exitsing data into tmp global
  1.  S IBDTL=$NA(^TMP("IBCNBCD1 ABLIST DATES",$J))
  1.  K @IBDTL
  1.  S @IBDTL@(99_+IBDATE,IBIEN)=$P(IBDATE,U,2)
  1.  ;
  1.  ; -- get the annual benefits data
  1.  D ABDATA(IBDATE,IBIEN,.IBDTL,.IBDATA,.IBERR) Q:$D(IBERR)
  1.  ;
  1.  ; -- edit annual benefits for that year
  1.  D ABEDIT(IBIEN,.IBASAV,.IBDATA,IBDATE,IBPOL,.IBERR)
  1.  Q
  1.  ;
  1. ABEDIT(IBIEN,IBASAV,IBDATA,IBDATE,IBPOL,IBERR) ; -- Edit Patient Annual Benefits
  1.  N IBDIF,IBOUT,IBSYS,IBGSAV
  1.  ;
  1.  I +$G(IBIEN) L +^IBA(355.4,IBIEN):5 I '$T D ABLKD Q
  1.  ;
  1.  ; ***** DO NOT KILL IBSYS *****    
  1.  S IBSYS=$NA(^IBA(355.4,IBIEN)) ; -- **** CAUTION using Vista System Annual Benefits Global ****
  1.  ; ***** DO NOT KILL IBSYS *****    
  1.  ;
  1.  ; -- save Annual Benefits data
  1.  D ABSAVE(.IBSYS,.IBGSAV)
  1.  ;
  1.  ; -- edit annual benefits data  /  quit if user deleted record
  1.  S IBOUT=$$ABEDT(IBIEN,IBGRPDA,IBDATE,IBPOL,.IBERR) Q:'$D(@IBSYS)!(+$G(IBERR))
  1.  ;
  1.  ; -- check for any changes made to annual benefits
  1.  S IBDIF=$$ABDIF(.IBSYS,.IBGSAV)
  1.  ;
  1.  ; -- timed out ocurred and no changes
  1.  I IBOUT&('IBDIF) D ABOUT(IBIEN) Q
  1.  ;
  1.  ; -- timed out with changes to annual benefits
  1.  I IBOUT&(IBDIF) D ABUNDO(IBIEN,.IBDATA,.IBERR),ABOUT(IBIEN) Q
  1.  ;
  1.  ; -- ask user to save the changes or not
  1.  I IBDIF S IBOUT=+$$ABASK() I 'IBOUT!(IBOUT']"") D ABUNDO(IBIEN,.IBDATA,.IBERR),ABOUT(IBIEN) Q
  1.  ;
  1.  S IBASAV=1 D ABOUT(IBIEN)
  1.  Q
  1.  ;
  1. ABEDT(IBIEN,IBGRPDA,IBDATE,IBPOL,IBERR) ; Main call to edit data in Annual Benefits via Input Template
  1.  N DA,DR,DIE,DTOUT
  1.  ;
  1.  W !!,"---------------------- EDIT ANNUAL BENEFITS INFORMATION  ----------------------",!
  1.  ;
  1.  ; -- use the input template that is stored in file 355.4 to edit annual benefits fields
  1.  ; -- the fields are ".05;.06;2.01:2.15;2.17;3.01:3.09;4.01:4.09;5.01:5.08:5.1:5.12;5.14"
  1.  ; -- the user will not be able to edit the .01 and .02 fields
  1.  S DA=IBIEN,DR="[IBCN AB ACCEPT]",DIE="^IBA(355.4,"
  1.  D ^DIE
  1.  Q $D(DTOUT)
  1.  ;
  1. ABUNDO(IBIEN,IBDATA,IBERR) ; - undo any annual benefits edits
  1.  N IBN,IBFLD,IBFDA
  1.  S IBFDA=$NA(^TMP("IBCNBCD1 AB FDA",$J))
  1.  K @IBFDA
  1.  ;
  1.  S IBN=IBIEN_","
  1.  F IBFLD=".01":0 S IBFLD=$O(@IBDATA@(355.4,IBN,IBFLD)) Q:IBFLD'>0  S @IBFDA@(355.4,IBN,IBFLD)=$G(@IBDATA@(355.4,IBN,IBFLD,"I"))
  1.  ;
  1.  D FILE^DIE("I",.IBFDA,"IBERR") I $D(IBERR) W !,!,"***Error...ABUNDO^IBCNBCD1 - Cannot undo changes to the Annual Benefits file! ",! D PAUSE^VALM1
  1.  Q
  1.  ;
  1. ABGFLD(IBFLDS) ; Put fields into one string
  1.  S IBFLDS=".01;.02;.05;.06"
  1.  S IBFLDS=IBFLDS_";2.01;2.02;2.03;2.04;2.05;2.06;2.07;2.08;2.09;2.1;2.11;2.12;2.13;2.14;2.15;2.17"
  1.  S IBFLDS=IBFLDS_";3.01;3.02;3.03;3.04;3.05;3.06;3.07;3.08;3.09"
  1.  S IBFLDS=IBFLDS_";4.01;4.02;4.03;4.04;4.05;4.06;4.07;4.08;4.09"
  1.  S IBFLDS=IBFLDS_";5.01;5.02;5.03;5.04;5.05;5.06;5.07;5.08;5.09;5.1;5.11;5.12;5.14"
  1.  Q
  1.  ;
  1. ABSAVE(IBSYS,IBGSAV) ; -- save the global before editing
  1.  S IBGSAV=$NA(^TMP("IBCNBCD1 AB GLOBAL SAVE",$J))
  1.  K @IBGSAV
  1.  ;
  1.  S @IBGSAV@(0)=$G(@IBSYS@(0))
  1.  S @IBGSAV@(1)=$G(@IBSYS@(1))
  1.  S @IBGSAV@(2)=$G(@IBSYS@(2))
  1.  S @IBGSAV@(3)=$G(@IBSYS@(3))
  1.  S @IBGSAV@(4)=$G(@IBSYS@(4))
  1.  S @IBGSAV@(5)=$G(@IBSYS@(5))
  1.  Q
  1.  ;
  1. ABDIF(IBSYS,IBGSAV) ; -- check for any edits made to annual benefits
  1.  I $G(@IBSYS@(0))'=$G(@IBGSAV@(0)) Q 1
  1.  I $G(@IBSYS@(1))'=$G(@IBGSAV@(1)) Q 1
  1.  I $G(@IBSYS@(2))'=$G(@IBGSAV@(2)) Q 1
  1.  I $G(@IBSYS@(3))'=$G(@IBGSAV@(3)) Q 1
  1.  I $G(@IBSYS@(4))'=$G(@IBGSAV@(4)) Q 1
  1.  I $G(@IBSYS@(5))'=$G(@IBGSAV@(5)) Q 1
  1.  Q 0
  1.  ;
  1. ABOUT(IBIEN) ; -- Set return variable and unlock global
  1.  I +$G(IBIEN) L -^IBA(355.4,IBIEN)
  1.  Q
  1.  ;
  1. ABCLN ; Clean up ^TMP globals
  1.  K ^TMP("IBCNBCD1 HOLD DATA",$J),^TMP("IBCNBCD1 AB GLOBAL SAVE",$J),^TMP("IBCNBCD1 ABLIST DATES",$J),^TMP("IBCNBCD1 ABDATA DATA",$J)
  1.  Q
  1.  ;
  1. ABLKD ; -- write locked message
  1.  W !!,"Sorry, another user currently editing this entry."
  1.  W !,"Try again later."
  1.  D PAUSE^VALM1
  1.  Q
  1.  ;
  1. ABASK() ; Prompt to ask user to Save Changes
  1.  Q $E($$READ^IBCNBAA("YA^::E","Save Changes to Annual Benefits File Y/N? ","No","Enter Yes or No to Save the Changes to the AB File <or> ^ to Quit"))
  1.  ;
  1. ASKREV() ; Prompt to ask user to Review the Annual Benefits
  1.  Q $E($$READ^IBCNBAA("YA^::E","Do you want to Review the AB Y/N? ","No","Enter Yes or No to Review the Annual Benefits <or> ^ to Quit"))
  1.  ;
  1. ABDEDT() ; ask user if they want to Edit the Annual Benefits
  1.  N IBSCR
  1.  S IBSCR="FO^1:4^K:($E(X)'=""E""&($E(X)'=""e""))!($L(X)=4&(($E(X,1,4)'=""EDIT"")&($E(X,1,4)'=""edit""))) X"
  1.  Q $$READ^IBCNBAA(IBSCR,"Enter 'E' to Edit Annual Benefits data or Return to continue","","Enter 'E' to edit Annual Benefits data <or> Return to continue <or> ^ to quit.")
  1.  ;
  1. ASKYR() ; Prompt to Enter a New or Existing AB year
  1.  Q $$READ^IBCNBAA("DA^::EX","Enter Existing Date or Add New Benefit Year:  ","","Enter a New/Existing Benefit Year Date <or> ^ to Quit")
  1.  ;
  1. EDTYR(IBDATE) ; Prompt to Edit an Existing AB year
  1.  Q +$$READ^IBCNBAA("YA^::E","Are you sure you want to edit existing benefit year information for: "_$P(IBDATE,U,2)_" Y/N?: ","","Enter Yes or No to Edit the Benefit Year")
  1.  ;
  1. CREYR(IBDATE) ; Prompt to Create a new AB year
  1.  Q +$$READ^IBCNBAA("YA^::E","Are you sure you want to create a new benefit year for:  "_$P(IBDATE,U,2)_" Y/N? ","","Enter Yes or No to Create a new Benefit Year Date")