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

IBP618A.m

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