Routine: ABMPT255

ABMPT255 ; IHS/ASDST/LSL - 3P BILLING 2.5 Patch 5 POST INIT ;

 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009

 ; 03/09/04 V2.5 P5 - Post init routine created

EN ; EP

 D ^ABMDPOST                 ; Just in case patch 2 not installed

 Q:$G(^ABMDERR(192,0))'=""   ;post-init has already been installed-don't do again

 D ERRCD192                    ; Create 3P Error Code 192

 D ERRCD193                    ; Create 3P Error Code 193

 D CODES                        ;Update codes to be one character

 D QUES               ;make sure right questions are on 837 formats

ERRCD192 ;

 ; Create 3P Error Code 192 - Imprecise Injury Date

 ; The code error for all 3 837 modes of export, else warning

 S DIC="^ABMDERR("

 S DIC(0)="EMQZXL"

 S DINUM=192

 S DLAYGO=9002274

 S X="IMPRECISE INJURY DATE"

 K DD,DO

 D FILE^DICN

 I +Y<1 Q

 S DIE=DIC

 S DA=+Y

 S DR=".02///If page 3 question ""Accident Related"" is yes, an exact date (mm/dd/yyyy) of injury is required"

 D ^DIE

 S IEN=DA

 D ERRSITE(IEN)

 F X=21,22,23 D EXPMODE(IEN,X)

ERRCD193 ;

 ; Create 3P Error Code 193 - Referring Provider Missing Person Class

 S DIC="^ABMDERR("

 S DIC(0)="EMQZXL"

 S DINUM=193

 S DLAYGO=9002274

 S X="PIN/PERSON CLASS MISSING FROM REFERRING PROVIDER"

 K DD,DO

 D FILE^DICN

 I +Y<1 Q

 S DIE=DIC

 S DA=+Y

 S DR=".02///Edit Referring Physician on page 3 and add Referring Physician PIN and/or Referring Physician Person Class"

 D ^DIE

 S IEN=DA

 D ERRSITE(IEN)

 F X=21,22,23 D EXPMODE(IEN,X)

ERRSITE(IEN) ;

 S ABMSITE=1

 F  S ABMSITE=$O(^ABMDPARM(ABMSITE)) Q:+ABMSITE=0  D

 . K DA,DIE,DIC,DR,Y,DINUM

 . S DLAYGO=9002274

 . S DA(1)=IEN

 . S DIC="^ABMDERR("_DA(1)_",31,"

 . S DINUM=ABMSITE,X=ABMSITE

 . S DIC(0)="EQXMLZ"

 . S DIC("P")=$P(^DD(9002274.04,31,0),U,2)

 . S DIC("DR")=".03///E"

 . K DD,DO

 . D FILE^DICN

EXPMODE(IEN,X) ;

 Q:'+IEN

 K DA,DIE,DIC,DR,Y,DINUM

 S DLAYGO=9002274

 S DA(1)=IEN

 S DIC="^ABMDERR("_DA(1)_",21,"

 S DINUM=X

 S DIC(0)="EQXMLZ"

 S DIC("P")=$P(^DD(9002274.04,21,0),U,2)

 K DD,DO

 D FILE^DICN

CODES ; change admission type and admission source codes to 1-digit codes

 S DIE="^ABMDCODE("

 F ABMT="A","T" D

 .S ABMCD=""

 .F  S ABMCD=$O(^ABMDCODE("AC",ABMT,ABMCD)) Q:ABMCD=""  D

 ..Q:$L(ABMCD)=1

 ..S ABMIEN=""

 ..F  S ABMIEN=$O(^ABMDCODE("AC",ABMT,ABMCD,ABMIEN)) Q:ABMIEN=""  D

 ...S DA=ABMIEN

 ...S DR=".01///"_+ABMCD

 ...D ^DIE

 K ABMT,ABMIEN

 ; add new codes with category Type of Service

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

 .S ABMCD=$P(ABMLN,"^")

 .S ABMDESC=$P(ABMLN,"^",2)

 .S DIC="^ABMDCODE("

 .S DIC(0)="ALM"

 .S DIC("DR")=".01////"_ABMCD_";.02////K;.03////"_ABMDESC

 .K DD,DO

 .D FILE^DICN

QUES ;

 S DIE="^ABMDEXP("

 F DA=21,22,23 D

 .I DA=21 S DR=".08////1,2,3,4,5,8,14,19,21,22,23,24,28"

 .I DA=22 S DR=".08////1,2,3,4B,5,6,7,9,10,11,12B,14,15,19,20,25,26,28,29,30"

 .I DA=23 S DR=".08////1,2,3,4B,5,14,16,17,18,19,28"

 .D ^DIE

