- IB20P618 ;SAB/Albany - IB*2.0*618 POST INSTALL;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
- ;
- POSTINIT ;Post Install for IB*2.0*618
- D BMES^XPDUTL(" >> Starting the Post-Initialization routine for IB*2.0*618 ")
- ; Adding AR CATEGORIES and REVENUE SOURCE CODES
- D RTADD
- D RTUPD
- D ADDRS
- D IBUPD^IBP618A
- D ADDACT^IBP618A
- D UPDACT^IBP618B
- D ADDACTCH^IBP618B
- D BMES^XPDUTL(" >> End of the Post-Initialization routine for IB*2.0*618")
- Q
- ;
- RTADD ;Add New rate types to the Rate type File
- ;
- N LOOP,FDA,FDAIEN,DATA,BRF,ARCAT,CHK
- ;
- D MES^XPDUTL(" -> Adding new Rate Type entries to file 399.3 ...")
- ; Add new Rate Types
- F LOOP=2:1 S DATA=$T(RTDATA+LOOP) Q:$P(DATA,";",3)="END" D
- . ;Clear the array
- . K FDA
- . ;Check to insure that the rate type doesn't exist already
- . S CHK="" ; Initialized the check variable
- . S CHK=$O(^DGCR(399.3,"B",$P(DATA,";",3),""))
- . Q:CHK'=""
- . ;Store in array for adding to the file (#399.3).
- . S FDA(399.3,"+1,",.01)=$P(DATA,";",3) ;Rate Type Name
- . S FDA(399.3,"+1,",.02)=$P(DATA,";",4) ;Bill Name
- . S FDA(399.3,"+1,",.03)=$P(DATA,";",5) ;Inactive Flag
- . S FDA(399.3,"+1,",.04)=$P(DATA,";",6) ;Abbreviation
- . S FDA(399.3,"+1,",.05)=$P(DATA,";",7) ;Third Party?
- . S ARCAT=$P(DATA,";",8) ;AR Cat
- . S:ARCAT'="" ARCAT=$O(^PRCA(430.2,"AC",ARCAT,"")) ;Find local IEN for AR Cat
- . S FDA(399.3,"+1,",.06)=ARCAT ;AR Cat
- . S FDA(399.3,"+1,",.07)=$P(DATA,";",9) ;Responsible?
- . S FDA(399.3,"+1,",.08)=$P(DATA,";",10) ;Reimbursable
- . S FDA(399.3,"+1,",.09)=$P(DATA,";",11) ;NSC Statement
- . S FDA(399.3,"+1,",.1)=$P(DATA,";",12) ;Electronic Transmit
- . S BRF=$P(DATA,";",13) ;Bill Resulting From (BRF) (430.6)
- . S:BRF'="" BRF=$O(^PRCA(430.6,"B",BRF,"")) ;Find local IEN for BRF
- . S FDA(399.3,"+1,",.11)=BRF
- . S FDA(399.3,"+1,",.12)=$P(DATA,";",14) ;Collect?
- . ;Add to the file.
- . D UPDATE^DIE(,"FDA","FDAIEN")
- . S FDAIEN=FDAIEN(1) K FDAIEN(1)
- D MES^XPDUTL(" New Rate Types added.")
- Q
- ;
- RTDATA ; New RATE TYPE data. (Internal data format
- ;;name;billname;inactive; abbreviation;thirdparty;AR Cat #;resp;reimb;nsc;etransmit;billfrom;collect?
- ;;CC WORKERS' COMP;CC WORKERS' COMP;;CC WC;1;59;i;1;1;1;;
- ;;CC NO-FAULT AUTO;CC NO-FAULT AUTO;;CC NF;1;60;i;1;1;1;;
- ;;CC TORT FEASOR;CC TORT FEASOR;;CC TF;1;61;i;1;1;1;;
- ;;CHOICE WORKERS' COMP;CHOICE WORKERS' COMP;;CCC WC;1;62;i;1;1;1;;
- ;;CHOICE NO-FAULT AUTO;CHOICE NO-FAULT AUTO;;CCC NF;1;54;i;1;1;1;;
- ;;CHOICE TORT FEASOR;CHOICE TORT FEASOR;;CCC TF;1;55;i;1;1;1;;
- ;;CCN WORKERS' COMP;CCN WORKERS' COMP;;CCN WC;1;56;i;1;1;1;;
- ;;CCN NO-FAULT AUTO;CCN NO-FAULT AUTO;;CCN NF;1;57;i;1;1;1;;
- ;;CCN TORT FEASOR;CCN TORT FEASOR;;CCN TF;1;58;i;1;1;1;;
- ;;CHOICE REIMB INS;CHOICE REIMB INS;;CCC REIM;1;50;i;1;1;1;HI;1
- ;;CC REIMB INS;CC REIMB INS;;CC REIM;1;51;i;1;1;1;HI;1
- ;;CCN REIMB INS;CCN REIMB INS;;CCN REIM;1;52;i;1;1;1;HI;1
- ;;CC MTF REIMB INS;CC MTF REIMB INS;;CCD REIM;1;53;i;1;1;1;HI;1
- ;;DOD DISABILITY EVALUATION;DOD DISABILITY EVALUATION;;TR IDES;1;77;i;1;1;1;HI;1
- ;;DOD SPINAL CORD INJURY;DOD SPINAL CORD INJURY;;TRSPINAL;1;78;i;1;1;1;HI;1
- ;;DOD TRAUMATIC BRAIN INJURY;DOD TRAUMATIC BRAIN INJURY;;TR TBI;1;79;i;1;1;1;HI;1
- ;;DOD BLIND REHABILITATION;DOD BLIND REHABILITATION;;TRREHAB;1;80;i;1;1;1;HI;1
- ;;TRICARE DENTAL;TRICARE DENTAL;;TR DENTAL;1;81;i;1;1;1;HI;1
- ;;TRICARE PHARMACY;TRICARE PHARMACY;;TR RX;1;82;i;1;1;1;HI;1
- ;;END
- ;
- RTUPD ; Update the FEE REIMB INS entry in the Rate Type File (399.3) to inactivate
- N LIEN,X,Y,DIE,DA,DR,DTOUT,DATA
- ;
- D MES^XPDUTL(" -> Inactivating the FEE REIMB INS Rate Type...")
- S LIEN=$O(^DGCR(399.3,"B","FEE REIMB INS",""))
- Q:'LIEN
- ; File the update
- S DR=".03////1;"
- S DIE="^DGCR(399.3,",DA=LIEN
- D ^DIE
- ;
- Q
- ADDRS ; Add Rate Schedules (363) for FEE REIMB INS
- D MES^XPDUTL(" -> Adding new Rate Schedules to file 363 ...")
- N IBA,IBCNT,IBI,IBLN,IBFN,IBRT,IBBS,IBCNTCS,IBDISP,IBJ,IBLNCS,IBCS,IBCSFN,IBADMIN,DD,DO
- N DLAYGO,DIC,DIE,DA,DR,RXDT,X,Y,IBCPNM,IBEDT
- S IBCNT=0
- F IBI=2:1 S IBLN=$P($T(RSF+IBI),";;",2) Q:IBLN="END" I $E(IBLN)?1A D
- . ;Check for problems
- . S IBBS=$P(IBLN,U,4) I IBBS'="" S IBBS=$$MCCRUTL(IBBS,13) Q:'IBBS ;Billable service invalid
- . S IBRT=$P(IBLN,U,2),IBRT=$O(^DGCR(399.3,"B",IBRT,0)) D Q:'IBRT
- .. I 'IBRT D MSG(" **** Rate Type "_$P(IBLN,U,2)_" not defined, RS "_$P(IBLN,U,1)_" not created")
- .. I +$P($G(^DGCR(399.3,+IBRT,0)),U,3) S IBRT=0 D MSG(" **** Rate Type "_$P(IBLN,U,2)_" not Active, RS "_$P(IBLN,U,1)_" not created")
- . ;No problems found, so create entry
- . K DD,DO
- . S DLAYGO=363,DIC="^IBE(363,",DIC(0)="L",X=$P(IBLN,U,1)
- . D FILE^DICN K DIC,DINUM,DLAYGO
- . I Y<1 K X,Y Q
- . S IBFN=+Y,IBCNT=IBCNT+1
- . S IBCPNM=$P(IBLN,U,5),IBEDT=$P(IBLN,U,6)
- . S RXDT=$$RXDT(IBCPNM,IBEDT)
- . S DR=".02////"_IBRT_";.03////"_$P(IBLN,U,3) I +IBBS S DR=DR_";.04////"_IBBS
- . S DR=DR_";.05////"_$P(RXDT,U)
- . I $P(RXDT,U,2) S DR=DR_";.06////"_$P(RXDT,U,2)
- . I ($P(IBLN,U,1)["RX"),($G(IBDISP)]"") S DR=DR_";1.01///"_IBDISP
- . I ($P(IBLN,U,1)["RX"),($G(IBADMIN)]"") S DR=DR_";1.02////"_IBADMIN
- . S DIE="^IBE(363,",DA=+Y D ^DIE K DIE,DA,DR,X,Y
- . S IBCNTCS=0
- . ; Retrieve name of Charge Set to copy
- . I IBRT="" D MSG(" **** Rate Type "_$P(IBLN,U,2)_" missing Charge Set Information, RS "_$P(IBLN,U,1)_" not created") Q
- . ; add all Reasonable Charges Charge Sets to the Rate Schedule.
- . S IBCNTCS=$$RSCS(IBFN,IBCPNM,$P(RXDT,U))
- . D MES^XPDUTL(" Total Reasonable Charge Set"_$S(IBCNTCS=1:" ",1:"s ")_IBCNTCS_" added to Rate Schedule "_$P(IBLN,U,1)_".")
- D MES^XPDUTL(" Rate Schedules completed.")
- Q ;ADDRS
- ;
- RSCS(IBFN,IBCPNM,RXDT) ; add existing Charge Sets to FR
- ; copy the Charge Sets from the corresponding RI RS (v2)
- ; IBFN - Rate Schedule IEN
- ; IBCPNM - Charge Set to copy
- ; RXDT - last effective date of charge set being copied.
- N IBCNT,IBNRS,IBRSNM,IBTY,IBVDT,IBCOPY,IBCS,IBCS0,IBXFN,IBCSFN,IBCSNM,IBCSAA,IBNAME
- S (IBCNT,IBCOPY)=0
- S IBNRS=$G(^IBE(363,+$G(IBFN),0)),IBRSNM=$P(IBNRS,"^",1)
- S IBTY=$P(IBNRS,"^",3)
- S IBVDT=RXDT
- Q:IBVDT="" 0
- S IBCOPY=+$$RSEXISTS(IBVDT,IBCPNM)
- I 'IBCOPY G RSCSQ
- I +$P($G(^IBE(363,+IBCOPY,0)),U,3)=IBTY D
- . S IBXFN=0 F S IBXFN=$O(^IBE(363,IBCOPY,11,IBXFN)) Q:'IBXFN D
- .. S IBCS=$G(^IBE(363,IBCOPY,11,IBXFN,0)),IBCSFN=+IBCS
- .. I +$$RSCSFILE(IBFN,$P($G(^IBE(363.1,IBCSFN,0)),U,1),$P(IBCS,U,2)) S IBCNT=IBCNT+1
- RSCSQ Q IBCNT
- ;
- ;
- RSCSFILE(IBFN,IBCSNM,IBCSAA) ; Add Charge Set to a Rate Schedule
- N IBX,DD,DO,DLAYGO,DIC,DA,DR,X,Y,IBCSFN S IBX=0
- I $G(^IBE(363,+$G(IBFN),0))="" G RSCSFQ
- I $G(IBCSNM)="" G RSCSFQ
- S IBCSFN=$O(^IBE(363.1,"B",IBCSNM,0)) I 'IBCSFN G RSCSFQ
- I $O(^IBE(363,IBFN,11,"B",IBCSFN,0)) G RSCSFQ
- S DLAYGO=363,DA(1)=+IBFN,DIC="^IBE(363,"_DA(1)_",11,",DIC(0)="L"
- S X=IBCSNM,DIC("DR")=".02///"_$G(IBCSAA),DIC("P")="363.0011P"
- D ^DIC S:+Y IBX=1
- RSCSFQ Q IBX
- ;
- ;
- RSEXISTS(IBVDT,IBNAME) ; return RS IFN if Rate Schedule exists for Effective Date
- N IBX,IBRSFN,IBRS0 S IBX=0
- S IBRSFN=0 F S IBRSFN=$O(^IBE(363,IBRSFN)) Q:'IBRSFN D I IBX Q
- . S IBRS0=$G(^IBE(363,IBRSFN,0))
- . I $P(IBRS0,U,1)=IBNAME,$P(IBRS0,U,5)=IBVDT S IBX=IBRSFN
- Q IBX
- ;
- MSG(X) ;
- N IBX S IBX=$O(IBA(999999),-1) S:'IBX IBX=1 S IBX=IBX+1
- S IBA(IBX)=$G(X)
- Q ;MSG
- ;
- MCCRUTL(X,P) ; returns IFN of item in 399.1 if Name is found and piece P is true
- N IBX,IBY S IBY=""
- I $G(X)'="" S IBX=0 F S IBX=$O(^DGCR(399.1,"B",X,IBX)) Q:'IBX I $P($G(^DGCR(399.1,IBX,0)),U,+$G(P)) S IBY=IBX
- Q IBY
- ;
- RXDT(IBCPNM,IBEDT) ;Copy the active charge schedule from charge set being copied.
- ; update Fee information if Pharmacy.
- N IBEFLG,IBD
- S IBEDT=$G(IBEDT) ; Set to NULL if not passed in
- S IBCS=""
- ;If no Effective Date sent, get the latest entry.
- I IBEDT="" S IBCS=$O(^IBE(363,"B",IBCPNM,IBCS),-1)
- ;If Effective date sent, loop through the entries to find the entry
- ; with the correct effective date.
- I IBEDT'="" D
- . S IBEFLG=0
- . F S IBCS=$O(^IBE(363,"B",IBCPNM,IBCS),-1) Q:'IBCS D Q:IBEFLG
- .. S IBD=$G(^IBE(363,IBCS,0))
- .. I $P(IBD,U,5)=IBEDT S IBEFLG=1
- Q:IBCS="" ""
- S IBCS0=^IBE(363,IBCS,0)
- I IBCPNM["RX" S IBDISP=$P($G(^IBE(363,IBCS,1)),U,1),IBADMIN=$G(^IBE(363,IBCS,10))
- Q $P(IBCS0,U,5,6) ;return effective and end dates
- ;
- RSF ;Rate Schedules (363) for the new Community Care Rate Types.
- ;;Rate Schedule Name^Rate Type^Bill Type^Billable Service^Rate Schedule to copy for Charge Sets
- ;;CCC-NF-INPT^CHOICE NO-FAULT AUTO^1^^NF-INPT
- ;;CCC-NF-SNF^CHOICE NO-FAULT AUTO^1^SKILLED NURSING^NF-SNF
- ;;CCC-NF-OPT^CHOICE NO-FAULT AUTO^3^^NF-OPT
- ;;CCC-NF-RX^CHOICE NO-FAULT AUTO^3^^NF-RX^3140101
- ;;CCC-NF-RX^CHOICE NO-FAULT AUTO^3^^NF-RX^3150101
- ;;CCC-NF-RX^CHOICE NO-FAULT AUTO^3^^NF-RX^3160101
- ;;CCC-NF-RX^CHOICE NO-FAULT AUTO^3^^NF-RX^3170101
- ;;CCC-NF-RX^CHOICE NO-FAULT AUTO^3^^NF-RX^3180101
- ;;CC-NF-INPT^CC NO-FAULT AUTO^1^^NF-INPT
- ;;CC-NF-SNF^CC NO-FAULT AUTO^1^SKILLED NURSING^NF-SNF
- ;;CC-NF-OPT^CC NO-FAULT AUTO^3^^NF-OPT
- ;;CC-NF-RX^CC NO-FAULT AUTO^3^^NF-RX^3140101
- ;;CC-NF-RX^CC NO-FAULT AUTO^3^^NF-RX^3150101
- ;;CC-NF-RX^CC NO-FAULT AUTO^3^^NF-RX^3160101
- ;;CC-NF-RX^CC NO-FAULT AUTO^3^^NF-RX^3170101
- ;;CC-NF-RX^CC NO-FAULT AUTO^3^^NF-RX^3180101
- ;;CCN-NF-INPT^CCN NO-FAULT AUTO^1^^NF-INPT
- ;;CCN-NF-SNF^CCN NO-FAULT AUTO^1^SKILLED NURSING^NF-SNF
- ;;CCN-NF-OPT^CCN NO-FAULT AUTO^3^^NF-OPT
- ;;CCN-NF-RX^CCN NO-FAULT AUTO^3^^NF-RX^3140101
- ;;CCN-NF-RX^CCN NO-FAULT AUTO^3^^NF-RX^3150101
- ;;CCN-NF-RX^CCN NO-FAULT AUTO^3^^NF-RX^3160101
- ;;CCN-NF-RX^CCN NO-FAULT AUTO^3^^NF-RX^3170101
- ;;CCN-NF-RX^CCN NO-FAULT AUTO^3^^NF-RX^3180101
- ;;CCC-RI-INPT^CHOICE REIMB INS^1^^RI-INPT
- ;;CCC-RI-SNF^CHOICE REIMB INS^1^SKILLED NURSING^RI-SNF
- ;;CCC-RI-OPT^CHOICE REIMB INS^3^^RI-OPT
- ;;CCC-RI-RX^CHOICE REIMB INS^3^^RI-RX^3140101
- ;;CCC-RI-RX^CHOICE REIMB INS^3^^RI-RX^3150101
- ;;CCC-RI-RX^CHOICE REIMB INS^3^^RI-RX^3160101
- ;;CCC-RI-RX^CHOICE REIMB INS^3^^RI-RX^3170101
- ;;CCC-RI-RX^CHOICE REIMB INS^3^^RI-RX^3180101
- ;;CC-RI-INPT^CC REIMB INS^1^^RI-INPT
- ;;CC-RI-SNF^CC REIMB INS^1^SKILLED NURSING^RI-SNF
- ;;CC-RI-OPT^CC REIMB INS^3^^RI-OPT
- ;;CC-RI-RX^CC REIMB INS^3^^RI-RX^3140101
- ;;CC-RI-RX^CC REIMB INS^3^^RI-RX^3150101
- ;;CC-RI-RX^CC REIMB INS^3^^RI-RX^3160101
- ;;CC-RI-RX^CC REIMB INS^3^^RI-RX^3170101
- ;;CC-RI-RX^CC REIMB INS^3^^RI-RX^3180101
- ;;CCN-RI-INPT^CCN REIMB INS^1^^RI-INPT
- ;;CCN-RI-SNF^CCN REIMB INS^1^SKILLED NURSING^RI-SNF
- ;;CCN-RI-OPT^CCN REIMB INS^3^^RI-OPT
- ;;CCN-RI-RX^CCN REIMB INS^3^^RI-RX^3140101
- ;;CCN-RI-RX^CCN REIMB INS^3^^RI-RX^3150101
- ;;CCN-RI-RX^CCN REIMB INS^3^^RI-RX^3160101
- ;;CCN-RI-RX^CCN REIMB INS^3^^RI-RX^3170101
- ;;CCN-RI-RX^CCN REIMB INS^3^^RI-RX^3180101
- ;;CC-DOD-INPT^CC MTF REIMB INS^1^INPATIENT^RI-INPT
- ;;CC-DOD-SNF^CC MTF REIMB INS^1^SKILLED NURSING^RI-SNF
- ;;CC-DOD-OPT^CC MTF REIMB INS^3^OUTPATIENT VISIT^RI-OPT
- ;;CC-DOD-RX^CC MTF REIMB INS^3^^RI-RX^3140101
- ;;CC-DOD-RX^CC MTF REIMB INS^3^^RI-RX^3150101
- ;;CC-DOD-RX^CC MTF REIMB INS^3^^RI-RX^3160101
- ;;CC-DOD-RX^CC MTF REIMB INS^3^^RI-RX^3170101
- ;;CC-DOD-RX^CC MTF REIMB INS^3^^RI-RX^3180101
- ;;CCC-TF-INPT^CHOICE TORT FEASOR^1^^TF-INPT
- ;;CCC-TF-SNF^CHOICE TORT FEASOR^1^SKILLED NURSING^TF-SNF
- ;;CCC-TF-OPT^CHOICE TORT FEASOR^3^^TF-OPT
- ;;CCC-TF-RX^CHOICE TORT FEASOR^3^^TF-RX^3140101
- ;;CCC-TF-RX^CHOICE TORT FEASOR^3^^TF-RX^3150101
- ;;CCC-TF-RX^CHOICE TORT FEASOR^3^^TF-RX^3160101
- ;;CCC-TF-RX^CHOICE TORT FEASOR^3^^TF-RX^3170101
- ;;CCC-TF-RX^CHOICE TORT FEASOR^3^^TF-RX^3180101
- ;;CC-TF-INPT^CC TORT FEASOR^1^^TF-INPT
- ;;CC-TF-SNF^CC TORT FEASOR^1^SKILLED NURSING^TF-SNF
- ;;CC-TF-OPT^CC TORT FEASOR^3^^TF-OPT
- ;;CC-TF-RX^CC TORT FEASOR^3^^TF-RX^3140101
- ;;CC-TF-RX^CC TORT FEASOR^3^^TF-RX^3150101
- ;;CC-TF-RX^CC TORT FEASOR^3^^TF-RX^3160101
- ;;CC-TF-RX^CC TORT FEASOR^3^^TF-RX^3170101
- ;;CC-TF-RX^CC TORT FEASOR^3^^TF-RX^3180101
- ;;CCN-TF-INPT^CCN TORT FEASOR^1^^TF-INPT
- ;;CCN-TF-SNF^CCN TORT FEASOR^1^SKILLED NURSING^TF-SNF
- ;;CCN-TF-OPT^CCN TORT FEASOR^3^^TF-OPT
- ;;CCN-TF-RX^CCN TORT FEASOR^3^^TF-RX^3140101
- ;;CCN-TF-RX^CCN TORT FEASOR^3^^TF-RX^3150101
- ;;CCN-TF-RX^CCN TORT FEASOR^3^^TF-RX^3160101
- ;;CCN-TF-RX^CCN TORT FEASOR^3^^TF-RX^3170101
- ;;CCN-TF-RX^CCN TORT FEASOR^3^^TF-RX^3180101
- ;;CCC-WC-INPT^CHOICE WORKERS' COMP^1^^WC-INPT
- ;;CCC-WC-SNF^CHOICE WORKERS' COMP^1^SKILLED NURSING^WC-SNF
- ;;CCC-WC-OPT^CHOICE WORKERS' COMP^3^^WC-OPT
- ;;CCC-WC-RX^CHOICE WORKERS' COMP^3^^WC-RX^3140101
- ;;CCC-WC-RX^CHOICE WORKERS' COMP^3^^WC-RX^3150101
- ;;CCC-WC-RX^CHOICE WORKERS' COMP^3^^WC-RX^3160101
- ;;CCC-WC-RX^CHOICE WORKERS' COMP^3^^WC-RX^3170101
- ;;CCC-WC-RX^CHOICE WORKERS' COMP^3^^WC-RX^3180101
- ;;CC-WC-INPT^CC WORKERS' COMP^1^^WC-INPT
- ;;CC-WC-SNF^CC WORKERS' COMP^1^SKILLED NURSING^WC-SNF
- ;;CC-WC-OPT^CC WORKERS' COMP^3^^WC-OPT
- ;;CC-WC-RX^CC WORKERS' COMP^3^^WC-RX^3140101
- ;;CC-WC-RX^CC WORKERS' COMP^3^^WC-RX^3150101
- ;;CC-WC-RX^CC WORKERS' COMP^3^^WC-RX^3160101
- ;;CC-WC-RX^CC WORKERS' COMP^3^^WC-RX^3170101
- ;;CC-WC-RX^CC WORKERS' COMP^3^^WC-RX^3180101
- ;;CCN-WC-INPT^CCN WORKERS' COMP^1^^WC-INPT
- ;;CCN-WC-SNF^CCN WORKERS' COMP^1^SKILLED NURSING^WC-SNF
- ;;CCN-WC-OPT^CCN WORKERS' COMP^3^^WC-OPT
- ;;CCN-WC-RX^CCN WORKERS' COMP^3^^WC-RX^3140101
- ;;CCN-WC-RX^CCN WORKERS' COMP^3^^WC-RX^3150101
- ;;CCN-WC-RX^CCN WORKERS' COMP^3^^WC-RX^3160101
- ;;CCN-WC-RX^CCN WORKERS' COMP^3^^WC-RX^3170101
- ;;CCN-WC-RX^CCN WORKERS' COMP^3^^WC-RX^3180101
- ;;DOD-DIS EXAM-OPT^DOD DISABILITY EVALUATION^3^OUTPATIENT VISIT^RI-OPT
- ;;DOD-SCI-INPT^DOD SPINAL CORD INJURY^1^INPATIENT^RI-INPT
- ;;DOD-SCI-OPT^DOD SPINAL CORD INJURY^3^OUTPATIENT VISIT^RI-OPT
- ;;DOD-SCI-SNF^DOD SPINAL CORD INJURY^1^SKILLED NURSING^RI-SNF
- ;;DOD-TBI-INPT^DOD TRAUMATIC BRAIN INJURY^1^INPATIENT^RI-INPT
- ;;DOD-TBI-OPT^DOD TRAUMATIC BRAIN INJURY^3^OUTPATIENT VISIT^RI-OPT
- ;;DOD-TBI-SNF^DOD TRAUMATIC BRAIN INJURY^1^SKILLED NURSING^RI-SNF
- ;;DOD-BR-INPT^DOD BLIND REHABILITATION^1^INPATIENT^RI-INPT
- ;;DOD-BR-OPT^DOD BLIND REHABILITATION^3^OUTPATIENT VISIT^RI-OPT
- ;;DOD-BR-SNF^DOD BLIND REHABILITATION^1^SKILLED NURSING^RI-SNF
- ;;TR-DENTAL^TRICARE DENTAL^3^OUTPATIENT VISIT^RI-OPT
- ;;TR-PHARM^TRICARE PHARMACY^3^^RI-RX^3140101
- ;;TR-PHARM^TRICARE PHARMACY^3^^RI-RX^3150101
- ;;TR-PHARM^TRICARE PHARMACY^3^^RI-RX^3160101
- ;;TR-PHARM^TRICARE PHARMACY^3^^RI-RX^3170101
- ;;TR-PHARM^TRICARE PHARMACY^3^^RI-RX^3180101
- ;;END
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIB20P618 14590 printed Feb 18, 2025@23:30:29 Page 2
- IB20P618 ;SAB/Albany - IB*2.0*618 POST INSTALL;12/11/17 2:10pm
- +1 ;;2.0;Integrated Billing;**618**;Mar 20, 1995;Build 61
- +2 ;Per VA Directive 6402, this routine should not be modified.
- +3 QUIT
- +4 ;
- POSTINIT ;Post Install for IB*2.0*618
- +1 DO BMES^XPDUTL(" >> Starting the Post-Initialization routine for IB*2.0*618 ")
- +2 ; Adding AR CATEGORIES and REVENUE SOURCE CODES
- +3 DO RTADD
- +4 DO RTUPD
- +5 DO ADDRS
- +6 DO IBUPD^IBP618A
- +7 DO ADDACT^IBP618A
- +8 DO UPDACT^IBP618B
- +9 DO ADDACTCH^IBP618B
- +10 DO BMES^XPDUTL(" >> End of the Post-Initialization routine for IB*2.0*618")
- +11 QUIT
- +12 ;
- RTADD ;Add New rate types to the Rate type File
- +1 ;
- +2 NEW LOOP,FDA,FDAIEN,DATA,BRF,ARCAT,CHK
- +3 ;
- +4 DO MES^XPDUTL(" -> Adding new Rate Type entries to file 399.3 ...")
- +5 ; Add new Rate Types
- +6 FOR LOOP=2:1
- SET DATA=$TEXT(RTDATA+LOOP)
- if $PIECE(DATA,";",3)="END"
- QUIT
- Begin DoDot:1
- +7 ;Clear the array
- +8 KILL FDA
- +9 ;Check to insure that the rate type doesn't exist already
- +10 ; Initialized the check variable
- SET CHK=""
- +11 SET CHK=$ORDER(^DGCR(399.3,"B",$PIECE(DATA,";",3),""))
- +12 if CHK'=""
- QUIT
- +13 ;Store in array for adding to the file (#399.3).
- +14 ;Rate Type Name
- SET FDA(399.3,"+1,",.01)=$PIECE(DATA,";",3)
- +15 ;Bill Name
- SET FDA(399.3,"+1,",.02)=$PIECE(DATA,";",4)
- +16 ;Inactive Flag
- SET FDA(399.3,"+1,",.03)=$PIECE(DATA,";",5)
- +17 ;Abbreviation
- SET FDA(399.3,"+1,",.04)=$PIECE(DATA,";",6)
- +18 ;Third Party?
- SET FDA(399.3,"+1,",.05)=$PIECE(DATA,";",7)
- +19 ;AR Cat
- SET ARCAT=$PIECE(DATA,";",8)
- +20 ;Find local IEN for AR Cat
- if ARCAT'=""
- SET ARCAT=$ORDER(^PRCA(430.2,"AC",ARCAT,""))
- +21 ;AR Cat
- SET FDA(399.3,"+1,",.06)=ARCAT
- +22 ;Responsible?
- SET FDA(399.3,"+1,",.07)=$PIECE(DATA,";",9)
- +23 ;Reimbursable
- SET FDA(399.3,"+1,",.08)=$PIECE(DATA,";",10)
- +24 ;NSC Statement
- SET FDA(399.3,"+1,",.09)=$PIECE(DATA,";",11)
- +25 ;Electronic Transmit
- SET FDA(399.3,"+1,",.1)=$PIECE(DATA,";",12)
- +26 ;Bill Resulting From (BRF) (430.6)
- SET BRF=$PIECE(DATA,";",13)
- +27 ;Find local IEN for BRF
- if BRF'=""
- SET BRF=$ORDER(^PRCA(430.6,"B",BRF,""))
- +28 SET FDA(399.3,"+1,",.11)=BRF
- +29 ;Collect?
- SET FDA(399.3,"+1,",.12)=$PIECE(DATA,";",14)
- +30 ;Add to the file.
- +31 DO UPDATE^DIE(,"FDA","FDAIEN")
- +32 SET FDAIEN=FDAIEN(1)
- KILL FDAIEN(1)
- End DoDot:1
- +33 DO MES^XPDUTL(" New Rate Types added.")
- +34 QUIT
- +35 ;
- RTDATA ; New RATE TYPE data. (Internal data format
- +1 ;;name;billname;inactive; abbreviation;thirdparty;AR Cat #;resp;reimb;nsc;etransmit;billfrom;collect?
- +2 ;;CC WORKERS' COMP;CC WORKERS' COMP;;CC WC;1;59;i;1;1;1;;
- +3 ;;CC NO-FAULT AUTO;CC NO-FAULT AUTO;;CC NF;1;60;i;1;1;1;;
- +4 ;;CC TORT FEASOR;CC TORT FEASOR;;CC TF;1;61;i;1;1;1;;
- +5 ;;CHOICE WORKERS' COMP;CHOICE WORKERS' COMP;;CCC WC;1;62;i;1;1;1;;
- +6 ;;CHOICE NO-FAULT AUTO;CHOICE NO-FAULT AUTO;;CCC NF;1;54;i;1;1;1;;
- +7 ;;CHOICE TORT FEASOR;CHOICE TORT FEASOR;;CCC TF;1;55;i;1;1;1;;
- +8 ;;CCN WORKERS' COMP;CCN WORKERS' COMP;;CCN WC;1;56;i;1;1;1;;
- +9 ;;CCN NO-FAULT AUTO;CCN NO-FAULT AUTO;;CCN NF;1;57;i;1;1;1;;
- +10 ;;CCN TORT FEASOR;CCN TORT FEASOR;;CCN TF;1;58;i;1;1;1;;
- +11 ;;CHOICE REIMB INS;CHOICE REIMB INS;;CCC REIM;1;50;i;1;1;1;HI;1
- +12 ;;CC REIMB INS;CC REIMB INS;;CC REIM;1;51;i;1;1;1;HI;1
- +13 ;;CCN REIMB INS;CCN REIMB INS;;CCN REIM;1;52;i;1;1;1;HI;1
- +14 ;;CC MTF REIMB INS;CC MTF REIMB INS;;CCD REIM;1;53;i;1;1;1;HI;1
- +15 ;;DOD DISABILITY EVALUATION;DOD DISABILITY EVALUATION;;TR IDES;1;77;i;1;1;1;HI;1
- +16 ;;DOD SPINAL CORD INJURY;DOD SPINAL CORD INJURY;;TRSPINAL;1;78;i;1;1;1;HI;1
- +17 ;;DOD TRAUMATIC BRAIN INJURY;DOD TRAUMATIC BRAIN INJURY;;TR TBI;1;79;i;1;1;1;HI;1
- +18 ;;DOD BLIND REHABILITATION;DOD BLIND REHABILITATION;;TRREHAB;1;80;i;1;1;1;HI;1
- +19 ;;TRICARE DENTAL;TRICARE DENTAL;;TR DENTAL;1;81;i;1;1;1;HI;1
- +20 ;;TRICARE PHARMACY;TRICARE PHARMACY;;TR RX;1;82;i;1;1;1;HI;1
- +21 ;;END
- +22 ;
- RTUPD ; Update the FEE REIMB INS entry in the Rate Type File (399.3) to inactivate
- +1 NEW LIEN,X,Y,DIE,DA,DR,DTOUT,DATA
- +2 ;
- +3 DO MES^XPDUTL(" -> Inactivating the FEE REIMB INS Rate Type...")
- +4 SET LIEN=$ORDER(^DGCR(399.3,"B","FEE REIMB INS",""))
- +5 if 'LIEN
- QUIT
- +6 ; File the update
- +7 SET DR=".03////1;"
- +8 SET DIE="^DGCR(399.3,"
- SET DA=LIEN
- +9 DO ^DIE
- +10 ;
- +11 QUIT
- ADDRS ; Add Rate Schedules (363) for FEE REIMB INS
- +1 DO MES^XPDUTL(" -> Adding new Rate Schedules to file 363 ...")
- +2 NEW IBA,IBCNT,IBI,IBLN,IBFN,IBRT,IBBS,IBCNTCS,IBDISP,IBJ,IBLNCS,IBCS,IBCSFN,IBADMIN,DD,DO
- +3 NEW DLAYGO,DIC,DIE,DA,DR,RXDT,X,Y,IBCPNM,IBEDT
- +4 SET IBCNT=0
- +5 FOR IBI=2:1
- SET IBLN=$PIECE($TEXT(RSF+IBI),";;",2)
- if IBLN="END"
- QUIT
- IF $EXTRACT(IBLN)?1A
- Begin DoDot:1
- +6 ;Check for problems
- +7 ;Billable service invalid
- SET IBBS=$PIECE(IBLN,U,4)
- IF IBBS'=""
- SET IBBS=$$MCCRUTL(IBBS,13)
- if 'IBBS
- QUIT
- +8 SET IBRT=$PIECE(IBLN,U,2)
- SET IBRT=$ORDER(^DGCR(399.3,"B",IBRT,0))
- Begin DoDot:2
- +9 IF 'IBRT
- DO MSG(" **** Rate Type "_$PIECE(IBLN,U,2)_" not defined, RS "_$PIECE(IBLN,U,1)_" not created")
- +10 IF +$PIECE($GET(^DGCR(399.3,+IBRT,0)),U,3)
- SET IBRT=0
- DO MSG(" **** Rate Type "_$PIECE(IBLN,U,2)_" not Active, RS "_$PIECE(IBLN,U,1)_" not created")
- End DoDot:2
- if 'IBRT
- QUIT
- +11 ;No problems found, so create entry
- +12 KILL DD,DO
- +13 SET DLAYGO=363
- SET DIC="^IBE(363,"
- SET DIC(0)="L"
- SET X=$PIECE(IBLN,U,1)
- +14 DO FILE^DICN
- KILL DIC,DINUM,DLAYGO
- +15 IF Y<1
- KILL X,Y
- QUIT
- +16 SET IBFN=+Y
- SET IBCNT=IBCNT+1
- +17 SET IBCPNM=$PIECE(IBLN,U,5)
- SET IBEDT=$PIECE(IBLN,U,6)
- +18 SET RXDT=$$RXDT(IBCPNM,IBEDT)
- +19 SET DR=".02////"_IBRT_";.03////"_$PIECE(IBLN,U,3)
- IF +IBBS
- SET DR=DR_";.04////"_IBBS
- +20 SET DR=DR_";.05////"_$PIECE(RXDT,U)
- +21 IF $PIECE(RXDT,U,2)
- SET DR=DR_";.06////"_$PIECE(RXDT,U,2)
- +22 IF ($PIECE(IBLN,U,1)["RX")
- IF ($GET(IBDISP)]"")
- SET DR=DR_";1.01///"_IBDISP
- +23 IF ($PIECE(IBLN,U,1)["RX")
- IF ($GET(IBADMIN)]"")
- SET DR=DR_";1.02////"_IBADMIN
- +24 SET DIE="^IBE(363,"
- SET DA=+Y
- DO ^DIE
- KILL DIE,DA,DR,X,Y
- +25 SET IBCNTCS=0
- +26 ; Retrieve name of Charge Set to copy
- +27 IF IBRT=""
- DO MSG(" **** Rate Type "_$PIECE(IBLN,U,2)_" missing Charge Set Information, RS "_$PIECE(IBLN,U,1)_" not created")
- QUIT
- +28 ; add all Reasonable Charges Charge Sets to the Rate Schedule.
- +29 SET IBCNTCS=$$RSCS(IBFN,IBCPNM,$PIECE(RXDT,U))
- +30 DO MES^XPDUTL(" Total Reasonable Charge Set"_$SELECT(IBCNTCS=1:" ",1:"s ")_IBCNTCS_" added to Rate Schedule "_$PIECE(IBLN,U,1)_".")
- End DoDot:1
- +31 DO MES^XPDUTL(" Rate Schedules completed.")
- +32 ;ADDRS
- QUIT
- +33 ;
- RSCS(IBFN,IBCPNM,RXDT) ; add existing Charge Sets to FR
- +1 ; copy the Charge Sets from the corresponding RI RS (v2)
- +2 ; IBFN - Rate Schedule IEN
- +3 ; IBCPNM - Charge Set to copy
- +4 ; RXDT - last effective date of charge set being copied.
- +5 NEW IBCNT,IBNRS,IBRSNM,IBTY,IBVDT,IBCOPY,IBCS,IBCS0,IBXFN,IBCSFN,IBCSNM,IBCSAA,IBNAME
- +6 SET (IBCNT,IBCOPY)=0
- +7 SET IBNRS=$GET(^IBE(363,+$GET(IBFN),0))
- SET IBRSNM=$PIECE(IBNRS,"^",1)
- +8 SET IBTY=$PIECE(IBNRS,"^",3)
- +9 SET IBVDT=RXDT
- +10 if IBVDT=""
- QUIT 0
- +11 SET IBCOPY=+$$RSEXISTS(IBVDT,IBCPNM)
- +12 IF 'IBCOPY
- GOTO RSCSQ
- +13 IF +$PIECE($GET(^IBE(363,+IBCOPY,0)),U,3)=IBTY
- Begin DoDot:1
- +14 SET IBXFN=0
- FOR
- SET IBXFN=$ORDER(^IBE(363,IBCOPY,11,IBXFN))
- if 'IBXFN
- QUIT
- Begin DoDot:2
- +15 SET IBCS=$GET(^IBE(363,IBCOPY,11,IBXFN,0))
- SET IBCSFN=+IBCS
- +16 IF +$$RSCSFILE(IBFN,$PIECE($GET(^IBE(363.1,IBCSFN,0)),U,1),$PIECE(IBCS,U,2))
- SET IBCNT=IBCNT+1
- End DoDot:2
- End DoDot:1
- RSCSQ QUIT IBCNT
- +1 ;
- +2 ;
- RSCSFILE(IBFN,IBCSNM,IBCSAA) ; Add Charge Set to a Rate Schedule
- +1 NEW IBX,DD,DO,DLAYGO,DIC,DA,DR,X,Y,IBCSFN
- SET IBX=0
- +2 IF $GET(^IBE(363,+$GET(IBFN),0))=""
- GOTO RSCSFQ
- +3 IF $GET(IBCSNM)=""
- GOTO RSCSFQ
- +4 SET IBCSFN=$ORDER(^IBE(363.1,"B",IBCSNM,0))
- IF 'IBCSFN
- GOTO RSCSFQ
- +5 IF $ORDER(^IBE(363,IBFN,11,"B",IBCSFN,0))
- GOTO RSCSFQ
- +6 SET DLAYGO=363
- SET DA(1)=+IBFN
- SET DIC="^IBE(363,"_DA(1)_",11,"
- SET DIC(0)="L"
- +7 SET X=IBCSNM
- SET DIC("DR")=".02///"_$GET(IBCSAA)
- SET DIC("P")="363.0011P"
- +8 DO ^DIC
- if +Y
- SET IBX=1
- RSCSFQ QUIT IBX
- +1 ;
- +2 ;
- RSEXISTS(IBVDT,IBNAME) ; return RS IFN if Rate Schedule exists for Effective Date
- +1 NEW IBX,IBRSFN,IBRS0
- SET IBX=0
- +2 SET IBRSFN=0
- FOR
- SET IBRSFN=$ORDER(^IBE(363,IBRSFN))
- if 'IBRSFN
- QUIT
- Begin DoDot:1
- +3 SET IBRS0=$GET(^IBE(363,IBRSFN,0))
- +4 IF $PIECE(IBRS0,U,1)=IBNAME
- IF $PIECE(IBRS0,U,5)=IBVDT
- SET IBX=IBRSFN
- End DoDot:1
- IF IBX
- QUIT
- +5 QUIT IBX
- +6 ;
- MSG(X) ;
- +1 NEW IBX
- SET IBX=$ORDER(IBA(999999),-1)
- if 'IBX
- SET IBX=1
- SET IBX=IBX+1
- +2 SET IBA(IBX)=$GET(X)
- +3 ;MSG
- QUIT
- +4 ;
- MCCRUTL(X,P) ; returns IFN of item in 399.1 if Name is found and piece P is true
- +1 NEW IBX,IBY
- SET IBY=""
- +2 IF $GET(X)'=""
- SET IBX=0
- FOR
- SET IBX=$ORDER(^DGCR(399.1,"B",X,IBX))
- if 'IBX
- QUIT
- IF $PIECE($GET(^DGCR(399.1,IBX,0)),U,+$GET(P))
- SET IBY=IBX
- +3 QUIT IBY
- +4 ;
- RXDT(IBCPNM,IBEDT) ;Copy the active charge schedule from charge set being copied.
- +1 ; update Fee information if Pharmacy.
- +2 NEW IBEFLG,IBD
- +3 ; Set to NULL if not passed in
- SET IBEDT=$GET(IBEDT)
- +4 SET IBCS=""
- +5 ;If no Effective Date sent, get the latest entry.
- +6 IF IBEDT=""
- SET IBCS=$ORDER(^IBE(363,"B",IBCPNM,IBCS),-1)
- +7 ;If Effective date sent, loop through the entries to find the entry
- +8 ; with the correct effective date.
- +9 IF IBEDT'=""
- Begin DoDot:1
- +10 SET IBEFLG=0
- +11 FOR
- SET IBCS=$ORDER(^IBE(363,"B",IBCPNM,IBCS),-1)
- if 'IBCS
- QUIT
- Begin DoDot:2
- +12 SET IBD=$GET(^IBE(363,IBCS,0))
- +13 IF $PIECE(IBD,U,5)=IBEDT
- SET IBEFLG=1
- End DoDot:2
- if IBEFLG
- QUIT
- End DoDot:1
- +14 if IBCS=""
- QUIT ""
- +15 SET IBCS0=^IBE(363,IBCS,0)
- +16 IF IBCPNM["RX"
- SET IBDISP=$PIECE($GET(^IBE(363,IBCS,1)),U,1)
- SET IBADMIN=$GET(^IBE(363,IBCS,10))
- +17 ;return effective and end dates
- QUIT $PIECE(IBCS0,U,5,6)
- +18 ;
- RSF ;Rate Schedules (363) for the new Community Care Rate Types.
- +1 ;;Rate Schedule Name^Rate Type^Bill Type^Billable Service^Rate Schedule to copy for Charge Sets
- +2 ;;CCC-NF-INPT^CHOICE NO-FAULT AUTO^1^^NF-INPT
- +3 ;;CCC-NF-SNF^CHOICE NO-FAULT AUTO^1^SKILLED NURSING^NF-SNF
- +4 ;;CCC-NF-OPT^CHOICE NO-FAULT AUTO^3^^NF-OPT
- +5 ;;CCC-NF-RX^CHOICE NO-FAULT AUTO^3^^NF-RX^3140101
- +6 ;;CCC-NF-RX^CHOICE NO-FAULT AUTO^3^^NF-RX^3150101
- +7 ;;CCC-NF-RX^CHOICE NO-FAULT AUTO^3^^NF-RX^3160101
- +8 ;;CCC-NF-RX^CHOICE NO-FAULT AUTO^3^^NF-RX^3170101
- +9 ;;CCC-NF-RX^CHOICE NO-FAULT AUTO^3^^NF-RX^3180101
- +10 ;;CC-NF-INPT^CC NO-FAULT AUTO^1^^NF-INPT
- +11 ;;CC-NF-SNF^CC NO-FAULT AUTO^1^SKILLED NURSING^NF-SNF
- +12 ;;CC-NF-OPT^CC NO-FAULT AUTO^3^^NF-OPT
- +13 ;;CC-NF-RX^CC NO-FAULT AUTO^3^^NF-RX^3140101
- +14 ;;CC-NF-RX^CC NO-FAULT AUTO^3^^NF-RX^3150101
- +15 ;;CC-NF-RX^CC NO-FAULT AUTO^3^^NF-RX^3160101
- +16 ;;CC-NF-RX^CC NO-FAULT AUTO^3^^NF-RX^3170101
- +17 ;;CC-NF-RX^CC NO-FAULT AUTO^3^^NF-RX^3180101
- +18 ;;CCN-NF-INPT^CCN NO-FAULT AUTO^1^^NF-INPT
- +19 ;;CCN-NF-SNF^CCN NO-FAULT AUTO^1^SKILLED NURSING^NF-SNF
- +20 ;;CCN-NF-OPT^CCN NO-FAULT AUTO^3^^NF-OPT
- +21 ;;CCN-NF-RX^CCN NO-FAULT AUTO^3^^NF-RX^3140101
- +22 ;;CCN-NF-RX^CCN NO-FAULT AUTO^3^^NF-RX^3150101
- +23 ;;CCN-NF-RX^CCN NO-FAULT AUTO^3^^NF-RX^3160101
- +24 ;;CCN-NF-RX^CCN NO-FAULT AUTO^3^^NF-RX^3170101
- +25 ;;CCN-NF-RX^CCN NO-FAULT AUTO^3^^NF-RX^3180101
- +26 ;;CCC-RI-INPT^CHOICE REIMB INS^1^^RI-INPT
- +27 ;;CCC-RI-SNF^CHOICE REIMB INS^1^SKILLED NURSING^RI-SNF
- +28 ;;CCC-RI-OPT^CHOICE REIMB INS^3^^RI-OPT
- +29 ;;CCC-RI-RX^CHOICE REIMB INS^3^^RI-RX^3140101
- +30 ;;CCC-RI-RX^CHOICE REIMB INS^3^^RI-RX^3150101
- +31 ;;CCC-RI-RX^CHOICE REIMB INS^3^^RI-RX^3160101
- +32 ;;CCC-RI-RX^CHOICE REIMB INS^3^^RI-RX^3170101
- +33 ;;CCC-RI-RX^CHOICE REIMB INS^3^^RI-RX^3180101
- +34 ;;CC-RI-INPT^CC REIMB INS^1^^RI-INPT
- +35 ;;CC-RI-SNF^CC REIMB INS^1^SKILLED NURSING^RI-SNF
- +36 ;;CC-RI-OPT^CC REIMB INS^3^^RI-OPT
- +37 ;;CC-RI-RX^CC REIMB INS^3^^RI-RX^3140101
- +38 ;;CC-RI-RX^CC REIMB INS^3^^RI-RX^3150101
- +39 ;;CC-RI-RX^CC REIMB INS^3^^RI-RX^3160101
- +40 ;;CC-RI-RX^CC REIMB INS^3^^RI-RX^3170101
- +41 ;;CC-RI-RX^CC REIMB INS^3^^RI-RX^3180101
- +42 ;;CCN-RI-INPT^CCN REIMB INS^1^^RI-INPT
- +43 ;;CCN-RI-SNF^CCN REIMB INS^1^SKILLED NURSING^RI-SNF
- +44 ;;CCN-RI-OPT^CCN REIMB INS^3^^RI-OPT
- +45 ;;CCN-RI-RX^CCN REIMB INS^3^^RI-RX^3140101
- +46 ;;CCN-RI-RX^CCN REIMB INS^3^^RI-RX^3150101
- +47 ;;CCN-RI-RX^CCN REIMB INS^3^^RI-RX^3160101
- +48 ;;CCN-RI-RX^CCN REIMB INS^3^^RI-RX^3170101
- +49 ;;CCN-RI-RX^CCN REIMB INS^3^^RI-RX^3180101
- +50 ;;CC-DOD-INPT^CC MTF REIMB INS^1^INPATIENT^RI-INPT
- +51 ;;CC-DOD-SNF^CC MTF REIMB INS^1^SKILLED NURSING^RI-SNF
- +52 ;;CC-DOD-OPT^CC MTF REIMB INS^3^OUTPATIENT VISIT^RI-OPT
- +53 ;;CC-DOD-RX^CC MTF REIMB INS^3^^RI-RX^3140101
- +54 ;;CC-DOD-RX^CC MTF REIMB INS^3^^RI-RX^3150101
- +55 ;;CC-DOD-RX^CC MTF REIMB INS^3^^RI-RX^3160101
- +56 ;;CC-DOD-RX^CC MTF REIMB INS^3^^RI-RX^3170101
- +57 ;;CC-DOD-RX^CC MTF REIMB INS^3^^RI-RX^3180101
- +58 ;;CCC-TF-INPT^CHOICE TORT FEASOR^1^^TF-INPT
- +59 ;;CCC-TF-SNF^CHOICE TORT FEASOR^1^SKILLED NURSING^TF-SNF
- +60 ;;CCC-TF-OPT^CHOICE TORT FEASOR^3^^TF-OPT
- +61 ;;CCC-TF-RX^CHOICE TORT FEASOR^3^^TF-RX^3140101
- +62 ;;CCC-TF-RX^CHOICE TORT FEASOR^3^^TF-RX^3150101
- +63 ;;CCC-TF-RX^CHOICE TORT FEASOR^3^^TF-RX^3160101
- +64 ;;CCC-TF-RX^CHOICE TORT FEASOR^3^^TF-RX^3170101
- +65 ;;CCC-TF-RX^CHOICE TORT FEASOR^3^^TF-RX^3180101
- +66 ;;CC-TF-INPT^CC TORT FEASOR^1^^TF-INPT
- +67 ;;CC-TF-SNF^CC TORT FEASOR^1^SKILLED NURSING^TF-SNF
- +68 ;;CC-TF-OPT^CC TORT FEASOR^3^^TF-OPT
- +69 ;;CC-TF-RX^CC TORT FEASOR^3^^TF-RX^3140101
- +70 ;;CC-TF-RX^CC TORT FEASOR^3^^TF-RX^3150101
- +71 ;;CC-TF-RX^CC TORT FEASOR^3^^TF-RX^3160101
- +72 ;;CC-TF-RX^CC TORT FEASOR^3^^TF-RX^3170101
- +73 ;;CC-TF-RX^CC TORT FEASOR^3^^TF-RX^3180101
- +74 ;;CCN-TF-INPT^CCN TORT FEASOR^1^^TF-INPT
- +75 ;;CCN-TF-SNF^CCN TORT FEASOR^1^SKILLED NURSING^TF-SNF
- +76 ;;CCN-TF-OPT^CCN TORT FEASOR^3^^TF-OPT
- +77 ;;CCN-TF-RX^CCN TORT FEASOR^3^^TF-RX^3140101
- +78 ;;CCN-TF-RX^CCN TORT FEASOR^3^^TF-RX^3150101
- +79 ;;CCN-TF-RX^CCN TORT FEASOR^3^^TF-RX^3160101
- +80 ;;CCN-TF-RX^CCN TORT FEASOR^3^^TF-RX^3170101
- +81 ;;CCN-TF-RX^CCN TORT FEASOR^3^^TF-RX^3180101
- +82 ;;CCC-WC-INPT^CHOICE WORKERS' COMP^1^^WC-INPT
- +83 ;;CCC-WC-SNF^CHOICE WORKERS' COMP^1^SKILLED NURSING^WC-SNF
- +84 ;;CCC-WC-OPT^CHOICE WORKERS' COMP^3^^WC-OPT
- +85 ;;CCC-WC-RX^CHOICE WORKERS' COMP^3^^WC-RX^3140101
- +86 ;;CCC-WC-RX^CHOICE WORKERS' COMP^3^^WC-RX^3150101
- +87 ;;CCC-WC-RX^CHOICE WORKERS' COMP^3^^WC-RX^3160101
- +88 ;;CCC-WC-RX^CHOICE WORKERS' COMP^3^^WC-RX^3170101
- +89 ;;CCC-WC-RX^CHOICE WORKERS' COMP^3^^WC-RX^3180101
- +90 ;;CC-WC-INPT^CC WORKERS' COMP^1^^WC-INPT
- +91 ;;CC-WC-SNF^CC WORKERS' COMP^1^SKILLED NURSING^WC-SNF
- +92 ;;CC-WC-OPT^CC WORKERS' COMP^3^^WC-OPT
- +93 ;;CC-WC-RX^CC WORKERS' COMP^3^^WC-RX^3140101
- +94 ;;CC-WC-RX^CC WORKERS' COMP^3^^WC-RX^3150101
- +95 ;;CC-WC-RX^CC WORKERS' COMP^3^^WC-RX^3160101
- +96 ;;CC-WC-RX^CC WORKERS' COMP^3^^WC-RX^3170101
- +97 ;;CC-WC-RX^CC WORKERS' COMP^3^^WC-RX^3180101
- +98 ;;CCN-WC-INPT^CCN WORKERS' COMP^1^^WC-INPT
- +99 ;;CCN-WC-SNF^CCN WORKERS' COMP^1^SKILLED NURSING^WC-SNF
- +100 ;;CCN-WC-OPT^CCN WORKERS' COMP^3^^WC-OPT
- +101 ;;CCN-WC-RX^CCN WORKERS' COMP^3^^WC-RX^3140101
- +102 ;;CCN-WC-RX^CCN WORKERS' COMP^3^^WC-RX^3150101
- +103 ;;CCN-WC-RX^CCN WORKERS' COMP^3^^WC-RX^3160101
- +104 ;;CCN-WC-RX^CCN WORKERS' COMP^3^^WC-RX^3170101
- +105 ;;CCN-WC-RX^CCN WORKERS' COMP^3^^WC-RX^3180101
- +106 ;;DOD-DIS EXAM-OPT^DOD DISABILITY EVALUATION^3^OUTPATIENT VISIT^RI-OPT
- +107 ;;DOD-SCI-INPT^DOD SPINAL CORD INJURY^1^INPATIENT^RI-INPT
- +108 ;;DOD-SCI-OPT^DOD SPINAL CORD INJURY^3^OUTPATIENT VISIT^RI-OPT
- +109 ;;DOD-SCI-SNF^DOD SPINAL CORD INJURY^1^SKILLED NURSING^RI-SNF
- +110 ;;DOD-TBI-INPT^DOD TRAUMATIC BRAIN INJURY^1^INPATIENT^RI-INPT
- +111 ;;DOD-TBI-OPT^DOD TRAUMATIC BRAIN INJURY^3^OUTPATIENT VISIT^RI-OPT
- +112 ;;DOD-TBI-SNF^DOD TRAUMATIC BRAIN INJURY^1^SKILLED NURSING^RI-SNF
- +113 ;;DOD-BR-INPT^DOD BLIND REHABILITATION^1^INPATIENT^RI-INPT
- +114 ;;DOD-BR-OPT^DOD BLIND REHABILITATION^3^OUTPATIENT VISIT^RI-OPT
- +115 ;;DOD-BR-SNF^DOD BLIND REHABILITATION^1^SKILLED NURSING^RI-SNF
- +116 ;;TR-DENTAL^TRICARE DENTAL^3^OUTPATIENT VISIT^RI-OPT
- +117 ;;TR-PHARM^TRICARE PHARMACY^3^^RI-RX^3140101
- +118 ;;TR-PHARM^TRICARE PHARMACY^3^^RI-RX^3150101
- +119 ;;TR-PHARM^TRICARE PHARMACY^3^^RI-RX^3160101
- +120 ;;TR-PHARM^TRICARE PHARMACY^3^^RI-RX^3170101
- +121 ;;TR-PHARM^TRICARE PHARMACY^3^^RI-RX^3180101
- +122 ;;END
- +123 ;