Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ABMP2514

ABMP2514.m

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