CODETOS ;

 ;;0^WHOLE BLOOD

 ;;1^MEDICAL CARE

 ;;2^SURGERY

 ;;3^CONSULATION

 ;;4^DIAGNOSTIC RADIOLOGY

 ;;5^DIAGNOSTIC LABORATORY

 ;;6^THERAPEUTIC RADIOLOGY

 ;;7^ANESTHESIA

 ;;8^ASSISTANT AT SURGERY

 ;;9^OTHER MEDICAL ITEMS OR SERVICES

 ;;A^USED DME

 ;;B^HIGH RISK SCREENING MAMMOGRAPHY

 ;;C^LOW RISK SCREENING MAMMOGRAPHY

 ;;D^AMBULANCE

 ;;E^ENTERAL/PARENTERAL NUTRIENTS/SUPPLIES

 ;;F^AMBULATORY SURGICAL CENTER

 ;;G^IMMUNOSUPPRESSIVE DRUGS

 ;;H^HOSPICE

 ;;J^DIABETIC SHOES

 ;;K^HEARING ITEMS AND SERVICES

 ;;L^ESRD SUPPLIES

 ;;M^MONTHLY CAPITATION PAYMENT FOR DIALYSIS

 ;;N^KIDNEY DONOR

 ;;P^LUMP SUM PURCHASE OF DME, PROSTHETICS, ORTHOTICS

 ;;Q^VISION ITEMS OR SERVICES

 ;;R^RENTAL OF DME

 ;;S^SURGICAL DRESSINGS OR OTHER MEDICAL SUPPLIES

 ;;T^OUTPATIENT MENTAL HEALTH TREATMENT LIMITATION

 ;;U^OCCUPATIONAL THERAPY

 ;;V^PNEUMOCOCCAL/FLU VACCINE

 ;;W^PHYSICAL THERAPY

 ;;END

ABMPT255  ; IHS/ASDST/LSL - 3P BILLING 2.5 Patch 5 POST INIT ;

 +1       ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009

 +2       ;

 +3       ; 03/09/04 V2.5 P5 - Post init routine created

 +4       ;

 +5        QUIT

EN        ; EP

 +1       ; Just in case patch 2 not installed

           DO ^ABMDPOST

 +2       ;post-init has already been installed-don't do again

           IF $GET(^ABMDERR(192,0))'=""

               QUIT

 +3       ; Create 3P Error Code 192

           DO ERRCD192

 +4       ; Create 3P Error Code 193

           DO ERRCD193

 +5       ;Update codes to be one character

           DO CODES

 +6       ;make sure right questions are on 837 formats

           DO QUES

 +7        QUIT

 +8       ;

ERRCD192  ;

 +1       ; Create 3P Error Code 192 - Imprecise Injury Date

 +2       ; The code error for all 3 837 modes of export, else warning

 +3        SET DIC="^ABMDERR("

 +4        SET DIC(0)="EMQZXL"

 +5        SET DINUM=192

 +6        SET DLAYGO=9002274

 +7        SET X="IMPRECISE INJURY DATE"

 +8        KILL DD,DO

 +9        DO FILE^DICN

 +10       IF +Y<1

               QUIT

 +11      ;

 +12       SET DIE=DIC

 +13       SET DA=+Y

 +14       SET DR=".02///If page 3 question ""Accident Related"" is yes, an exact date (mm/dd/yyyy) of injury is required"

 +15       DO ^DIE

 +16      ;

 +17       SET IEN=DA

 +18       DO ERRSITE(IEN)

 +19       FOR X=21,22,23

               DO EXPMODE(IEN,X)

 +20       QUIT

ERRCD193  ;

 +1       ; Create 3P Error Code 193 - Referring Provider Missing Person Class

 +2        SET DIC="^ABMDERR("

 +3        SET DIC(0)="EMQZXL"

 +4        SET DINUM=193

 +5        SET DLAYGO=9002274

 +6        SET X="PIN/PERSON CLASS MISSING FROM REFERRING PROVIDER"

 +7        KILL DD,DO

 +8        DO FILE^DICN

 +9        IF +Y<1

               QUIT

 +10      ;

 +11       SET DIE=DIC

 +12       SET DA=+Y

 +13       SET DR=".02///Edit Referring Physician on page 3 and add Referring Physician PIN and/or Referring Physician Person Class"

 +14       DO ^DIE

 +15      ;

 +16       SET IEN=DA

 +17       DO ERRSITE(IEN)

 +18       FOR X=21,22,23

               DO EXPMODE(IEN,X)

 +19       QUIT

 +20      ;

ERRSITE(IEN) ;

 +1        SET ABMSITE=1

 +2        FOR

               SET ABMSITE=$ORDER(^ABMDPARM(ABMSITE))

               IF +ABMSITE=0

                   QUIT

               Begin DoDot:1

 +3                KILL DA,DIE,DIC,DR,Y,DINUM

 +4                SET DLAYGO=9002274

 +5                SET DA(1)=IEN

 +6                SET DIC="^ABMDERR("_DA(1)_",31,"

 +7                SET DINUM=ABMSITE

                   SET X=ABMSITE

 +8                SET DIC(0)="EQXMLZ"

 +9                SET DIC("P")=$PIECE(^DD(9002274.04,31,0),U,2)

 +10               SET DIC("DR")=".03///E"

 +11               KILL DD,DO

 +12               DO FILE^DICN

               End DoDot:1

 +13       QUIT

 +14      ;

