Routine: ABMPT256

ABMPT256 ; IHS/ASDST/LSL - 3P BILLING 2.5 Patch 6 POST INIT ;

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

 ; IHS/SD/SDR v2.5 p6 - 7/15/04 - Added code for two new error messages (201;202)

 ;     Other code mostly from v2.5 p5 but updated to check if codes already exist so they aren't

 ;     created again.

EN ; EP

 D ^ABMDPOST                 ; Just in case patch 2 not installed

 D ERRCD201                    ;Create 3P Error Code 201

 D ERRCD202                    ;Create 3P Error Code 202

 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

ERRCD201 ;add error code 201

 K DIC,DIE

 S DIC="^ABMDERR("

 S DIC(0)="MQZXL"

 S DINUM=201

 S DLAYGO=9002274

 S X="TAXONOMY CODE MISSING FOR PERSON CLASS"

 K DD,DO

 D ^DIC

 I +Y<1 Q

 S DIE=DIC

 S DA=+Y

 S DR=".02////Proceed to the 3P PROVIDER TAXONOMY CODE file in Fileman.  Choose the X12 Taxonomy code and add the person class to the PERSON CLASS field;.03////E"

 D ^DIE

ERRCD202 ; add error code 202

 K DIC,DIE

 S DIC="^ABMDERR("

 S DIC(0)="MQZXL"

 S DINUM=202

 S DLAYGO=9002274

 S X="PROVIDER CLASS NOT MAPPED TO TAXONOMY CODE"

 K DD,DO

 D ^DIC

 I +Y<1 Q

 S DIE=DIC

 S DA=+Y

 S DR=".02////Proceed to the 3P PROVIDER TAXONOMY CODE file in Fileman.  Choose the X12 Taxonomy code and add the proivder class to the PROVIDER CLASS field;.03////E"

 D ^DIE

ERRCD192 ;

 ; Create 3P Error Code 192 - Imprecise Injury Date

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

 K DIC,DIE

 S DIC="^ABMDERR("

 S DIC(0)="MQZXL"

 S DINUM=192

 S DLAYGO=9002274

 S X="IMPRECISE INJURY DATE"

 K DD,DO

 D ^DIC

 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

 K DIC,DIE

 S DIC="^ABMDERR("

 S DIC(0)="MQZXL"

 S DINUM=193

 S DLAYGO=9002274

 S X="REFER. PROVIDER MISSING PIN/PERSON CLASS/PROV. CLASS/TAX. CODE"

 K DD,DO

 D ^DIC

 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/Provider Class/Taxonomy Code"

 D ^DIE

 S IEN=DA

 D ERRSITE(IEN)

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

ERRSITE(IEN) ;

 S ABMSITE=1

 K DIC,DIE

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

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

 . S DLAYGO=9002274.04

 . S DA(1)=IEN

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

 . S DINUM=ABMSITE,X="`"_ABMSITE

 . S DIC(0)="QXMLZ"

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

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

 . K DD,DO

 . D ^DIC

EXPMODE(IEN,X) ;

 Q:'+IEN

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

 S DLAYGO=9002274.04

 S DA(1)=IEN

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

 S DINUM=X

 S DIC(0)="QXMLZ"

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

 K DD,DO

 D ^DIC

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

 K DIC,DIE

 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)

 .I $D(^ABMDCODE("C",$E(ABMDESC,1,30))),$D(^ABMDCODE("B",ABMCD)) Q  ;entry already exists

 .K DIC,DIE

 .S DIC="^ABMDCODE("

 .S DIC(0)="LM"

 .S X=$P(^ABMDCODE(0),U,3)+1

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

 .S DIC("DR")=DIC("DR")_";.01////"_ABMCD

 .K DD,DO

 .D ^DIC

QUES ;  verify questions for 837 export modes

 K DIE

 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

ABMPT256  ; IHS/ASDST/LSL - 3P BILLING 2.5 Patch 6 POST INIT ;

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

 +2       ;

 +3       ; IHS/SD/SDR v2.5 p6 - 7/15/04 - Added code for two new error messages (201;202)

 +4       ;     Other code mostly from v2.5 p5 but updated to check if codes already exist so they aren't

 +5       ;     created again.

 +6       ;

 +7        QUIT

EN        ; EP

 +1       ; Just in case patch 2 not installed

           DO ^ABMDPOST

 +2       ;Create 3P Error Code 201

           DO ERRCD201

 +3       ;Create 3P Error Code 202

           DO ERRCD202

 +4       ; Create 3P Error Code 192

           DO ERRCD192

 +5       ; Create 3P Error Code 193

           DO ERRCD193

 +6       ;Update codes to be one character

           DO CODES

 +7       ;make sure right questions are on 837 formats

           DO QUES

 +8        QUIT

 +9       ;

ERRCD201  ;add error code 201

 +1        KILL DIC,DIE

 +2        SET DIC="^ABMDERR("

 +3        SET DIC(0)="MQZXL"

 +4        SET DINUM=201

 +5        SET DLAYGO=9002274

 +6        SET X="TAXONOMY CODE MISSING FOR PERSON CLASS"

 +7        KILL DD,DO

 +8        DO ^DIC

 +9        IF +Y<1

               QUIT

 +10      ;

 +11       SET DIE=DIC

 +12       SET DA=+Y

 +13       SET DR=".02////Proceed to the 3P PROVIDER TAXONOMY CODE file in Fileman.  Choose the X12 Taxonomy code and add the person class to the PERSON CLASS field;.03////E"

 +14       DO ^DIE

 +15       QUIT

