ABMDTPAR ; IHS/ASDST/DMJ - Table Maintenance of 3P PARAMETERS ;
;;2.6;IHS Third Party Billing;**1,3,11,21**;NOV 12, 2009;Build 379
;
; IHS/SD/SDR - v2.5 p8 - added code for UNCODED DX LAG TIME prompt
; IHS/SD/SDR - V2.5 P8 - IM12246/IM17548 - Added code for default prompt for Reference and In-House CLIAs
; IHS/SD/SDR - v2.5 p9 - IM14099 - Fixed access to multiple; would error when user typed "??"
; IHS/SD/SDR - v2.5 p10 - IM17482 - Add site parameter for restricting PRV segment by insurer
; IHS/SD/SDR - v2.5 p10 - IM19802 - Fix multiple lookup
; IHS/SD/SDR - v2.5 p10 - IM20089 - Added code for new prompt to override ISA08 value for Medicare
; IHS/SD/SDR - v2.5 p11 - Patient Statement - Added prompt for statement header line 2
; IHS/SD/SDR - v2.5 p13 - POA changes - Added new prompt
; IHS/SD/SDR - abm*2.6*1 - HEAT4158 - Added prompt for mammography cert#
;IHS/SD/SDR - 2.6*21 - HEAT130406 - Removed prompt for DAYS INACTIVE BEFORE PURGING
;IHS/SD/SDR - 2.6*21 - VMBP - Updated p11 changes to include Serena ref#s
;
; *********************************************************************
;
W !
K DTOUT,DUOUT
AFFL I '$D(^ABMDPARM(DUZ(2),1,0)) D
.W !,"Site ",$P(^DIC(4,DUZ(2),0),U)," has not been initialized in 3P Billing Package."
.W !,"I will now run option INITIALIZE SITE."
.D ^ABMDSS
Q:'$D(^ABMDPARM(DUZ(2),1,0)) S ABM("X")=$P(^(0),U)
Q:'$D(^AUTTLOC(ABM("X"),0)) S ABM("LCD")=$P(^(0),U,7)
S ABM("AFFL")=""
S ABM("I")=0 F S ABM("I")=$O(^AUTTLOC(ABM("X"),11,ABM("I"))) Q:'ABM("I") S ABM("IDT")=$S($P(^(ABM("I"),0),U,2)]"":$P(^(0),U,2),1:9999999) I DT>$P(^(0),U)&(DT<ABM("IDT")) S ABM("AFFL")=$P(^(0),U,3)
I ABM("AFFL")="" D SETAF G XIT:$D(DTOUT)!$D(DUOUT)
S:ABM("AFFL")="" ABM("AFFL")=1
S DA=1,DIE="^ABMDPARM(DUZ(2),"
S DR=".34T" ; EMC File Preference
S DR=DR_";S:X=""K"" Y=""@1"" S:X=""H"" Y=""@2"""
S DR=DR_";.39T"
S DR=DR_";S Y=""@1"""
S DR=DR_";@2"
S DR=DR_";.47T" ; Default EMC Path
S DR=DR_";.23T" ; Facility to receive payments
S DR=DR_";.26T" ; Printable name of payment site
S DR=DR_";.09T" ; Current Default fee schedule
S DR=DR_";.18T" ; Create bills for all patients
S DR=DR_";I 'X S Y=.13" ; Branching
S DR=DR_";.185T" ; Display bene patient all claims
S DR=DR_";.13T" ; Require that queing be forced
S DR=DR_";.14T" ; Display long ICP/CPT description
S DR=DR_";.16T" ; Backbill limit
S DR=DR_";.17T" ; Block 31 (HCFA 1500) to print
S DR=DR_";I X'=3 S Y=.38"
S DR=DR_";.37T" ; HCFA-1500 Signature
S DR=DR_";.38T" ; UB-92 Signature
S DR=DR_";.36T" ; Place of service code
S DR=DR_";.24T" ; Bill Number suffix
S DR=DR_";.33T" ; Append HRN to bill number
S DR=DR_";.25T" ; Allow for CPT modifiers prompt
S DR=DR_";.27T" ; Set prof. component Automatically
;S DR=DR_";.28T" ; Days inactive before purging abm*2.6*21 IHS/SD/SDR HEAT130406
S DR=DR_";.29T" ; Default version of HCFA-1500
S DR=DR_";.32T" ; Default form for dental billing
S DR=DR_";.312T" ;VA Station Number ;abm*2.6*11 VMBP RQMT_93
S DR=DR_";.313T" ;VA Contract Number ;abm*2.6*11 VMBP RQMT_93
D ^DIE K DR Q:$D(Y)
S DA(1)=DA
S ABMFLD="15",ABMFLE="9002274.5" D MULTLKUP(ABMFLD,ABMFLE) ;default unbillable clinics
S ABMFLD="17",ABMFLE="9002274.5" D MULTLKUP(ABMFLD,ABMFLE) ;default invalid prv discipline
S ABMFLD="6",ABMFLE="9002274.5" D MULTLKUP(ABMFLD,ABMFLE) ;unbillable insurers
S DA=1,DIE="^ABMDPARM(DUZ(2),"
S DR=".3T//P" ;UB92 FL38
S DR=DR_";.411" ; In-House CLIA
S DR=DR_";.412" ; Reference Lab CLIA
D ^DIE K DR Q:$D(Y)
S DR=".48T" D ^DIE Q:$D(Y)
S DR=".52T" D ^DIE Q:$D(Y)
S DR=".49T" D ^DIE Q:$D(Y)
S DR="212T" D ^DIE Q:$D(Y)
;S DR=".51T" ;abm*2.6*1 HEAT4158
S DR=".51T" D ^DIE Q:$D(Y) ;abm*2.6*1 HEAT4158
S DR=".54T" D ^DIE Q:$D(Y) ;abm*2.6*1 HEAT4158
;D ^DIE ;abm*2.6*1 HEAT4158
I $P($G(^ABMDPARM(DUZ(2),1,5)),U)'=2 D
.S DR=".53"
.D ^DIE
I $P($G(^ABMDPARM(DUZ(2),1,5)),U)=2 D
.S DR=".53////@" ;remove anything that might be there
.D ^DIE
Q:$D(Y)
S DR=".311T" D ^DIE Q:$D(Y)
S DR="211T" D ^DIE Q:$D(Y) ;pt stmt
S DR="214T" D ^DIE Q:$D(Y) ;pt stmt dt abm*2.6*3
S DR="213T" D ^DIE Q:$D(Y) ;poa
W !!,"RX DISPENSE FEES",!,"================"
S DR=".03T;.41T;.42T;.43T;.44T;.45T;.46T" D ^DIE K DR Q:$D(Y)
W ! S DR=11 D ^DIE K DR Q:$D(Y)
G XIT:$D(Y)!$D(DTOUT)!$D(DUOUT)!$D(ABM("DIE-FAIL"))
S DIE="^ABMDEXP(",DA=11,DR=1 D ^DIE Q:$D(Y)
S DIE="^ABMDPARM(DUZ(2),",DA=1,DR=".15////Y" D ^DIE Q:$D(Y)
S ABMFLD="19",ABMFLE="9002274.5" D MULTLKUP(ABMFLD,ABMFLE)
ITYPES ;ENTER INSURANCE TYPE TO EXPORT TO AREA OFFICE
;
K DIR
;
XIT K DIE,ABM,DR
Q
;
SETAF ;SET AFFILIATION
W *7,!!?5,"The Affilation of "_$P(^AUTTLOC(ABM("X"),0),U,2)_" has not been Established!",!
S DIE="^AUTTLOC(",DA=DUZ(2),DR=1101 D ^DIE
Q
MULTLKUP(ABMFLD,ABMFLE) ;lookup/edit of 3p Parameters multiples
N X,Y
F D Q:$D(DTOUT)!($D(DUOUT))!(+$G(Y)<0)
.S DA(1)=1
.S DIC="^ABMDPARM(DUZ(2),"_DA(1)_","_ABMFLD_","
.S DIC(0)="AEMLQ"
.K DD,DO
.S DIC("P")=$P(^DD(ABMFLE,ABMFLD,0),U,2)
.D ^DIC
.Q:Y<0
.I $D(DTOUT)!$D(DUOUT) Q
.I $P(Y,U,3)="" D ;not a new entry
..S DIE=DIC
..S DA=+Y
..S DR=".01"
..D ^DIE
Q
ABMDTPAR ; IHS/ASDST/DMJ - Table Maintenance of 3P PARAMETERS ;
+1 ;;2.6;IHS Third Party Billing;**1,3,11,21**;NOV 12, 2009;Build 379
+2 ;
+3 ; IHS/SD/SDR - v2.5 p8 - added code for UNCODED DX LAG TIME prompt
+4 ; IHS/SD/SDR - V2.5 P8 - IM12246/IM17548 - Added code for default prompt for Reference and In-House CLIAs
+5 ; IHS/SD/SDR - v2.5 p9 - IM14099 - Fixed access to multiple; would error when user typed "??"
+6 ; IHS/SD/SDR - v2.5 p10 - IM17482 - Add site parameter for restricting PRV segment by insurer
+7 ; IHS/SD/SDR - v2.5 p10 - IM19802 - Fix multiple lookup
+8 ; IHS/SD/SDR - v2.5 p10 - IM20089 - Added code for new prompt to override ISA08 value for Medicare
+9 ; IHS/SD/SDR - v2.5 p11 - Patient Statement - Added prompt for statement header line 2
+10 ; IHS/SD/SDR - v2.5 p13 - POA changes - Added new prompt
+11 ; IHS/SD/SDR - abm*2.6*1 - HEAT4158 - Added prompt for mammography cert#
+12 ;IHS/SD/SDR - 2.6*21 - HEAT130406 - Removed prompt for DAYS INACTIVE BEFORE PURGING
+13 ;IHS/SD/SDR - 2.6*21 - VMBP - Updated p11 changes to include Serena ref#s
+14 ;
+15 ; *********************************************************************
+16 ;
+17 WRITE !
+18 KILL DTOUT,DUOUT
AFFL IF '$DATA(^ABMDPARM(DUZ(2),1,0))
Begin DoDot:1
+1 WRITE !,"Site ",$PIECE(^DIC(4,DUZ(2),0),U)," has not been initialized in 3P Billing Package."
+2 WRITE !,"I will now run option INITIALIZE SITE."
+3 DO ^ABMDSS
End DoDot:1
+4 IF '$DATA(^ABMDPARM(DUZ(2),1,0))
QUIT
SET ABM("X")=$PIECE(^(0),U)
+5 IF '$DATA(^AUTTLOC(ABM("X"),0))
QUIT
SET ABM("LCD")=$PIECE(^(0),U,7)
+6 SET ABM("AFFL")=""
+7 SET ABM("I")=0
FOR
SET ABM("I")=$ORDER(^AUTTLOC(ABM("X"),11,ABM("I")))
IF 'ABM("I")
QUIT
SET ABM("IDT")=$SELECT($PIECE(^(ABM("I"),0),U,2)]"":$PIECE(^(0),U,2),1:9999999)
IF DT>$PIECE(^(0),U)&(DT<ABM("IDT"))
SET ABM("AFFL")=$PIECE(^(0),U,3)
+8 IF ABM("AFFL")=""
DO SETAF
IF $DATA(DTOUT)!$DATA(DUOUT)
GOTO XIT
+9 IF ABM("AFFL")=""
SET ABM("AFFL")=1
+10 SET DA=1
SET DIE="^ABMDPARM(DUZ(2),"
+11 ; EMC File Preference
SET DR=".34T"
+12 SET DR=DR_";S:X=""K"" Y=""@1"" S:X=""H"" Y=""@2"""
+13 SET DR=DR_";.39T"
+14 SET DR=DR_";S Y=""@1"""
+15 SET DR=DR_";@2"
+16 ; Default EMC Path
SET DR=DR_";.47T"
+17 ; Facility to receive payments
SET DR=DR_";.23T"
+18 ; Printable name of payment site
SET DR=DR_";.26T"
+19 ; Current Default fee schedule
SET DR=DR_";.09T"
+20 ; Create bills for all patients
SET DR=DR_";.18T"
+21 ; Branching
SET DR=DR_";I 'X S Y=.13"
+22 ; Display bene patient all claims
SET DR=DR_";.185T"
+23 ; Require that queing be forced
SET DR=DR_";.13T"
+24 ; Display long ICP/CPT description
SET DR=DR_";.14T"
+25 ; Backbill limit
SET DR=DR_";.16T"
+26 ; Block 31 (HCFA 1500) to print
SET DR=DR_";.17T"
+27 SET DR=DR_";I X'=3 S Y=.38"
+28 ; HCFA-1500 Signature
SET DR=DR_";.37T"
+29 ; UB-92 Signature
SET DR=DR_";.38T"
+30 ; Place of service code
SET DR=DR_";.36T"
+31 ; Bill Number suffix
SET DR=DR_";.24T"
+32 ; Append HRN to bill number
SET DR=DR_";.33T"
+33 ; Allow for CPT modifiers prompt
SET DR=DR_";.25T"
+34 ; Set prof. component Automatically
SET DR=DR_";.27T"
+35 ;S DR=DR_";.28T" ; Days inactive before purging abm*2.6*21 IHS/SD/SDR HEAT130406
+36 ; Default version of HCFA-1500
SET DR=DR_";.29T"
+37 ; Default form for dental billing
SET DR=DR_";.32T"
+38 ;VA Station Number ;abm*2.6*11 VMBP RQMT_93
SET DR=DR_";.312T"
+39 ;VA Contract Number ;abm*2.6*11 VMBP RQMT_93
SET DR=DR_";.313T"
+40 DO ^DIE
KILL DR
IF $DATA(Y)
QUIT
+41 SET DA(1)=DA
+42 ;default unbillable clinics
SET ABMFLD="15"
SET ABMFLE="9002274.5"
DO MULTLKUP(ABMFLD,ABMFLE)
+43 ;default invalid prv discipline
SET ABMFLD="17"
SET ABMFLE="9002274.5"
DO MULTLKUP(ABMFLD,ABMFLE)
+44 ;unbillable insurers
SET ABMFLD="6"
SET ABMFLE="9002274.5"
DO MULTLKUP(ABMFLD,ABMFLE)
+45 SET DA=1
SET DIE="^ABMDPARM(DUZ(2),"
+46 ;UB92 FL38
SET DR=".3T//P"
+47 ; In-House CLIA
SET DR=DR_";.411"
+48 ; Reference Lab CLIA
SET DR=DR_";.412"
+49 DO ^DIE
KILL DR
IF $DATA(Y)
QUIT
+50 SET DR=".48T"
DO ^DIE
IF $DATA(Y)
QUIT
+51 SET DR=".52T"
DO ^DIE
IF $DATA(Y)
QUIT
+52 SET DR=".49T"
DO ^DIE
IF $DATA(Y)
QUIT
+53 SET DR="212T"
DO ^DIE
IF $DATA(Y)
QUIT
+54 ;S DR=".51T" ;abm*2.6*1 HEAT4158
+55 ;abm*2.6*1 HEAT4158
SET DR=".51T"
DO ^DIE
IF $DATA(Y)
QUIT
+56 ;abm*2.6*1 HEAT4158
SET DR=".54T"
DO ^DIE
IF $DATA(Y)
QUIT
+57 ;D ^DIE ;abm*2.6*1 HEAT4158
+58 IF $PIECE($GET(^ABMDPARM(DUZ(2),1,5)),U)'=2
Begin DoDot:1
+59 SET DR=".53"
+60 DO ^DIE
End DoDot:1
+61 IF $PIECE($GET(^ABMDPARM(DUZ(2),1,5)),U)=2
Begin DoDot:1
+62 ;remove anything that might be there
SET DR=".53////@"
+63 DO ^DIE
End DoDot:1
+64 IF $DATA(Y)
QUIT
+65 SET DR=".311T"
DO ^DIE
IF $DATA(Y)
QUIT
+66 ;pt stmt
SET DR="211T"
DO ^DIE
IF $DATA(Y)
QUIT
+67 ;pt stmt dt abm*2.6*3
SET DR="214T"
DO ^DIE
IF $DATA(Y)
QUIT
+68 ;poa
SET DR="213T"
DO ^DIE
IF $DATA(Y)
QUIT
+69 WRITE !!,"RX DISPENSE FEES",!,"================"
+70 SET DR=".03T;.41T;.42T;.43T;.44T;.45T;.46T"
DO ^DIE
KILL DR
IF $DATA(Y)
QUIT
+71 WRITE !
SET DR=11
DO ^DIE
KILL DR
IF $DATA(Y)
QUIT
+72 IF $DATA(Y)!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(ABM("DIE-FAIL"))
GOTO XIT
+73 SET DIE="^ABMDEXP("
SET DA=11
SET DR=1
DO ^DIE
IF $DATA(Y)
QUIT
+74 SET DIE="^ABMDPARM(DUZ(2),"
SET DA=1
SET DR=".15////Y"
DO ^DIE
IF $DATA(Y)
QUIT
+75 SET ABMFLD="19"
SET ABMFLE="9002274.5"
DO MULTLKUP(ABMFLD,ABMFLE)
ITYPES ;ENTER INSURANCE TYPE TO EXPORT TO AREA OFFICE
+1 ;
+2 KILL DIR
+3 ;
XIT KILL DIE,ABM,DR
+1 QUIT
+2 ;
SETAF ;SET AFFILIATION
+1 WRITE *7,!!?5,"The Affilation of "_$PIECE(^AUTTLOC(ABM("X"),0),U,2)_" has not been Established!",!
+2 SET DIE="^AUTTLOC("
SET DA=DUZ(2)
SET DR=1101
DO ^DIE
+3 QUIT
MULTLKUP(ABMFLD,ABMFLE) ;lookup/edit of 3p Parameters multiples
+1 NEW X,Y
+2 FOR
Begin DoDot:1
+3 SET DA(1)=1
+4 SET DIC="^ABMDPARM(DUZ(2),"_DA(1)_","_ABMFLD_","
+5 SET DIC(0)="AEMLQ"
+6 KILL DD,DO
+7 SET DIC("P")=$PIECE(^DD(ABMFLE,ABMFLD,0),U,2)
+8 DO ^DIC
+9 IF Y<0
QUIT
+10 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+11 ;not a new entry
IF $PIECE(Y,U,3)=""
Begin DoDot:2
+12 SET DIE=DIC
+13 SET DA=+Y
+14 SET DR=".01"
+15 DO ^DIE
End DoDot:2
End DoDot:1
IF $DATA(DTOUT)!($DATA(DUOUT))!(+$GET(Y)<0)
QUIT
+16 QUIT
