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