ERRCD202  ; add error code 202

 +1        KILL DIC,DIE

 +2        SET DIC="^ABMDERR("

 +3        SET DIC(0)="MQZXL"

 +4        SET DINUM=202

 +5        SET DLAYGO=9002274

 +6        SET X="PROVIDER CLASS NOT MAPPED TO TAXONOMY CODE"

 +7        KILL DD,DO

 +8        DO ^DIC

 +9        IF +Y<1

               QUIT

 +10      ;

 +11       SET DIE=DIC

 +12       SET DA=+Y

 +13       SET DR=".02////Proceed to the 3P PROVIDER TAXONOMY CODE file in Fileman.  Choose the X12 Taxonomy code and add the proivder class to the PROVIDER CLASS field;.03////E"

 +14       DO ^DIE

 +15       QUIT

ERRCD192  ;

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

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

 +3        KILL DIC,DIE

 +4        SET DIC="^ABMDERR("

 +5        SET DIC(0)="MQZXL"

 +6        SET DINUM=192

 +7        SET DLAYGO=9002274

 +8        SET X="IMPRECISE INJURY DATE"

 +9        KILL DD,DO

 +10       DO ^DIC

 +11       IF +Y<1

               QUIT

 +12      ;

 +13       SET DIE=DIC

 +14       SET DA=+Y

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

 +16       DO ^DIE

 +17      ;

 +18       SET IEN=DA

 +19       DO ERRSITE(IEN)

 +20       FOR X=21,22,23

               DO EXPMODE(IEN,X)

 +21       QUIT

ERRCD193  ;

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

 +2        KILL DIC,DIE

 +3        SET DIC="^ABMDERR("

 +4        SET DIC(0)="MQZXL"

 +5        SET DINUM=193

 +6        SET DLAYGO=9002274

 +7        SET X="REFER. PROVIDER MISSING PIN/PERSON CLASS/PROV. CLASS/TAX. CODE"

 +8        KILL DD,DO

 +9        DO ^DIC

 +10       IF +Y<1

               QUIT

 +11      ;

 +12       SET DIE=DIC

 +13       SET DA=+Y

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

 +15       DO ^DIE

 +16      ;

 +17       SET IEN=DA

 +18       DO ERRSITE(IEN)

 +19       FOR X=21,22,23

               DO EXPMODE(IEN,X)

 +20       QUIT

 +21      ;

ERRSITE(IEN) ;

 +1        SET ABMSITE=1

 +2        KILL DIC,DIE

 +3        FOR

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

               IF +ABMSITE=0

                   QUIT

               Begin DoDot:1

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

 +5                SET DLAYGO=9002274.04

 +6                SET DA(1)=IEN

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

 +8                SET DINUM=ABMSITE

                   SET X="`"_ABMSITE

 +9                SET DIC(0)="QXMLZ"

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

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

 +12               KILL DD,DO

 +13               DO ^DIC

               End DoDot:1

 +14       QUIT

 +15      ;

EXPMODE(IEN,X) ;

 +1        IF '+IEN

               QUIT

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

 +3        SET DLAYGO=9002274.04

 +4        SET DA(1)=IEN

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

 +6        SET DINUM=X

 +7        SET DIC(0)="QXMLZ"

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

 +9        KILL DD,DO

 +10       DO ^DIC

 +11       QUIT

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

 +1        KILL DIC,DIE

 +2        SET DIE="^ABMDCODE("

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

               Begin DoDot:1

 +4                SET ABMCD=""

 +5                FOR

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

                       IF ABMCD=""

                           QUIT

                       Begin DoDot:2

 +6                        IF $LENGTH(ABMCD)=1

                               QUIT

 +7                        SET ABMIEN=""

 +8                        FOR

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

                               IF ABMIEN=""

                                   QUIT

                               Begin DoDot:3

 +9                                SET DA=ABMIEN

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

 +11                               DO ^DIE

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +12       KILL ABMT,ABMIEN

 +13      ;

 +14      ; add new codes with category Type of Service

 +15       FOR ABMI=1:1

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

               IF ABMLN="END"

                   QUIT

               Begin DoDot:1

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

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

 +18      ;entry already exists

                   IF $DATA(^ABMDCODE("C",$EXTRACT(ABMDESC,1,30)))

                       IF $DATA(^ABMDCODE("B",ABMCD))

                           QUIT

 +19               KILL DIC,DIE

 +20               SET DIC="^ABMDCODE("

 +21               SET DIC(0)="LM"

 +22               SET X=$PIECE(^ABMDCODE(0),U,3)+1

 +23               SET DIC("DR")=".02////K;.03////"_ABMDESC

 +24               SET DIC("DR")=DIC("DR")_";.01////"_ABMCD

 +25               KILL DD,DO

 +26               DO ^DIC

               End DoDot:1

 +27       QUIT

QUES      ;  verify questions for 837 export modes

 +1        KILL DIE

 +2        SET DIE="^ABMDEXP("

 +3        FOR DA=21,22,23

               Begin DoDot:1

 +4                IF DA=21

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

 +5                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"

 +6                IF DA=23

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

 +7                DO ^DIE

               End DoDot:1

 +8        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

ABMPT256.m