ABMPT261.m

ABMPT261 ; IHS/SD/SDR - 3P BILLING 2.6 Patch 1 POST INIT ;  

 ;;2.6;IHS Third Party Billing;**1**;NOV 12, 2009

 ;

 Q

EN ;EP

 D ECODES

 D QEXP29  ;add prior auth question (#28) to export mode 29

 Q

ECODES ;

 ;HEAT 6439

 Q:$D(^ABMDCODE("AC","W"))  ;PWK codes already entered

 K DIC,X

 F ABMI=1:1 S ABMLN=$P($T(ECODETXT+ABMI),";;",2) Q:ABMLN="END"  D

 .S ABMCODE=$P(ABMLN,U)

 .S ABMDESC=$P(ABMLN,U,2)

 .S DIC="^ABMDCODE("

 .S DIC(0)="ML"

 .S X=ABMCODE

 .S DIC("DR")=".02///W"

 .S DIC("DR")=DIC("DR")_";.03///"_ABMDESC

 .K DD,DO

 .D FILE^DICN

 Q

ECODETXT ;

 ;;77^Support Data for Verification (REFERRAL)

 ;;AS^Admission Summary

 ;;B2^Prescription

 ;;B3^Physician Order

 ;;B4^Referral Form

 ;;CT^Certification

 ;;DA^Dental Models

 ;;DG^Diagnostic Report

 ;;DS^Discharge Summary

 ;;EB^Explanation of Benefits (CoB or MSP)

 ;;MT^Models

 ;;NN^Nursing Notes

 ;;OB^Operative Note

 ;;OZ^Support Data for Claim

 ;;PN^Physical Therapy Notes

 ;;PO^Prosthetics or Orthotic Certification

 ;;PZ^Physical Therapy Certification

 ;;RB^Radiology Films

 ;;RR^Radiology Reports

 ;;RT^Report of Tests and Analysis Report

 ;;P6^Periodontal Chart

 ;;END

 Q

QEXP29 ;

 S ABMLIST=$P($G(^ABMDEXP(29,0)),U,8)

 S ABMLIST=ABMLIST_",28"

 S DIE="^ABMDEXP("

 S DA=29

 S DR=".08////"_ABMLIST

 D ^DIE

 Q

ABMPT261  ; IHS/SD/SDR - 3P BILLING 2.6 Patch 1 POST INIT ;  

 +1       ;;2.6;IHS Third Party Billing;**1**;NOV 12, 2009

 +2       ;

 +3        QUIT 

EN        ;EP

 +1        DO ECODES

 +2       ;add prior auth question (#28) to export mode 29

           DO QEXP29

 +3        QUIT 

ECODES    ;

 +1       ;HEAT 6439

 +2       ;PWK codes already entered

           IF $DATA(^ABMDCODE("AC","W"))

               QUIT 

 +3        KILL DIC,X

 +4        FOR ABMI=1:1

               SET ABMLN=$PIECE($TEXT(ECODETXT+ABMI),";;",2)

               IF ABMLN="END"

                   QUIT 

               Begin DoDot:1

 +5                SET ABMCODE=$PIECE(ABMLN,U)

 +6                SET ABMDESC=$PIECE(ABMLN,U,2)

 +7                SET DIC="^ABMDCODE("

 +8                SET DIC(0)="ML"

 +9                SET X=ABMCODE

 +10               SET DIC("DR")=".02///W"

 +11               SET DIC("DR")=DIC("DR")_";.03///"_ABMDESC

 +12               KILL DD,DO

 +13               DO FILE^DICN

               End DoDot:1

 +14       QUIT 

ECODETXT  ;

 +1       ;;77^Support Data for Verification (REFERRAL)

 +2       ;;AS^Admission Summary

 +3       ;;B2^Prescription

 +4       ;;B3^Physician Order

 +5       ;;B4^Referral Form

 +6       ;;CT^Certification

 +7       ;;DA^Dental Models

 +8       ;;DG^Diagnostic Report

 +9       ;;DS^Discharge Summary

 +10      ;;EB^Explanation of Benefits (CoB or MSP)

 +11      ;;MT^Models

 +12      ;;NN^Nursing Notes

 +13      ;;OB^Operative Note

 +14      ;;OZ^Support Data for Claim

 +15      ;;PN^Physical Therapy Notes

 +16      ;;PO^Prosthetics or Orthotic Certification

 +17      ;;PZ^Physical Therapy Certification

 +18      ;;RB^Radiology Films

 +19      ;;RR^Radiology Reports

 +20      ;;RT^Report of Tests and Analysis Report

 +21      ;;P6^Periodontal Chart

 +22      ;;END

 +23       QUIT 

QEXP29    ;

 +1        SET ABMLIST=$PIECE($GET(^ABMDEXP(29,0)),U,8)

 +2        SET ABMLIST=ABMLIST_",28"

 +3        SET DIE="^ABMDEXP("

 +4        SET DA=29

 +5        SET DR=".08////"_ABMLIST

 +6        DO ^DIE

 +7        QUIT