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
;
Q
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
Q
;
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)
Q
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)
Q
;
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
Q
;
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
Q
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
Q
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
Q
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
