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
