- 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