EXPMODE(IEN,X) ;

 +1        IF '+IEN

               QUIT

 +2        KILL DA,DIE,DIC,DR,Y,DINUM

 +3        SET DLAYGO=9002274

 +4        SET DA(1)=IEN

 +5        SET DIC="^ABMDERR("_DA(1)_",21,"

 +6        SET DINUM=X

 +7        SET DIC(0)="EQXMLZ"

 +8        SET DIC("P")=$PIECE(^DD(9002274.04,21,0),U,2)

 +9        KILL DD,DO

 +10       DO FILE^DICN

 +11       QUIT

CODES     ; change admission type and admission source codes to 1-digit codes

 +1        SET DIE="^ABMDCODE("

 +2        FOR ABMT="A","T"

               Begin DoDot:1

 +3                SET ABMCD=""

 +4                FOR

                       SET ABMCD=$ORDER(^ABMDCODE("AC",ABMT,ABMCD))

                       IF ABMCD=""

                           QUIT

                       Begin DoDot:2

 +5                        IF $LENGTH(ABMCD)=1

                               QUIT

 +6                        SET ABMIEN=""

 +7                        FOR

                               SET ABMIEN=$ORDER(^ABMDCODE("AC",ABMT,ABMCD,ABMIEN))

                               IF ABMIEN=""

                                   QUIT

                               Begin DoDot:3

 +8                                SET DA=ABMIEN

 +9                                SET DR=".01///"_+ABMCD

 +10                               DO ^DIE

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +11       KILL ABMT,ABMIEN

 +12      ;

 +13      ; add new codes with category Type of Service

 +14       FOR ABMI=1:1

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

               IF ABMLN="END"

                   QUIT

               Begin DoDot:1

 +15               SET ABMCD=$PIECE(ABMLN,"^")

 +16               SET ABMDESC=$PIECE(ABMLN,"^",2)

 +17               SET DIC="^ABMDCODE("

 +18               SET DIC(0)="ALM"

 +19               SET DIC("DR")=".01////"_ABMCD_";.02////K;.03////"_ABMDESC

 +20               KILL DD,DO

 +21               DO FILE^DICN

               End DoDot:1

 +22       QUIT

QUES      ;

 +1        SET DIE="^ABMDEXP("

 +2        FOR DA=21,22,23

               Begin DoDot:1

 +3                IF DA=21

                       SET DR=".08////1,2,3,4,5,8,14,19,21,22,23,24,28"

 +4                IF DA=22

                       SET DR=".08////1,2,3,4B,5,6,7,9,10,11,12B,14,15,19,20,25,26,28,29,30"

 +5                IF DA=23

                       SET DR=".08////1,2,3,4B,5,14,16,17,18,19,28"

 +6                DO ^DIE

               End DoDot:1

 +7        QUIT

CODETOS   ;

 +1       ;;0^WHOLE BLOOD

 +2       ;;1^MEDICAL CARE

 +3       ;;2^SURGERY

 +4       ;;3^CONSULATION

 +5       ;;4^DIAGNOSTIC RADIOLOGY

 +6       ;;5^DIAGNOSTIC LABORATORY

 +7       ;;6^THERAPEUTIC RADIOLOGY

 +8       ;;7^ANESTHESIA

 +9       ;;8^ASSISTANT AT SURGERY

 +10      ;;9^OTHER MEDICAL ITEMS OR SERVICES

 +11      ;;A^USED DME

 +12      ;;B^HIGH RISK SCREENING MAMMOGRAPHY

 +13      ;;C^LOW RISK SCREENING MAMMOGRAPHY

 +14      ;;D^AMBULANCE

 +15      ;;E^ENTERAL/PARENTERAL NUTRIENTS/SUPPLIES

 +16      ;;F^AMBULATORY SURGICAL CENTER

 +17      ;;G^IMMUNOSUPPRESSIVE DRUGS

 +18      ;;H^HOSPICE

 +19      ;;J^DIABETIC SHOES

 +20      ;;K^HEARING ITEMS AND SERVICES

 +21      ;;L^ESRD SUPPLIES

 +22      ;;M^MONTHLY CAPITATION PAYMENT FOR DIALYSIS

 +23      ;;N^KIDNEY DONOR

 +24      ;;P^LUMP SUM PURCHASE OF DME, PROSTHETICS, ORTHOTICS

 +25      ;;Q^VISION ITEMS OR SERVICES

 +26      ;;R^RENTAL OF DME

 +27      ;;S^SURGICAL DRESSINGS OR OTHER MEDICAL SUPPLIES

 +28      ;;T^OUTPATIENT MENTAL HEALTH TREATMENT LIMITATION

 +29      ;;U^OCCUPATIONAL THERAPY

 +30      ;;V^PNEUMOCOCCAL/FLU VACCINE

 +31      ;;W^PHYSICAL THERAPY

 +32      ;;END

ABMPT255.m