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

IBCNBCD2.m

Go to the documentation of this file.
  1. IBCNBCD2 ;ALB/AWC - MCCF FY14 Display Group Plan Coverage Limitations 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. ; Input Parameters:
  1. ; See routine IBCNBCD1
  1. ;
  1. COVLIM(IBBUFDA,IBGRPDA,IBCSAV,IBQ,IBERR) ; Coverage Limitations entry point. - Called from routine ACCOV^IBCNBAA
  1. N IBGSAV,IBSYS,IBDATE,IBDTL,IBFOUND,IBDATA,IBEDIT,IBOUT,IBPLAN,IBYES,IBTXT,IBN,DTOUT
  1. S IBN=0,IBTXT=""
  1. ;
  1. ; -- **** CAUTION DO NOT KILL ****
  1. N IBSYS S IBSYS=$NA(^IBA(355.32)) ; -- **** VistA System Coverage Limitation Global ****
  1. ; -- **** CAUTION DO NOT KILL ****
  1. ;
  1. ;
  1. F S IBQ=$$ASKREV() Q:IBQ'=1!($D(DTOUT)) D Q:$D(IBERR)
  1. . ;
  1. . ; -- display a list of coverage limitations years for the group policy
  1. . D CVDTS(IBGRPDA,.IBDTL)
  1. . ;
  1. . ; -- prompt user to select coverage limitation year
  1. . S IBDATE=$$ASKYR() Q:$E(IBDATE)=U!($D(DTOUT))
  1. . ;
  1. . ; -- get data for selected coverage limitation year
  1. . S IBFOUND=$$CVDATA(IBDATE,.IBDTL,.IBGSAV,.IBSYS,.IBDATA,.IBERR) Q:$D(IBERR)
  1. . ;
  1. . ; -- user entered a new date not found in the display list
  1. . I 'IBFOUND D Q:'IBYES!('IBFOUND)!($D(IBERR))
  1. . . ;
  1. . . ; -- ask user to create new benifit year
  1. . . S IBYES=$$CREYR(.IBDATE) Q:'IBYES
  1. . . ;
  1. . . ; -- create a new record entry
  1. . . D CVDLC(IBGRPDA,IBDATE,.IBDTL,.IBERR) Q:$D(IBERR)
  1. . . ;
  1. . . ; -- get data for newly created record
  1. . . S IBFOUND=$$CVDATA(IBDATE,.IBDTL,.IBGSAV,.IBSYS,.IBDATA,.IBERR) Q:$D(IBERR)
  1. . . S IBN=1
  1. . . ;
  1. . ;
  1. . ; -- get coverage plans and display coverage limitations for selected year
  1. . D CVPLAN(.IBPLAN) S IBOUT=$$CVDISP^IBCNBCD3(.IBDATA,.IBPLAN) Q:IBOUT
  1. . ;
  1. . ; -- edit coverage limitations
  1. . S IBTXT=$S(IBN:"the NEW",1:"existing")
  1. . S IBEDIT=$$EDTYR(IBDATE,IBTXT) I IBEDIT D CVEDIT(IBGRPDA,.IBGSAV,.IBSYS,IBDATE,.IBCSAV,.IBDATA,.IBERR)
  1. . S IBN=0
  1. . ;
  1. D CVOUT(.IBDATA)
  1. Q
  1. ;
  1. CVDTS(IBGRPDA,IBDTL) ; Display a list of Coverage Limitations Years to select
  1. N IBI,IBIEN,IBDT,IBXDT,IBIDT,IBRET
  1. ;
  1. S IBDTL=$NA(^TMP("IBCNBCD2 CVDTS DATES",$J))
  1. K @IBDTL
  1. ;
  1. F IBI=0:0 S IBI=$O(^IBA(355.32,"APCD",IBGRPDA,IBI)) Q:IBI'>0 D
  1. . S IBDT="" F S IBDT=$O(^IBA(355.32,"APCD",IBGRPDA,IBI,IBDT)) Q:IBDT="" D
  1. . . S IBIEN=$O(^IBA(355.32,"APCD",IBGRPDA,IBI,IBDT,0))
  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 !!,"Coverage Date:",!
  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. CVDATA(IBDATE,IBDTL,IBGSAV,IBSYS,IBDATA,IBERR) ; Get data for the selected year
  1. N IBI,IBJ,IBHOLD,IBFLDS,IBCDA,IBIEN,IBPLN,IBDAT,IBLOCK
  1. S IBDATA=$NA(^TMP("IBCNBCD2 CVDATA DATA",$J))
  1. S IBGSAV=$NA(^TMP("IBCNBCD2 IB CV GSAV",$J))
  1. K @IBDATA,@IBGSAV
  1. ; ;
  1. S IBDAT=0,IBFLDS=".02;.03;.04"
  1. ;
  1. F IBI=0:0 S IBI=$O(@IBDTL@(IBI)) Q:IBI'>0 I $E(IBI,3,$L(IBI))=+IBDATE D Q:$D(IBERR)
  1. . F IBIEN=0:0 S IBIEN=$O(@IBDTL@(IBI,IBIEN)) Q:IBIEN'>0 D Q:$D(IBERR)
  1. . . ;
  1. . . S IBHOLD=$NA(^TMP("IBCNBCD2 CVDATA HOLD",$J))
  1. . . K @IBHOLD
  1. . . D GETS^DIQ(355.32,IBIEN_",",.IBFLDS,"IE",.IBHOLD,"IBERR") I $D(IBERR) W !,"***Error...CVDATA^IBCNBCD2 Cannot retrieve Coverage Limitations data fields." D PAUSE^VALM1 Q
  1. . . S IBPLN=@IBHOLD@(355.32,IBIEN_",",.02,"E")
  1. . . M @IBDATA@(IBPLN)=@IBHOLD@(355.32,IBIEN_",")
  1. . . S @IBDATA@(IBPLN)=IBIEN ; -- top level so set it to the IEN
  1. . . S IBLOCK=$$CVLOCK(IBIEN,.IBSYS) I 'IBLOCK S IBERR=1 Q ; -- lock the record
  1. . . ;
  1. . . ; -- save off the system global data
  1. . . S @IBGSAV@(IBIEN,0)=$G(^IBA(355.32,IBIEN,0))
  1. . . S @IBGSAV@(IBIEN,1)=$G(^IBA(355.32,IBIEN,1))
  1. . . S @IBGSAV@(IBIEN,2,0)=$G(^IBA(355.32,IBIEN,2,0))
  1. . . ;
  1. . . F IBJ=0:0 S IBJ=$O(^IBA(355.32,IBIEN,2,IBJ)) Q:IBJ'>0 D
  1. . . . S @IBDATA@(IBPLN,"COMM",IBJ)=^IBA(355.32,IBIEN,2,IBJ,0)
  1. . . . S @IBGSAV@(IBIEN,2,IBJ,0)=$G(^IBA(355.32,IBIEN,2,IBJ,0)) ; -- save off the system global comments data
  1. ;
  1. I $D(@IBDATA) S IBDAT=1
  1. Q IBDAT
  1. ;
  1. CVPLAN(IBPLAN) ; Display/Edit Coverage Limitations for selected date
  1. N IBI,IBJ
  1. S IBPLAN=$NA(^TMP("IBCNBCD2 CVDSEL PLAN COV",$J))
  1. K @IBPLAN
  1. ;
  1. S IBI="" F S IBI=$O(^IBE(355.31,"B",IBI)) Q:IBI']"" S IBJ=$O(^IBE(355.31,"B",IBI,0)) S @IBPLAN@(IBI,IBJ)=""
  1. Q
  1. ;
  1. CVLOCK(IBIEN,IBSYS) ; Lock the Coverage Limitations records
  1. N IBOUT
  1. S IBOUT=1
  1. L +@IBSYS@(IBIEN):5 I '$T S IBOUT=0 D CVLKD
  1. Q IBOUT
  1. ;
  1. CVEDIT(IBGRPDA,IBGSAV,IBSYS,IBDATE,IBCSAV,IBDATA,IBERR) ; Edit Coverage Limitations via Input Template 355.32
  1. N IBI,IBIEN,IBDR,IBDIF,IBSAV,IBADD,IBOUT,IBPLC
  1. N IBIP,IBOP,IBPH,IBDN,IBMH,IBLT
  1. N IBCI,IBCO,IBCP,IBCD,IBCM,IBCL
  1. ;
  1. ; -- check if data for the coverage categories
  1. S (IBOP,IBIP,IBPH,IBLT,IBDN,IBMH)="" ; -- DA's of the IBDATA global holding the record location
  1. S (IBCI,IBCO,IBCP,IBCD,IBCM,IBCL)="" ; -- pointers to the PLAN LIMITATION CATEGORY FILE (#355.31)
  1. ;
  1. ; -- get plan limitation categories ien'S
  1. S IBPLC=$NA(^TMP("IBCNBCD2 IB PLAN LIM CATEGORIES",$J))
  1. K @IBPLC
  1. D LIST^DIC(355.31,,"@;.01E",,,,,"B",,,.IBPLC,"IBERR") I $D(IBERR) W !,"*** Error...CVEDIT^IBCNBCD2 Cannot access Plan Limitations Category File!" D PAUSE^VALM1 Q
  1. F IBI=0:0 S IBI=$O(@IBPLC@("ID",IBI)) Q:IBI'>0 D
  1. . I @IBPLC@("ID",IBI,.01)="DENTAL" S IBCD=@IBPLC@(2,IBI) Q
  1. . I @IBPLC@("ID",IBI,.01)="OUTPATIENT" S IBCO=@IBPLC@(2,IBI) Q
  1. . I @IBPLC@("ID",IBI,.01)="PHARMACY" S IBCP=@IBPLC@(2,IBI) Q
  1. . I @IBPLC@("ID",IBI,.01)="INPATIENT" S IBCI=@IBPLC@(2,IBI) Q
  1. . I @IBPLC@("ID",IBI,.01)="MENTAL HEALTH" S IBCM=@IBPLC@(2,IBI) Q
  1. . I @IBPLC@("ID",IBI,.01)="LONG TERM CARE" S IBCL=@IBPLC@(2,IBI)
  1. ;
  1. ; -- check if our data list contain plan coverage limitations
  1. S IBI=""
  1. F S IBI=$O(@IBDATA@(IBI)) Q:IBI']"" D
  1. . I IBI="INPATIENT" S IBIP=IBI Q
  1. . I IBI="OUTPATIENT" S IBOP=IBI Q
  1. . I IBI="PHARMACY" S IBPH=IBI Q
  1. . I IBI="DENTAL" S IBDN=IBI Q
  1. . I IBI="MENTAL HEALTH" S IBMH=IBI Q
  1. . I IBI="LONG TERM CARE" S IBLT=IBI
  1. ;
  1. ;
  1. W !!,"---------------------- EDIT COVERAGE LIMITATIONS INFORMATION -----------------------",!
  1. ;
  1. ; -- inpatient
  1. I IBIP]"" D Q:IBOUT!($D(IBERR))!($D(DTOUT))
  1. . S IBOUT=0,IBIEN=$G(@IBDATA@(IBIP)),IBDR="[IBCNBC CV IP EDIT]"
  1. . D EDTREC(IBIEN,IBDR) I $G(Y(0))="AUDIT" S IBOUT=1 Q
  1. . S IBDIF=$$CVDIF(.IBSYS,.IBGSAV,IBIEN),IBSAV=1
  1. . I IBDIF S IBSAV=$$CVASK()
  1. . I (IBDIF&('IBSAV))!($D(DTOUT)) D CVUNDO(IBIEN,IBIP,.IBSYS,.IBGSAV,.IBDATA,.IBERR) Q
  1. . I (IBDIF&(IBSAV))&('$D(DTOUT)) S IBCSAV=1
  1. I IBIP']"" S IBADD=$$ASKADD("INPATIENT",IBDATE) Q:IBADD=U I IBADD Q:'$$ADDCV(IBGRPDA,IBCI,IBDATE,.IBERR)
  1. ;
  1. ; -- outpatient
  1. I IBOP]"" D Q:IBOUT!($D(IBERR))!($D(DTOUT))
  1. . W ! S IBOUT=0,IBIEN=$G(@IBDATA@(IBOP)),IBDR="[IBCNBC CV OP EDIT]"
  1. . D EDTREC(IBIEN,IBDR) I $G(Y(0))="AUDIT" S IBOUT=1 Q
  1. . S IBDIF=$$CVDIF(.IBSYS,.IBGSAV,IBIEN),IBSAV=1
  1. . I IBDIF S IBSAV=$$CVASK()
  1. . I (IBDIF&('IBSAV))!($D(DTOUT)) D CVUNDO(IBIEN,IBOP,.IBSYS,.IBGSAV,.IBDATA,.IBERR) Q
  1. . I (IBDIF&(IBSAV))&('$D(DTOUT)) S IBCSAV=1
  1. I IBOP']"" S IBADD=$$ASKADD("OUTPATIENT",IBDATE) Q:IBADD=U I IBADD Q:'$$ADDCV(IBGRPDA,IBCO,IBDATE,.IBERR)
  1. ;
  1. ; -- pharmacy
  1. I IBPH]"" D Q:IBOUT!($D(IBERR))!($D(DTOUT))
  1. . W ! S IBOUT=0,IBIEN=$G(@IBDATA@(IBPH)),IBDR="[IBCNBC CV PH EDIT]"
  1. . D EDTREC(IBIEN,IBDR) I $G(Y(0))="AUDIT" S IBOUT=1 Q
  1. . S IBDIF=$$CVDIF(.IBSYS,.IBGSAV,IBIEN),IBSAV=1
  1. . I IBDIF S IBSAV=$$CVASK()
  1. . I (IBDIF&('IBSAV))!($D(DTOUT)) D CVUNDO(IBIEN,IBPH,.IBSYS,.IBGSAV,.IBDATA,.IBERR) Q
  1. . I (IBDIF&(IBSAV))&('$D(DTOUT)) S IBCSAV=1
  1. I IBPH']"" S IBADD=$$ASKADD("PHARMACY",IBDATE) Q:IBADD=U I IBADD Q:'$$ADDCV(IBGRPDA,IBCP,IBDATE,.IBERR)
  1. ;
  1. ; -- dental
  1. I IBDN]"" D Q:IBOUT!($D(IBERR))!($D(DTOUT))
  1. . W ! S IBOUT=0,IBIEN=$G(@IBDATA@(IBDN)),IBDR="[IBCNBC CV DN EDIT]"
  1. . D EDTREC(IBIEN,IBDR) I $G(Y(0))="AUDIT" S IBOUT=1 Q
  1. . S IBDIF=$$CVDIF(.IBSYS,.IBGSAV,IBIEN),IBSAV=1
  1. . I IBDIF S IBSAV=$$CVASK()
  1. . I (IBDIF&('IBSAV))!($D(DTOUT)) D CVUNDO(IBIEN,IBDN,.IBSYS,.IBGSAV,.IBDATA,.IBERR) Q
  1. . I (IBDIF&(IBSAV))&('$D(DTOUT)) S IBCSAV=1
  1. I IBDN']"" S IBADD=$$ASKADD("DENTAL",IBDATE) Q:IBADD=U I IBADD Q:'$$ADDCV(IBGRPDA,IBCD,IBDATE,.IBERR)
  1. ;
  1. ; -- mental health
  1. I IBMH]"" D Q:IBOUT!($D(IBERR))!($D(DTOUT))
  1. . W ! S IBOUT=0,IBIEN=$G(@IBDATA@(IBMH)),IBDR="[IBCNBC CV MH EDIT]"
  1. . D EDTREC(IBIEN,IBDR) I $G(Y(0))="AUDIT" S IBOUT=1 Q
  1. . S IBDIF=$$CVDIF(.IBSYS,.IBGSAV,IBIEN),IBSAV=1
  1. . I IBDIF S IBSAV=$$CVASK()
  1. . I (IBDIF&('IBSAV))!($D(DTOUT)) D CVUNDO(IBIEN,IBMH,.IBSYS,.IBGSAV,.IBDATA,.IBERR) Q
  1. . I (IBDIF&(IBSAV))&('$D(DTOUT)) S IBCSAV=1
  1. I IBMH']"" S IBADD=$$ASKADD("MENTAL HEALTH",IBDATE) Q:IBADD=U I IBADD Q:'$$ADDCV(IBGRPDA,IBCM,IBDATE,.IBERR)
  1. ;
  1. ; -- long term
  1. I IBLT]"" D Q:IBOUT!($D(IBERR))!($D(DTOUT))
  1. . W ! S IBOUT=0,IBIEN=$G(@IBDATA@(IBLT)),IBDR="[IBCNBC CV LT EDIT]"
  1. . D EDTREC(IBIEN,IBDR) I $G(Y(0))="AUDIT" S IBOUT=1 Q
  1. . S IBDIF=$$CVDIF(.IBSYS,.IBGSAV,IBIEN),IBSAV=1
  1. . I IBDIF S IBSAV=$$CVASK()
  1. . I (IBDIF&('IBSAV))!($D(DTOUT)) D CVUNDO(IBIEN,IBLT,.IBSYS,.IBGSAV,.IBDATA,.IBERR) Q
  1. . I (IBDIF&(IBSAV))&('$D(DTOUT)) S IBCSAV=1
  1. I IBLT']"" S IBADD=$$ASKADD("LONG TERM",IBDATE) Q:IBADD=U I IBADD Q:'$$ADDCV(IBGRPDA,IBCL,IBDATE,.IBERR)
  1. Q
  1. ;
  1. CVUNDO(IBIEN,IBPL,IBSYS,IBGSAV,IBDATA,IBERR) ; - undo any coverage limitations edits
  1. N X,Y,DA,DIC,DIK,IBI,IBJ,IBFLD,IBIENH,IBFDA
  1. ;
  1. S IBFDA=$NA(^TMP("IBCNBCD2 CV EDIT FDA",$J))
  1. K @IBFDA
  1. ;
  1. ; -- updo edits except for comments
  1. F IBFLD=.01:0 S IBFLD=$O(@IBDATA@(IBPL,IBFLD)) Q:IBFLD'>0 S @IBFDA@(355.32,IBIEN_",",IBFLD)=$G(@IBDATA@(IBPL,IBFLD,"E"))
  1. D FILE^DIE("E",.IBFDA,"IBERR") I $D(IBERR) S IBERR=1 W !,!,"*** Error...CVUNDO^IBCNBCD2 Cannot update Fields in the Coverage Limitations file! ",! K @IBFDA D PAUSE^VALM1
  1. ;
  1. ; -- put back any deleted comments
  1. S IBJ=0
  1. F IBI=0:0 S IBI=$O(@IBDATA@(IBPL,"COMM",IBI)) Q:IBI'>0 D Q:$D(IBERR)
  1. . ;
  1. . ; -- if comment subscript deleted - add the comment
  1. . I $G(@IBSYS@(IBIEN,2,IBI,0))']"" D
  1. . . S DIC="^IBA(355.32,"_IBIEN_",2,",DIC(0)="L",DA(1)=IBIEN,DA=IBI,X=@IBDATA@(IBPL,"COMM",IBI)
  1. . . D FILE^DICN I '+Y S IBERR=1 W !,!,"*** Error...Cannot Add 'deleted' Comments in the Coverage Limitations file! ",! D PAUSE^VALM1
  1. . . ;
  1. . S IBJ=IBI
  1. ;
  1. ; -- delete any added comments
  1. I +IBJ F IBI=IBJ:0 S IBI=$O(@IBSYS@(IBIEN,2,IBI)) Q:IBI'>0 D
  1. . S DA(1)=IBIEN,DIK="^IBA(355.32,"_DA(1)_",2,",DA=IBI
  1. . D ^DIK K DA,DIK
  1. ;
  1. ; -- put modified comments into fda array
  1. S IBI=0,IBIENH=$G(@IBDATA@(IBPL))_","
  1. F IBFLD=0:0 S IBFLD=$O(@IBDATA@(IBPL,"COMM",IBFLD)) Q:IBFLD'>0 D
  1. . S IBIEN=IBFLD_","_IBIENH
  1. . S @IBFDA@(355.321,IBIEN,0)=$G(@IBDATA@(IBPL,"COMM",IBFLD))
  1. ;
  1. ; -- undo any modified comments
  1. I $D(@IBFDA)>9 D
  1. . D FILE^DIE("E",.IBFDA,"IBERR")
  1. . I $D(IBERR) W !,!,"*** Error...CVUNDO^IBCNBCD2 Cannot Put Original Comments in the Coverage Limitations file! ",! D PAUSE^VALM1
  1. Q
  1. ;
  1. CVDLC(IBGRPDA,IBDATE,IBDTL,IBERR) ; Create records for the new coverage limitation year
  1. N IBI,IBPCC,IBIP,IBOP,IBPH,IBDN,IBMH,IBLT,IBIEN,IBDT,IBFDT
  1. ;
  1. S IBDTL=$NA(^TMP("IBCNBCD2 CVDTS DATES",$J)),IBPCC=$NA(^TMP("IBCNBCD2 IB COVERAGE CAT",$J))
  1. K @IBDTL,@IBPCC
  1. ;
  1. ; -- get coverage categories
  1. D LIST^DIC(355.31,,"@;.01E",,,,,"B","",,.IBPCC,"IBERR") I $D(IBERR) W !,"Error...CVDLC^IBCNBCD2 Cannot access PLAN LIMITATION CATEGORY FILE!" D PAUSE^VALM1 Q
  1. S (IBIP,IBOP,IBPH,IBDN,IBMH,IBLT)=0
  1. F IBI=0:0 S IBI=$O(@IBPCC@("ID",IBI)) Q:IBI'>0 D
  1. . I @IBPCC@("ID",IBI,.01)="INPATIENT" S IBIP=@IBPCC@(2,IBI) Q
  1. . I @IBPCC@("ID",IBI,.01)="OUTPATIENT" S IBOP=@IBPCC@(2,IBI) Q
  1. . I @IBPCC@("ID",IBI,.01)="PHARMACY" S IBPH=@IBPCC@(2,IBI) Q
  1. . I @IBPCC@("ID",IBI,.01)="DENTAL" S IBDN=@IBPCC@(2,IBI) Q
  1. . I @IBPCC@("ID",IBI,.01)="MENTAL HEALTH" S IBMH=@IBPCC@(2,IBI) Q
  1. . I @IBPCC@("ID",IBI,.01)="LONG TERM CARE" S IBLT=@IBPCC@(2,IBI)
  1. ;
  1. ; -- add new records to the database
  1. I IBIP&(IBOP)&(IBPH)&(IBDN)&(IBMH)&(IBLT) D Q:$D(IBERR)
  1. . ;
  1. . ; -- format the date
  1. . S IBDT=+IBDATE D DT^DILF("E",IBDT,.IBRET) S IBFDT=$G(IBRET(0))
  1. . ;
  1. . ; -- load the coverage limitation date array with formatted date
  1. . S IBIEN=$$ADDCV(IBGRPDA,IBIP,IBDATE,.IBERR) Q:$D(IBERR) S @IBDTL@(99_IBDT,IBIEN)=IBFDT
  1. . S IBIEN=$$ADDCV(IBGRPDA,IBOP,IBDATE,.IBERR) Q:$D(IBERR) S @IBDTL@(99_IBDT,IBIEN)=IBFDT
  1. . S IBIEN=$$ADDCV(IBGRPDA,IBPH,IBDATE,.IBERR) Q:$D(IBERR) S @IBDTL@(99_IBDT,IBIEN)=IBFDT
  1. . S IBIEN=$$ADDCV(IBGRPDA,IBDN,IBDATE,.IBERR) Q:$D(IBERR) S @IBDTL@(99_IBDT,IBIEN)=IBFDT
  1. . S IBIEN=$$ADDCV(IBGRPDA,IBMH,IBDATE,.IBERR) Q:$D(IBERR) S @IBDTL@(99_IBDT,IBIEN)=IBFDT
  1. . S IBIEN=$$ADDCV(IBGRPDA,IBLT,IBDATE,.IBERR) Q:$D(IBERR) S @IBDTL@(99_IBDT,IBIEN)=IBFDT
  1. Q
  1. ;
  1. ADDCV(IBGRPDA,IBCAT,IBDATE,IBERR) ; Add new coverage limitation record
  1. N X,Y,DA,DIC,IBIEN,IBA,IBB,IBC
  1. S IBIEN=0,IBC="COVERED"
  1. ;
  1. ; -- retrieve the plan limitation category
  1. S IBA=$$GET1^DIQ(355.31,IBCAT_",",.01,"E") I IBA']"" S IBERR=1 W !,"Error #1...ADDCV-IBCNBCD2 Cannot retrieve PLAN LIMITATION CATEGORY!" D PAUSE^VALM1 Q IBIEN
  1. S IBB=$P(IBDATE,U,2)
  1. ;
  1. ; -- update plan coverage limitation file
  1. S DIC="^IBA(355.32,",DIC(0)="L",X=IBGRPDA,DIC("DR")=".02///^S X=IBA;.03///^S X=IBB;.04///^S X=IBC"
  1. D FILE^DICN S IBIEN=+Y I IBIEN<0!(IBIEN=0) S IBERR=1 W !,"Error #2...ADDCV-IBCNBCD2 Cannot add New Record to the PLAN COVERAGE LIMITATIONS FILE!" D PAUSE^VALM1
  1. Q IBIEN
  1. ;
  1. CVDIF(IBSYS,IBGSAV,IBIEN) ; -- check for any edits made to coverage limitations
  1. N IBI,IBDIF
  1. S IBDIF=0
  1. I $G(@IBSYS@(IBIEN,0))'=$G(@IBGSAV@(IBIEN,0)) S IBDIF=1 Q IBDIF
  1. I $G(@IBSYS@(IBIEN,1))'=$G(@IBGSAV@(IBIEN,1)) S IBDIF=1 Q IBDIF
  1. I $G(@IBSYS@(IBIEN,2,0))'=$G(@IBGSAV@(IBIEN,2,0)) S IBDIF=1 Q IBDIF
  1. I $D(@IBSYS@(IBIEN,2,0)) D
  1. . F IBI=0:0 S IBI=$O(@IBSYS@(IBIEN,2,IBI)) Q:IBI'>0!(IBDIF) I $G(@IBSYS@(IBIEN,2,IBI,0))'=$G(@IBGSAV@(IBIEN,2,IBI,0)) S IBDIF=1 Q
  1. Q IBDIF
  1. ;
  1. EDTREC(IBIEN,IBDR) ; Edit Coverage Limitaitons
  1. N DA,DR,DIE
  1. S DA=IBIEN,DR=IBDR
  1. S DIE="^IBA(355.32,",DIE("NO^")="BACKOUTOK"
  1. D ^DIE
  1. Q
  1. ;
  1. CVOUT(IBDATA) ; -- unlock coverage limitations records
  1. N IBI,IBIEN
  1. I $D(IBDATA)>9 D
  1. . S IBI=""
  1. . F S IBI=$O(@IBDATA@(IBI)) Q:IBI']"" S IBIEN=$G(@IBDATA@(IBI)) L -@IBSYS@(IBIEN)
  1. Q
  1. ;
  1. CVLKD ; -- write locked message
  1. W !!,"Sorry, another user currently editing this entry."
  1. W !,"Try again in a few minutes."
  1. D PAUSE^VALM1
  1. Q
  1. ;
  1. CVASK() ; Prompt to ask user to Save Changes
  1. Q $E($$READ^IBCNBAA("YA^::E","Save Changes to Coverage Limitations File Y/N? ","No","Enter Yes or No to Save the Changes to the CV File <or> ^ to Quit"))
  1. ;
  1. ASKREV() ; Prompt to review Coverage Limitations
  1. Q $E($$READ^IBCNBAA("YA^::E","Do you want to Review the CV Y/N? ","No","Enter Yes or No to Review the Coverage Limitations <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 Coverage Date: ","","Enter a New/Existing Coverage Limitation Date <or> ^ to Quit")
  1. ;
  1. ASKADD(IBTXT,IBDATE) ; Prompt to ask user to add new coverage CATEGORY
  1. Q $E($$READ^IBCNBAA("YA^::E","There is no "_IBTXT_" Coverage Category for year "_$P(IBDATE,U,2)_". Do you want to add it now Y/N? ","No","Enter Yes or No to add the record now <or> ^ to Quit"))
  1. ;
  1. EDTYR(IBDATE,IBTXT) ; Prompt to Edit an existing Coverage Date
  1. Q +$$READ^IBCNBAA("YA^::E","Are you sure you want to Edit "_IBTXT_" Coverage Date information: "_$P(IBDATE,U,2)_" Y/N?: ","","Enter Yes or No to Edit the Coverage Date")
  1. ;
  1. CREYR(IBDATE) ; Prompt to Create a new Coverage Date
  1. Q +$$READ^IBCNBAA("YA^::E","Are you sure you want to Create a new Coverage Date: "_$P(IBDATE,U,2)_" Y/N? ","","Enter Yes or No to Create a New Coverage Year Date")