©2011-2018 Open Source Electronic Health Record Alliance
This work is licensed under a Creative Commons Attribution 3.0 Unported License
This work is licensed under a Creative Commons Attribution 3.0 Unported License
IBP618A ;SAB/Albany - IB*2.0*618 POST INSTALL (CONT'D);12/11/17 2:10pm
;;2.0;Integrated Billing;**618**;Mar 20, 1995;Build 61
;Per VA Directive 6402, this routine should not be modified.
Q
;
ADDACT ; Add new ACTION TYPE ENTRIES (350.1)
;
N IBLOOP,IBDATA,FDA,IBARCAT,IBSVC,FDAIEN
N X,Y,DIE,DA,DR,DTOUT
N IBSL,IBSL1,IBSL1TXT,IBSL2,IBSL2TXT,IBSL3,IBSL3TX1,IBSL3TX2,IBSL3TX3
N IBIEN,IBLAST,IBBEG,IBEND
N IBEL,IBEL1,IBEL2,IBEL3,IBDQDASH
;
; Define the Logic field information
; Set Logic
S IBDQDASH=$c(95)_$c(34)_$c(45)_$c(34)_$c(95)
S IBSL2TXT="FEE OPT COPAYMENT"
S IBSL2="S IBDESC="_$C(34)_IBSL2TXT_$C(34)
S IBSL1TXT="INPT PER DIEM"
S IBSL1="S IBDESC="_$C(34)_IBSL1TXT_$C(34)
S IBSL3TX1="S:'$D(^(10)) X="""" I $D(^(10)) X ^(10) S X=$S($D(Y(0)):$P(Y(0),U),1:""UNK"") "
S IBSL3TX2="I $D(Y(0)) S X=X_""-""_$S($$DRUG^IBRXUTL1(+$P(Y(0),U,6))'="""":$$DRUG^IBRXUTL1(+$P(Y(0),U,6)),1:"_"""UNK DRUG"""_")"
S IBSL3TX3=",X=$E(X,1,18)_""-""_$S($D(IBUNIT):IBUNIT,$D(IBX):$P(IBX,U,2),1:"""")"
S IBSL3=IBSL3TX1_IBSL3TX2_IBSL3TX3
;
; Eligibility Logic
S IBEL1="S X=0,X1="""_",X2="_""""_" "
S IBEL2="G:'$D(VAEL) 1^IBAERR I VAEL(4),'+VAEL(3),'IBDOM,'$$RXEXMT^IBARXEU0(DFN,DT) "
S IBEL3="S X=1,X2=$P(^IBE(350.1,DA,0),"_""_"^"_""_",4) D COST^IBAUTL"
S IBEL=IBEL1_IBEL2_IBEL3
S IBLAST=1
S IBIEN="" F S IBIEN=$O(^IBE(350.1,IBIEN)) Q:IBIEN="" S:$G(IBIEN) IBLAST=IBIEN
S IBBEG=IBLAST
;
D MES^XPDUTL(" -> Adding new AT entries to file 350.1 ...")
F IBLOOP=1:1 S IBDATA=$T(ACTDAT+IBLOOP) Q:IBDATA=" ;;END" D
. ;Clear the array
. K FDA
. ;Extract the new ACTION TYPE to be added.
. Q:$D(^IBE(350.1,"B",$P(IBDATA,";",3))) ; Quit loop if action type exist
. ;Store in array for adding to the file (#350.1).
. S FDA(350.1,"+1,",.01)=$P(IBDATA,";",3) ;Name
. S FDA(350.1,"+1,",.02)=$P(IBDATA,";",4) ;Abbreviation
. S IBARCAT=$P(IBDATA,";",5) ;AR Cat (Charge Code)
. S:IBARCAT'="" IBARCAT=$O(^PRCA(430.2,"B",IBARCAT,"")) ;Find local IEN for AR Cat
. S FDA(350.1,"+1,",.03)=IBARCAT
. S IBSVC=$P(IBDATA,";",6) ;Service
. S:IBSVC'="" IBSVC=$O(^DIC(49,"B",IBSVC,"")) ;Find local IEN for Service
. S FDA(350.1,"+1,",.04)=IBSVC
. S FDA(350.1,"+1,",.05)=$P(IBDATA,";",7) ;Seq Number
. S FDA(350.1,"+1,",.08)=$P(IBDATA,";",8) ;User Lookup Name
. S FDA(350.1,"+1,",.1)=$P(IBDATA,";",9) ;Place on Hold
. S FDA(350.1,"+1,",.11)=$P(IBDATA,";",10) ;Billing Group
. I $P(IBDATA,";",11)'="" S FDA(350.1,"+1,",10)=$P(IBDATA,";",11) ;Parent Logic
. I $P(IBDATA,";",12)'="" S FDA(350.1,"+1,",20)=@$P(IBDATA,";",12) ;Set Logic
. I $P(IBDATA,";",13)'="" S FDA(350.1,"+1,",30)=$P(IBDATA,";",13) ;Full Logic
. I $P(IBDATA,";",14)'="" S FDA(350.1,"+1,",40)=@$P(IBDATA,";",14) ;Eligibility Logic
. ;Add to the IB file.
. D UPDATE^DIE(,"FDA","FDAIEN")
. S FDAIEN=FDAIEN(1) K FDAIEN(1)
D MES^XPDUTL(" New ACTION TYPES added.")
Q
;
ACTDAT ; Data for the new ACTION TYPE fields. (All categories will be updated)
;;CHOICE (INPT) CANCEL;CAN CCCI;CHOICE INPT;BUSINESS OFFICE;2;;;;;;;
;;CHOICE (INPT) NEW;NEW CCCI;CHOICE INPT;BUSINESS OFFICE;1;CHOICE INPATIENT;1;1;;;;
;;CHOICE (INPT) UPDATE;UPD CCCI;CHOICE INPT;BUSINESS OFFICE;3;;1;1;;;;
;;CHOICE (PER DIEM) CANCEL;CAN CCCP;CHOICE INPT;BUSINESS OFFICE;2;;;;;;;
;;CHOICE (PER DIEM) NEW;NEW CCCP;CHOICE INPT;BUSINESS OFFICE;1;CHOICE PER DIEM;1;3;;IBSL1;;
;;CHOICE (PER DIEM) UPDATE;UPD CCCP;CHOICE INPT;BUSINESS OFFICE;3;;1;3;;;;
;;CHOICE (OPT) CANCEL;CAN CCCO;CHOICE OPT;BUSINESS OFFICE;2;;;;;;;
;;CHOICE (OPT) NEW;NEW CCCO;CHOICE OPT;BUSINESS OFFICE;1;CHOICE OUTPATIENT;1;4;;IBSL2;;
;;CHOICE (OPT) UPDATE;UPD CCCO;CHOICE OPT;BUSINESS OFFICE;3;;1;4;;;;
;;CHOICE (RX) CANCEL;CAN CCCR;CHOICE RX CO-PAYMENT;PHARMACY;2;;;;D PTL^IBAUTL;IBSL3;I $D(X) D EN^PSOCPVW;
;;CHOICE (RX) NEW;NEW CCCR;CHOICE RX CO-PAYMENT;PHARMACY;1;CHOICE RX;1;5;D PTL^IBAUTL;IBSL3;I $D(X) D EN^PSOCPVW;IBEL
;;CHOICE (RX) UPDATE;UPD CCCR;CHOICE RX CO-PAYMENT;PHARMACY;3;;1;5;D PTL^IBAUTL;IBSL3;I $D(X) D EN^PSOCPVW;
;;CC (INPT) CANCEL;CAN CCIP;CC INPT;BUSINESS OFFICE;2;;;;;;;
;;CC (INPT) NEW;NEW CCIP;CC INPT;BUSINESS OFFICE;1;CC INPATIENT;1;1;;;;
;;CC (INPT) UPDATE;UPD CCIP;CC INPT;BUSINESS OFFICE;3;;1;1;;;;
;;CC (PER DIEM) CANCEL;CAN CCPD;CC INPT;BUSINESS OFFICE;2;;;;;;;
;;CC (PER DIEM) NEW;NEW CCPD;CC INPT;BUSINESS OFFICE;1;CC PER DIEM;1;3;;IBSL1;;
;;CC (PER DIEM) UPDATE;UPD CCPD;CC INPT;BUSINESS OFFICE;3;;1;3;;;;
;;CC (OPT) CANCEL;CAN CCO;CC OPT;BUSINESS OFFICE;2;;;;;;;
;;CC (OPT) NEW;NEW CCO;CC OPT;BUSINESS OFFICE;1;CC OUTPATIENT;1;4;;IBSL2;;
;;CC (OPT) UPDATE;UPD CCO;CC OPT;BUSINESS OFFICE;3;;1;4;;;;
;;CC (RX) CANCEL;CAN CCRX;CC RX CO-PAYMENT;PHARMACY;2;;;;D PTL^IBAUTL;IBSL3;I $D(X) D EN^PSOCPVW;
;;CC (RX) NEW;NEW CCRX;CC RX CO-PAYMENT;PHARMACY;1;CC RX COPAY;1;5;D PTL^IBAUTL;IBSL3;I $D(X) D EN^PSOCPVW;IBEL
;;CC (RX) UPDATE;UPD CCRX;CC RX CO-PAYMENT;PHARMACY;3;;1;5;D PTL^IBAUTL;IBSL3;I $D(X) D EN^PSOCPVW;
;;CCN (INPT) CANCEL;CAN CCNI;CCN INPT;BUSINESS OFFICE;2;;;;;;;
;;CCN (INPT) NEW;NEW CCNI;CCN INPT;BUSINESS OFFICE;1;CCN INPATIENT;1;1;;;;
;;CCN (INPT) UPDATE;UPD CCNI;CCN INPT;BUSINESS OFFICE;3;;1;1;;;;
;;CCN (PER DIEM) CANCEL;CAN CCNP;CCN INPT;BUSINESS OFFICE;2;;;;;;;
;;CCN (PER DIEM) NEW;NEW CCNP;CCN INPT;BUSINESS OFFICE;1;CCN PER DIEM;1;3;;IBSL1;;
;;CCN (PER DIEM) UPDATE;UPD CCNP;CCN INPT;BUSINESS OFFICE;3;;1;3;;;;
;;CCN (OPT) CANCEL;CAN CCNO;CCN OPT;BUSINESS OFFICE;2;;;;;;;
;;CCN (OPT) NEW;NEW CCNO;CCN OPT;BUSINESS OFFICE;1;CCN OUTPATIENT;1;4;;IBSL2;;
;;CCN (OPT) UPDATE;UPD CCNO;CCN OPT;BUSINESS OFFICE;3;;1;4;;;;
;;CCN (RX) CANCEL;CAN CCNR;CCN RX CO-PAYMENT;PHARMACY;2;;;;D PTL^IBAUTL;IBSL3;I $D(X) D EN^PSOCPVW;
;;CCN (RX) NEW;NEW CCNR;CCN RX CO-PAYMENT;PHARMACY;1;CCN RX COPAY;1;5;D PTL^IBAUTL;IBSL3;I $D(X) D EN^PSOCPVW;IBEL
;;CCN (RX) UPDATE;UPD CCNR;CCN RX CO-PAYMENT;PHARMACY;3;;1;5;D PTL^IBAUTL;IBSL3;I $D(X) D EN^PSOCPVW;
;;CC MTF (INPT) CANCEL;CAN CCDI;CC MTF INPT;BUSINESS OFFICE;2;;;;;;;
;;CC MTF (INPT) NEW;NEW CCDI;CC MTF INPT;BUSINESS OFFICE;1;CC MTF INPATIENT;1;1;;;;
;;CC MTF (INPT) UPDATE;UPD CCDI;CC MTF INPT;BUSINESS OFFICE;3;;1;1;;;;
;;CC MTF (PER DIEM) CANCEL;CAN CCDP;CC MTF INPT;BUSINESS OFFICE;2;;;;;;;
;;CC MTF (PER DIEM) NEW;NEW CCDP;CC MTF INPT;BUSINESS OFFICE;1;CC MTF PER DIEM;1;3;;IBSL1;;
;;CC MTF (PER DIEM) UPDATE;UPD CCDP;CC MTF INPT;BUSINESS OFFICE;3;;1;3;;;;
;;CC MTF (OPT) CANCEL;CAN CCDO;CC MTF OPT;BUSINESS OFFICE;2;;;;;;;
;;CC MTF (OPT) NEW;NEW CCDO;CC MTF OPT;BUSINESS OFFICE;1;CC MTF OUTPATIENT;1;4;;IBSL2;;
;;CC MTF (OPT) UPDATE;UPD CCDO;CC MTF OPT;BUSINESS OFFICE;3;;1;4;;;;
;;CC MTF (RX) CANCEL;CAN CCDR;CC MTF RX CO-PAYMENT;PHARMACY;2;;;;D PTL^IBAUTL;IBSL3;I $D(X) D EN^PSOCPVW;
;;CC MTF (RX) NEW;NEW CCDR;CC MTF RX CO-PAYMENT;PHARMACY;1;CC MTF RX COPAY;1;5;D PTL^IBAUTL;IBSL3;I $D(X) D EN^PSOCPVW;IBEL
;;CC MTF (RX) UPDATE;UPD CCDR;CC MTF RX CO-PAYMENT;PHARMACY;3;;1;5;D PTL^IBAUTL;IBSL3;I $D(X) D EN^PSOCPVW;
;;LTC CC INPT CNH CANCEL;C CCCNH;CC NURSING HOME CARE - LTC;BUSINESS OFFICE;2;;;;;;;
;;LTC CC INPT CNH NEW;N CCCNH;CC NURSING HOME CARE - LTC;BUSINESS OFFICE;1;CC LTC INPT CNH;1;9;;;;
;;LTC CC INPT CNH UPDATE;U CCCNH;CC NURSING HOME CARE - LTC;BUSINESS OFFICE;3;;1;9;;;;
;;LTC CC INPT RESPITE CANCEL;C CCIRES;CC RESPITE CARE;BUSINESS OFFICE;2;;;;;;;
;;LTC CC INPT RESPITE NEW;N CCIRES;CC RESPITE CARE;BUSINESS OFFICE;1;CC LTC INPT RESPITE;1;9;;;;
;;LTC CC INPT RESPITE UPDATE;U CCIRES;CC RESPITE CARE;BUSINESS OFFICE;3;;1;9;;;;
;;LTC CC OPT ADHC CANCEL;C CCADHC;CC NURSING HOME CARE - LTC;BUSINESS OFFICE;2;;;;;;;
;;LTC CC OPT ADHC NEW;N CCADHC;CC NURSING HOME CARE - LTC;BUSINESS OFFICE;1;CC LTC OPT ADHC;1;8;;;;
;;LTC CC OPT ADHC UPDATE;U CCADHC;CC NURSING HOME CARE - LTC;BUSINESS OFFICE;3;;1;8;;;;
;;LTC CC OPT RESPITE CANCEL;C CCORES;CC RESPITE CARE;BUSINESS OFFICE;2;;;;;;;
;;LTC CC OPT RESPITE NEW;N CCORES;CC RESPITE CARE;BUSINESS OFFICE;1;CC LTC OPT RESPITE;1;8;;;;
;;LTC CC OPT RESPITE UPDATE;U CCORES;CC RESPITE CARE;BUSINESS OFFICE;3;;1;8;;;;
;;LTC CCN INPT CNH CANCEL;C CCNCNH;CCN NURSING HOME CARE - LTC;BUSINESS OFFICE;2;;;;;;;
;;LTC CCN INPT CNH NEW;N CCNCNH;CCN NURSING HOME CARE - LTC;BUSINESS OFFICE;1;CCN LTC INPT CNH;1;9;;;;
;;LTC CCN INPT CNH UPDATE;U CCNCNH;CCN NURSING HOME CARE - LTC;BUSINESS OFFICE;3;;1;9;;;;
;;LTC CCN INPT RESPITE CANCEL;C CCNIRS;CCN RESPITE CARE;BUSINESS OFFICE;2;;;;;;;
;;LTC CCN INPT RESPITE NEW;N CCNIRS;CCN RESPITE CARE;BUSINESS OFFICE;1;CCN LTC INPT RESPITE;1;9;;;;
;;LTC CCN INPT RESPITE UPDATE;U CCNIRS;CCN RESPITE CARE;BUSINESS OFFICE;3;;1;9;;;;
;;LTC CCN OPT ADHC CANCEL;C CCNOAD;CCN NURSING HOME CARE - LTC;BUSINESS OFFICE;2;;;;;;;
;;LTC CCN OPT ADHC NEW;N CCNOAD;CCN NURSING HOME CARE - LTC;BUSINESS OFFICE;1;CCN LTC OPT ADHC;1;8;;;;
;;LTC CCN OPT ADHC UPDATE;U CCNOAD;CCN NURSING HOME CARE - LTC;BUSINESS OFFICE;3;;1;8;;;;
;;LTC CCN OPT RESPITE CANCEL;C CCNORS;CCN RESPITE CARE;BUSINESS OFFICE;2;;;;;;;;
;;LTC CCN OPT RESPITE NEW;N CCNORS;CCN RESPITE CARE;BUSINESS OFFICE;1;CCN LTC OPT RESPITE;1;8;;;;
;;LTC CCN OPT RESPITE UPDATE;U CCNORS;CCN RESPITE CARE;BUSINESS OFFICE;3;;1;8;;;;
;;LTC CHOICE INPT CNH CANCEL;C CCCCNH;CHOICE NURSING HOME CARE - LTC;BUSINESS OFFICE;2;;;;;;;
;;LTC CHOICE INPT CNH NEW;N CCCCNH;CHOICE NURSING HOME CARE - LTC;BUSINESS OFFICE;1;CHOICE LTC INPT CNH;1;9;;;;
;;LTC CHOICE INPT CNH UPDATE;U CCCCNH;CHOICE NURSING HOME CARE - LTC;BUSINESS OFFICE;3;;1;9;;;;
;;LTC CHOICE INPT RESPITE CANCEL;C CCCIRS;CHOICE RESPITE CARE;BUSINESS OFFICE;2;;;;;;;
;;LTC CHOICE INPT RESPITE NEW;N CCCIRS;CHOICE RESPITE CARE;BUSINESS OFFICE;1;CHOICE LTC INP RESPITE;1;9;;;;
;;LTC CHOICE INPT RESPITE UPDATE;U CCCIRS;CHOICE RESPITE CARE;BUSINESS OFFICE;3;;1;9;;;;
;;LTC CHOICE OPT ADHC CANCEL;C CCCOAD;CHOICE NURSING HOME CARE - LTC;BUSINESS OFFICE;2;;;;;;;
;;LTC CHOICE OPT ADHC NEW;N CCCOAD;CHOICE NURSING HOME CARE - LTC;BUSINESS OFFICE;1;CHOICE LTC OPT ADHC;1;8;;;;
;;LTC CHOICE OPT ADHC UPDATE;U CCCOAD;CHOICE NURSING HOME CARE - LTC;BUSINESS OFFICE;3;;1;8;;;;
;;LTC CHOICE OPT RESPITE CANCEL;C CCCORS;CHOICE RESPITE CARE;BUSINESS OFFICE;2;;;;;;;
;;LTC CHOICE OPT RESPITE NEW;N CCCORS;CHOICE RESPITE CARE;BUSINESS OFFICE;1;CHOICE LTC OPT RESPITE;1;8;;;;
;;LTC CHOICE OPT RESPITE UPDATE;U CCCORS;CHOICE RESPITE CARE;BUSINESS OFFICE;3;;1;8;;;;
;;END
IBUPD ; Inactivate FEE Service Entries
;
N LOOP,LIEN,IBDATA
N X,Y,DIE,DA,DR,DTOUT,DATA
;
; Grab all of the entries to update
F LOOP=1:1:24 D
. ;Extract the new ACTION TYPE to be added.
. S IBDATA=$T(IBDDAT+LOOP)
. S IBDATA=$P(IBDATA,";;",2)
. ;Store in array for adding to the file (#350.1).
. Q:IBDATA="" ;go to next entry if Category is not to be updated.
. S LIEN=$O(^IBE(350.1,"B",IBDATA,"")) ; find ACTION TYPE entry
. Q:LIEN=""
. ;
. ; File the update along with inactivate the ACTION TYPE
. S DR=".12////1;"
. S DIE="^IBE(350.1,",DA=LIEN
. D ^DIE
. K DR ;Clear update array before next use
;
S DR=""
D MES^XPDUTL(" -> Data added to the ACTION TYPE (350.1) INACTIVE field.")
Q
;
IBDDAT ; Fee Service to inactivate
;;DG FEE SERVICE (INPT) CANCEL
;;DG FEE SERVICE (INPT) NEW
;;DG FEE SERVICE (INPT) UPDATE
;;DG FEE SERVICE (OPT) CANCEL
;;DG FEE SERVICE (OPT) NEW
;;DG FEE SERVICE (OPT) UPDATE
;;DG LTC FEE INPT CNH CANCEL
;;DG LTC FEE INPT CNH NEW
;;DG LTC FEE INPT CNH UPDATE
;;DG LTC FEE INPT RESPITE CANCEL
;;DG LTC FEE INPT RESPITE NEW
;;DG LTC FEE INPT RESPITE UPDATE
;;DG LTC FEE OPT ADHC CANCEL
;;DG LTC FEE OPT ADHC NEW
;;DG LTC FEE OPT ADHC UPDATE
;;DG LTC FEE OPT RESPITE CANCEL
;;DG LTC FEE OPT RESPITE NEW
;;DG LTC FEE OPT RESPITE UPDATE
;;FEE SERV INPT PER DIEM CANCEL
;;FEE SERV INPT PER DIEM NEW
;;FEE SERV INPT PER DIEM UPDATE
;;FEE SERV NSC RX COPAY CANCEL
;;FEE SERV NSC RX COPAY NEW
;;FEE SERV NSC RX COPAY UPDATE
;;END