- 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
