- 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
