- ABMPOST9 ; IHS/ASDS/LSL - Post init of V2.4 Patch 9
- ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
- ;
- ; There are -1's in the 19 Multiple of the 3P CLAIM DATA File
- ; This routine will look for and delete them.
- ;
- S DUZ2=DUZ(2)
- S (DA(1),DUZ(2))=0
- ;
- ; DIK won't work here because the value of DA is -1.
- F S DUZ(2)=$O(^ABMDCLM(DUZ(2))) Q:'+DUZ(2) D
- . F S DA(1)=$O(^ABMDCLM(DUZ(2),DA(1))) Q:'+DA(1) D
- . . I $D(^ABMDCLM(DUZ(2),DA(1),19,-1)) D
- . . . S ABMP2=$P($G(^ABMDCLM(DUZ(2),DA(1),19,-1,0)),U,2)
- . . . I +ABMP2 K ^ABMDCLM(DUZ(2),DA(1),19,"C",ABMP2,-1)
- . . . K ^ABMDCLM(DUZ(2),DA(1),"ASRC","M",-1,19)
- . . . K ^ABMDCLM(DUZ(2),DA(1),19,-1)
- ;
- S DUZ(2)=DUZ2
- K DUZ2,DA,DIK
- ;
- ERROR ;
- ; Add new error code to 3P ERROR CODE file
- K DA,DR,DIC,DLAYGO,X,DINUM
- S DIC="^ABMDERR("
- S DIC(0)="LX"
- S DLAYGO=9002274
- S DINUM=189
- S X="MEDICARE PART B PIN NUMBER UNSPECIFIED IN 3P INSURER FILE."
- S DIC("DR")=".02////Through INSURER TABLE MAINTENANCE, enter the provider and MEDICARE PART B pin number."
- S DIC("DR")=DIC("DR")_";.03////E"
- S DIC("DR")=DIC("DR")_";.05////0"
- D ^DIC
- Q:Y<0
- K DA,DIC,DR,DINUM,Y
- ;
- ; Add Required by insurer (Medicare and Railroad Retirement)
- S ^ABMDERR(189,11,0)="^9002274.411PA^^"
- F INS=1,2 D
- . S DIC(0)="LXE"
- . S DA(1)=189
- . S DIC="^ABMDERR("_DA(1)_",11,"
- . S DINUM=INS
- . S X=$P(^AUTNINS(INS,0),U)
- . D ^DIC
- . K DA,DIC,DINUM,X
- K INS
- ;
- ; Add Required for export form (all current HCFA's)
- S ^ABMDERR(189,21,0)="^9002274.421P^^"
- F MOD=3,14,15,19,20 D
- . S DIC(0)="LXE"
- . S DA(1)=189
- . S DIC="^ABMDERR("_DA(1)_",21,"
- . S DINUM=MOD
- . S X=$P(^ABMDEXP(MOD,0),U)
- . D ^DIC
- . K DA,DIC,DINUM,X
- K MOD
- ;
- ; Add SITE multiple
- S ^ABMDERR(189,31,0)="^9002274.0431PA^^"
- S DUZHOLD=DUZ(2)
- S DUZ(2)=0
- F S DUZ(2)=$O(^ABMDCLM(DUZ(2))) Q:'+DUZ(2) D
- . S DIC(0)="LXE"
- . S DA(1)=189
- . S DIC="^ABMDERR("_DA(1)_",31,"
- . S DINUM=DUZ(2)
- . S X=$P($G(^DIC(4,DUZ(2),0)),U)
- . S DIC("DR")=".03////E"
- . D ^DIC
- . K DA,DIC,DINUM,X
- S DUZ(2)=DUZHOLD
- K DUZHOLD,DLAYGO
- Q
- ABMPOST9 ; IHS/ASDS/LSL - Post init of V2.4 Patch 9
- +1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
- +2 ;
- +3 ; There are -1's in the 19 Multiple of the 3P CLAIM DATA File
- +4 ; This routine will look for and delete them.
- +5 ;
- +6 SET DUZ2=DUZ(2)
- +7 SET (DA(1),DUZ(2))=0
- +8 ;
- +9 ; DIK won't work here because the value of DA is -1.
- +10 FOR
- SET DUZ(2)=$ORDER(^ABMDCLM(DUZ(2)))
- IF '+DUZ(2)
- QUIT
- Begin DoDot:1
- +11 FOR
- SET DA(1)=$ORDER(^ABMDCLM(DUZ(2),DA(1)))
- IF '+DA(1)
- QUIT
- Begin DoDot:2
- +12 IF $DATA(^ABMDCLM(DUZ(2),DA(1),19,-1))
- Begin DoDot:3
- +13 SET ABMP2=$PIECE($GET(^ABMDCLM(DUZ(2),DA(1),19,-1,0)),U,2)
- +14 IF +ABMP2
- KILL ^ABMDCLM(DUZ(2),DA(1),19,"C",ABMP2,-1)
- +15 KILL ^ABMDCLM(DUZ(2),DA(1),"ASRC","M",-1,19)
- +16 KILL ^ABMDCLM(DUZ(2),DA(1),19,-1)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +17 ;
- +18 SET DUZ(2)=DUZ2
- +19 KILL DUZ2,DA,DIK
- +20 ;
- ERROR ;
- +1 ; Add new error code to 3P ERROR CODE file
- +2 KILL DA,DR,DIC,DLAYGO,X,DINUM
- +3 SET DIC="^ABMDERR("
- +4 SET DIC(0)="LX"
- +5 SET DLAYGO=9002274
- +6 SET DINUM=189
- +7 SET X="MEDICARE PART B PIN NUMBER UNSPECIFIED IN 3P INSURER FILE."
- +8 SET DIC("DR")=".02////Through INSURER TABLE MAINTENANCE, enter the provider and MEDICARE PART B pin number."
- +9 SET DIC("DR")=DIC("DR")_";.03////E"
- +10 SET DIC("DR")=DIC("DR")_";.05////0"
- +11 DO ^DIC
- +12 IF Y<0
- QUIT
- +13 KILL DA,DIC,DR,DINUM,Y
- +14 ;
- +15 ; Add Required by insurer (Medicare and Railroad Retirement)
- +16 SET ^ABMDERR(189,11,0)="^9002274.411PA^^"
- +17 FOR INS=1,2
- Begin DoDot:1
- +18 SET DIC(0)="LXE"
- +19 SET DA(1)=189
- +20 SET DIC="^ABMDERR("_DA(1)_",11,"
- +21 SET DINUM=INS
- +22 SET X=$PIECE(^AUTNINS(INS,0),U)
- +23 DO ^DIC
- +24 KILL DA,DIC,DINUM,X
- End DoDot:1
- +25 KILL INS
- +26 ;
- +27 ; Add Required for export form (all current HCFA's)
- +28 SET ^ABMDERR(189,21,0)="^9002274.421P^^"
- +29 FOR MOD=3,14,15,19,20
- Begin DoDot:1
- +30 SET DIC(0)="LXE"
- +31 SET DA(1)=189
- +32 SET DIC="^ABMDERR("_DA(1)_",21,"
- +33 SET DINUM=MOD
- +34 SET X=$PIECE(^ABMDEXP(MOD,0),U)
- +35 DO ^DIC
- +36 KILL DA,DIC,DINUM,X
- End DoDot:1
- +37 KILL MOD
- +38 ;
- +39 ; Add SITE multiple
- +40 SET ^ABMDERR(189,31,0)="^9002274.0431PA^^"
- +41 SET DUZHOLD=DUZ(2)
- +42 SET DUZ(2)=0
- +43 FOR
- SET DUZ(2)=$ORDER(^ABMDCLM(DUZ(2)))
- IF '+DUZ(2)
- QUIT
- Begin DoDot:1
- +44 SET DIC(0)="LXE"
- +45 SET DA(1)=189
- +46 SET DIC="^ABMDERR("_DA(1)_",31,"
- +47 SET DINUM=DUZ(2)
- +48 SET X=$PIECE($GET(^DIC(4,DUZ(2),0)),U)
- +49 SET DIC("DR")=".03////E"
- +50 DO ^DIC
- +51 KILL DA,DIC,DINUM,X
- End DoDot:1
- +52 SET DUZ(2)=DUZHOLD
- +53 KILL DUZHOLD,DLAYGO
- +54 QUIT
