ABMP2514 ; IHS/SD/SDR - 3P BILLING 2.5 Patch 14 PRE/POST INIT ;
;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
;
POST ;
D TPCODES ;add entries to 3P Codes file
D EN^ABMF400 ;find Medicare 400/900 entries in local mod file
D UFMSPARM
;D ERRCODES^ABMP2512 ;new error codes in 3P Error Codes file
;D ECODES ;new codes for patch 13
;D QUES ;add question 20 (block 19) to 1500 (08/05)
;D POADFLT ;set default for POA field in 3P Parameters
Q
;
TPCODES ;
; IM28458
K DIC,X
S DIC="^ABMDCODE("
S DIC(0)="ML"
S X="63"
S DIC("DR")=".02///P"
S DIC("DR")=DIC("DR")_";.03///Discharged/Transferred to Long Term Care"
K DD,DO
D FILE^DICN
Q
UFMSPARM ;EP
S X=$$INSTALLD^ABMENVCK("ABM*2.5*12")
Q:X'=1
;
S DUZHOLD=$G(DUZ(2))
S DUZ(2)=1
F S DUZ(2)=$O(^ABMDPARM(DUZ(2))) Q:+DUZ(2)=0 D
.Q:$D(^ABMDPARM(DUZ(2),1))'=10
.S ABMADIEN=$O(^AUTTLOC(DUZ(2),11,9999999),-1)
.Q:+ABMADIEN=0
.K DIE,DIC,X,DR,DA
.S DIE="^ABMDPARM(DUZ(2),"
.S DA=1
.I $P($G(^AUTTLOC(DUZ(2),11,ABMADIEN,0)),U,3)="1" S DR="414////1;415////1;416////5" ;if affiliation IHS
.I $P($G(^AUTTLOC(DUZ(2),11,ABMADIEN,0)),U,3)'="1" S DR="414////0;415////0;416////5" ;if affiliation NOT IHS
.D ^DIE
S DUZ(2)=DUZHOLD
K DUZHOLD,ABMADIEN
Q
QUES ;EP
K DIC,DIE,DA,DR,X,Y
S DIE="^ABMDEXP("
S DA=27
S DR=".08////1,2,3,4B,5,7,9,10,12B,13,15,20,22,34,35,19,25"
D ^DIE
Q
POADFLT ;EP
S DUZHOLD=$G(DUZ(2))
S DUZ(2)=1
F S DUZ(2)=$O(^ABMDPARM(DUZ(2))) Q:+DUZ(2)=0 D
.Q:$D(^ABMDPARM(DUZ(2),1))'=10
.K DIE,DIC,X,DR,DA
.S DIE="^ABMDPARM(DUZ(2),"
.S DA=1
.S DR="213////Y" ;POA default to yes
.D ^DIE
S DUZ(2)=DUZHOLD
K DUZHOLD,ABMADIEN
Q
ECODES ;EP
;231 - Present on Admission (POA) indicator missing
K DIC,X
S DIC="^ABMDERR("
S DIC(0)="LM"
S DINUM=231
S X="PRESENT ON ADMISSION (POA) INDICATOR MISSING"
S DIC("DR")=".02///Populate POA for inpatient DXs on page 5A"
S DIC("DR")=DIC("DR")_";.03///E"
K DD,DO
D FILE^DICN
D SITE(231)
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)=0 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////"_$S(DA(1)=225!(DA(1)=226)!(DA(1)=230):"W",1:"E")
.D ^DIC
.K DA,DIC,DINUM
S DUZ(2)=DUZHOLD
K DUZHOLD,DLAYGO,ABMX
Q
TASK ;EP
S ZTRTN="FROMDT^ABMPUEXT"
S ZTDESC="3P UFMS RE-EXPORT"
;S ZTSAVE("ABM*")=""
S ZTIO=""
S ZTPRI=5
S ZTDTH=DT_"."_22 ;install day at 10:00pm
K ZTSK
D ^%ZTLOAD
W:$G(ZTSK) !,"Task # ",ZTSK," queued to run Re-Export at 10:00pm",!
Q
ABMP2514 ; IHS/SD/SDR - 3P BILLING 2.5 Patch 14 PRE/POST INIT ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
+2 ;
POST ;
+1 ;add entries to 3P Codes file
DO TPCODES
+2 ;find Medicare 400/900 entries in local mod file
DO EN^ABMF400
+3 DO UFMSPARM
+4 ;D ERRCODES^ABMP2512 ;new error codes in 3P Error Codes file
+5 ;D ECODES ;new codes for patch 13
+6 ;D QUES ;add question 20 (block 19) to 1500 (08/05)
+7 ;D POADFLT ;set default for POA field in 3P Parameters
+8 QUIT
+9 ;
TPCODES ;
+1 ; IM28458
+2 KILL DIC,X
+3 SET DIC="^ABMDCODE("
+4 SET DIC(0)="ML"
+5 SET X="63"
+6 SET DIC("DR")=".02///P"
+7 SET DIC("DR")=DIC("DR")_";.03///Discharged/Transferred to Long Term Care"
+8 KILL DD,DO
+9 DO FILE^DICN
+10 QUIT
UFMSPARM ;EP
+1 SET X=$$INSTALLD^ABMENVCK("ABM*2.5*12")
+2 IF X'=1
QUIT
+3 ;
+4 SET DUZHOLD=$GET(DUZ(2))
+5 SET DUZ(2)=1
+6 FOR
SET DUZ(2)=$ORDER(^ABMDPARM(DUZ(2)))
IF +DUZ(2)=0
QUIT
Begin DoDot:1
+7 IF $DATA(^ABMDPARM(DUZ(2),1))'=10
QUIT
+8 SET ABMADIEN=$ORDER(^AUTTLOC(DUZ(2),11,9999999),-1)
+9 IF +ABMADIEN=0
QUIT
+10 KILL DIE,DIC,X,DR,DA
+11 SET DIE="^ABMDPARM(DUZ(2),"
+12 SET DA=1
+13 ;if affiliation IHS
IF $PIECE($GET(^AUTTLOC(DUZ(2),11,ABMADIEN,0)),U,3)="1"
SET DR="414////1;415////1;416////5"
+14 ;if affiliation NOT IHS
IF $PIECE($GET(^AUTTLOC(DUZ(2),11,ABMADIEN,0)),U,3)'="1"
SET DR="414////0;415////0;416////5"
+15 DO ^DIE
End DoDot:1
+16 SET DUZ(2)=DUZHOLD
+17 KILL DUZHOLD,ABMADIEN
+18 QUIT
QUES ;EP
+1 KILL DIC,DIE,DA,DR,X,Y
+2 SET DIE="^ABMDEXP("
+3 SET DA=27
+4 SET DR=".08////1,2,3,4B,5,7,9,10,12B,13,15,20,22,34,35,19,25"
+5 DO ^DIE
+6 QUIT
POADFLT ;EP
+1 SET DUZHOLD=$GET(DUZ(2))
+2 SET DUZ(2)=1
+3 FOR
SET DUZ(2)=$ORDER(^ABMDPARM(DUZ(2)))
IF +DUZ(2)=0
QUIT
Begin DoDot:1
+4 IF $DATA(^ABMDPARM(DUZ(2),1))'=10
QUIT
+5 KILL DIE,DIC,X,DR,DA
+6 SET DIE="^ABMDPARM(DUZ(2),"
+7 SET DA=1
+8 ;POA default to yes
SET DR="213////Y"
+9 DO ^DIE
End DoDot:1
+10 SET DUZ(2)=DUZHOLD
+11 KILL DUZHOLD,ABMADIEN
+12 QUIT
ECODES ;EP
+1 ;231 - Present on Admission (POA) indicator missing
+2 KILL DIC,X
+3 SET DIC="^ABMDERR("
+4 SET DIC(0)="LM"
+5 SET DINUM=231
+6 SET X="PRESENT ON ADMISSION (POA) INDICATOR MISSING"
+7 SET DIC("DR")=".02///Populate POA for inpatient DXs on page 5A"
+8 SET DIC("DR")=DIC("DR")_";.03///E"
+9 KILL DD,DO
+10 DO FILE^DICN
+11 DO SITE(231)
+12 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)=0
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////"_$SELECT(DA(1)=225!(DA(1)=226)!(DA(1)=230):"W",1:"E")
+11 DO ^DIC
+12 KILL DA,DIC,DINUM
End DoDot:1
+13 SET DUZ(2)=DUZHOLD
+14 KILL DUZHOLD,DLAYGO,ABMX
+15 QUIT
TASK ;EP
+1 SET ZTRTN="FROMDT^ABMPUEXT"
+2 SET ZTDESC="3P UFMS RE-EXPORT"
+3 ;S ZTSAVE("ABM*")=""
+4 SET ZTIO=""
+5 SET ZTPRI=5
+6 ;install day at 10:00pm
SET ZTDTH=DT_"."_22
+7 KILL ZTSK
+8 DO ^%ZTLOAD
+9 IF $GET(ZTSK)
WRITE !,"Task # ",ZTSK," queued to run Re-Export at 10:00pm",!
+10 QUIT
