ABMP2510 ; IHS/SD/SDR - 3P BILLING 2.5 Patch 10 PRE/POST INIT ;
;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
;
;
Q
PREINST ;
S DIK="^ABMQUES("
S DA=31
D ^DIK
S DIK="^ABMPSTAT("
F DA=1,3,9,10,13 D ^DIK
;
; repoint entry from 3P EMC Reference ID file if used
; this is a bad entry that will be removed
PREINST2 S ABMIEN=0
F S ABMIEN=$O(^ABMREFID("B","1B",ABMIEN)) Q:+ABMIEN=0 D
.I $P($G(^ABMREFID(ABMIEN,0)),U,2)["Sheild" S ABMRMV=ABMIEN ;this is the entry to remove/repoint
.I $P($G(^ABMREFID(ABMIEN,0)),U,2)["Shield" S ABMUSE=ABMIEN ;use this entry
;
S ABMDUZ=0
F S ABMDUZ=$O(^ABMNINS(ABMDUZ)) Q:+ABMDUZ=0 D
.S ABMI=0
.F S ABMI=$O(^ABMNINS(ABMDUZ,ABMI)) Q:+ABMI=0 D
..S ABMVI=0
..F S ABMVI=$O(^ABMNINS(ABMDUZ,ABMI,1,ABMVI)) Q:+ABMVI=0 D
...I $P($G(^ABMNINS(ABMDUZ,ABMI,1,ABMVI,1)),U)=ABMRMV D
....S DUZ(2)=ABMDUZ
....S DA(1)=ABMI
....S DA=ABMVI
....S DIE="^ABMNINS(DUZ(2),"_DA(1)_",1,"
....S DR="101////"_ABMUSE
....D ^DIE
Q
EN ; EP
I $G(^DD(9002274.3021,.18,0))="" D EN^ABMPT259 ;if patch 9 not loaded do p9 post install
D ERRCODES ;new 3P Error codes
D ECODES ;new 3P CODES
D PCCCODES ;new 3P PCC Visit Status code
D REINDEX^ABMPT259 ;re-index 3p provider taxonomy file
Q
ERRCODES ;
;217 - DX deleted that was being referenced
K DIC,X
S DIC="^ABMDERR("
S DIC(0)="LM"
S DINUM=217
S X="DX HAS BEEN DELETED THAT IS BEING REFERENCED"
S DIC("DR")=".02///Redo corresponding DX codes"
S DIC("DR")=DIC("DR")_";.03///W"
K DD,DO
D FILE^DICN
D SITE(217)
;218 - NO MSP FOR MEDICARE PATIENT
K DIC,X
S DIC="^ABMDERR("
S DIC(0)="LM"
S DINUM=218
S X="NO MSP FOR MEDICARE PATIENT"
S DIC("DR")=".02///Enter MSP on page 4 of Pat Reg"
S DIC("DR")=DIC("DR")_";.03///W"
K DD,DO
D FILE^DICN
D SITE(218)
;219 - Medicare Active Insurer and DOB missing from page 4
K DIC,X
S DIC="^ABMDERR("
S DIC(0)="LM"
S DINUM=219
S X="MEDICARE ACTIVE INSURER AND DOB MISSING FROM PAT REG PAGE 4"
S DIC("DR")=".02///Populate Date Of Birth on page 4 of Pat Reg"
S DIC("DR")=DIC("DR")_";.03///E"
K DD,DO
D FILE^DICN
D SITE(219)
Q
SITE(ABMX) ;Add SITE multiple
S DUZHOLD=DUZ(2)
S DUZ(2)=0
F S DUZ(2)=$O(^ABMDCLM(DUZ(2))) Q:'+DUZ(2) D
.S DIC(0)="LX"
.S DA(1)=ABMX
.S DIC="^ABMDERR("_DA(1)_",31,"
.S DIC("P")=$P(^DD(9002274.04,31,0),U,2)
.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
S DUZ(2)=DUZHOLD
K DUZHOLD,DLAYGO,ABMX
Q
ECODES ;
;IM21196
Q:+$O(^ABMDCODE("C","DISCHARGED/TRANSFERRED TO ANOT",0))'=0 ;entry already exists
K DIC,X
S DIC="^ABMDCODE("
S DIC(0)="ML"
S X="62"
S DIC("DR")=".02///P"
S DIC("DR")=DIC("DR")_";.03///DISCHARGED/TRANSFERRED TO ANOTHER REHAB FAC"
K DD,DO
D FILE^DICN
Q
PCCCODES ;
S DIC="^ABMDCS("
S DIC(0)="LM"
S X="BILLED POS"
D ^DIC
Q
ABMP2510 ; IHS/SD/SDR - 3P BILLING 2.5 Patch 10 PRE/POST INIT ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
+2 ;
+3 ;
+4 QUIT
PREINST ;
+1 SET DIK="^ABMQUES("
+2 SET DA=31
+3 DO ^DIK
+4 SET DIK="^ABMPSTAT("
+5 FOR DA=1,3,9,10,13
DO ^DIK
+6 ;
+7 ; repoint entry from 3P EMC Reference ID file if used
+8 ; this is a bad entry that will be removed
PREINST2 SET ABMIEN=0
+1 FOR
SET ABMIEN=$ORDER(^ABMREFID("B","1B",ABMIEN))
IF +ABMIEN=0
QUIT
Begin DoDot:1
+2 ;this is the entry to remove/repoint
IF $PIECE($GET(^ABMREFID(ABMIEN,0)),U,2)["Sheild"
SET ABMRMV=ABMIEN
+3 ;use this entry
IF $PIECE($GET(^ABMREFID(ABMIEN,0)),U,2)["Shield"
SET ABMUSE=ABMIEN
End DoDot:1
+4 ;
+5 SET ABMDUZ=0
+6 FOR
SET ABMDUZ=$ORDER(^ABMNINS(ABMDUZ))
IF +ABMDUZ=0
QUIT
Begin DoDot:1
+7 SET ABMI=0
+8 FOR
SET ABMI=$ORDER(^ABMNINS(ABMDUZ,ABMI))
IF +ABMI=0
QUIT
Begin DoDot:2
+9 SET ABMVI=0
+10 FOR
SET ABMVI=$ORDER(^ABMNINS(ABMDUZ,ABMI,1,ABMVI))
IF +ABMVI=0
QUIT
Begin DoDot:3
+11 IF $PIECE($GET(^ABMNINS(ABMDUZ,ABMI,1,ABMVI,1)),U)=ABMRMV
Begin DoDot:4
+12 SET DUZ(2)=ABMDUZ
+13 SET DA(1)=ABMI
+14 SET DA=ABMVI
+15 SET DIE="^ABMNINS(DUZ(2),"_DA(1)_",1,"
+16 SET DR="101////"_ABMUSE
+17 DO ^DIE
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+18 QUIT
EN ; EP
+1 ;if patch 9 not loaded do p9 post install
IF $GET(^DD(9002274.3021,.18,0))=""
DO EN^ABMPT259
+2 ;new 3P Error codes
DO ERRCODES
+3 ;new 3P CODES
DO ECODES
+4 ;new 3P PCC Visit Status code
DO PCCCODES
+5 ;re-index 3p provider taxonomy file
DO REINDEX^ABMPT259
+6 QUIT
ERRCODES ;
+1 ;217 - DX deleted that was being referenced
+2 KILL DIC,X
+3 SET DIC="^ABMDERR("
+4 SET DIC(0)="LM"
+5 SET DINUM=217
+6 SET X="DX HAS BEEN DELETED THAT IS BEING REFERENCED"
+7 SET DIC("DR")=".02///Redo corresponding DX codes"
+8 SET DIC("DR")=DIC("DR")_";.03///W"
+9 KILL DD,DO
+10 DO FILE^DICN
+11 DO SITE(217)
+12 ;218 - NO MSP FOR MEDICARE PATIENT
+13 KILL DIC,X
+14 SET DIC="^ABMDERR("
+15 SET DIC(0)="LM"
+16 SET DINUM=218
+17 SET X="NO MSP FOR MEDICARE PATIENT"
+18 SET DIC("DR")=".02///Enter MSP on page 4 of Pat Reg"
+19 SET DIC("DR")=DIC("DR")_";.03///W"
+20 KILL DD,DO
+21 DO FILE^DICN
+22 DO SITE(218)
+23 ;219 - Medicare Active Insurer and DOB missing from page 4
+24 KILL DIC,X
+25 SET DIC="^ABMDERR("
+26 SET DIC(0)="LM"
+27 SET DINUM=219
+28 SET X="MEDICARE ACTIVE INSURER AND DOB MISSING FROM PAT REG PAGE 4"
+29 SET DIC("DR")=".02///Populate Date Of Birth on page 4 of Pat Reg"
+30 SET DIC("DR")=DIC("DR")_";.03///E"
+31 KILL DD,DO
+32 DO FILE^DICN
+33 DO SITE(219)
+34 QUIT
SITE(ABMX) ;Add SITE multiple
+1 SET DUZHOLD=DUZ(2)
+2 SET DUZ(2)=0
+3 FOR
SET DUZ(2)=$ORDER(^ABMDCLM(DUZ(2)))
IF '+DUZ(2)
QUIT
Begin DoDot:1
+4 SET DIC(0)="LX"
+5 SET DA(1)=ABMX
+6 SET DIC="^ABMDERR("_DA(1)_",31,"
+7 SET DIC("P")=$PIECE(^DD(9002274.04,31,0),U,2)
+8 SET DINUM=DUZ(2)
+9 SET X=$PIECE($GET(^DIC(4,DUZ(2),0)),U)
+10 SET DIC("DR")=".03////E"
+11 DO ^DIC
+12 KILL DA,DIC,DINUM
End DoDot:1
+13 SET DUZ(2)=DUZHOLD
+14 KILL DUZHOLD,DLAYGO,ABMX
+15 QUIT
ECODES ;
+1 ;IM21196
+2 ;entry already exists
IF +$ORDER(^ABMDCODE("C","DISCHARGED/TRANSFERRED TO ANOT",0))'=0
QUIT
+3 KILL DIC,X
+4 SET DIC="^ABMDCODE("
+5 SET DIC(0)="ML"
+6 SET X="62"
+7 SET DIC("DR")=".02///P"
+8 SET DIC("DR")=DIC("DR")_";.03///DISCHARGED/TRANSFERRED TO ANOTHER REHAB FAC"
+9 KILL DD,DO
+10 DO FILE^DICN
+11 QUIT
PCCCODES ;
+1 SET DIC="^ABMDCS("
+2 SET DIC(0)="LM"
+3 SET X="BILLED POS"
+4 DO ^DIC
+5 QUIT
