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

ABMDVST4.m

Go to the documentation of this file. 
  1. ABMDVST4 ; IHS/ASDST/DMJ - PCC Visit Stuff - PART 5 (HOSPITALIZATION) ; 
  1.  ;;2.6;IHS Third Party Billing System;**2,4,21**;NOV 12, 2009;Build 379
  1.  ;Original;TMD;03/26/96 12:32 PM
  1.  ;
  1.  ;IHS/SD/SDR v2.5 p5 - 5/17/2004 - Modified to put default for
  1.  ;   admission source/admission type/discharge status if outpatient
  1.  ;IHS/SD/SDR v2.5 p6 - 7/12/04 - IM14030 - Fix so discharge status will
  1.  ;     default correctly
  1.  ;IHS/SD/SDR - v2.5 p8 - task 6 - Added code to get patient weight from V Measurement file
  1.  ;IHS/SD/SDR - v2.5 p9 - IM13294 - Admission/Discharge hour populated for outpatient visits
  1.  ;IHS/SD/SDR - v2.5 p10 - IM19717/IM20374 - Removed "CLEAN" of 27 multiple
  1.  ;IHS/SD/SDR - v2.5 p10 - IM21006 - Added code to increment discharge
  1.  ;  hour by 1 for NC Medicaid for Outpt visits
  1.  ;IHS/SD/SDR - v2.5 p10 - IM21382 - Made Service Category R act like A
  1.  ;
  1.  ;IHS/SD/SDR - 2.6*2 - 3PMS10003A - modified to call ABMFEAPI
  1.  ;IHS/SD/SDR - 2.6*4 - HEAT15806 - fix for admit date/time missing; caused by ABMFEAPI change
  1.  ;IHS/SD/SDR - 2.6*21 - HEAT161981 - Made change to lookup discharge status as '01' not as '1'
  1.  ;
  1.  ;ABMP("DDT") is the discharge date from the V HOSPITALIZATION FILE
  1.  ;ABMP("HDATE") is the most recent hospitalizaiton date evaluated by
  1.  ;this rtn for this claim.  These 2 dates need to be the same
  1.  ;after all children of H cat visit are processed or this rtn is not done
  1.  Q:ABMIDONE
  1.  I '$D(ABMCPTTB("HOS")) D
  1.  .F ABM=0:0 S ABM=$O(^ABMDCPT("C","HOSPITALIZATION",ABM)) Q:'ABM  D
  1.  ..S Y=^ABMDCPT(ABM,0)
  1.  ..S ABMCPTTB("HOS",$E($P(Y,U,3),1,3),$E($P(Y,U,1),1,3))=$P(Y,U,4)
  1.  ..S ABMCPTTB("HOS",1,$P(Y,U,4))=""
  1.  .S ABM=0
  1.  .F  S ABM=$O(^ABMDCPT("C","OUTPATIENT",ABM)) Q:'ABM  D
  1.  ..S Y=^ABMDCPT(ABM,0)
  1.  ..I $P(Y,U,3)["ESTABLISHED" D  Q
  1.  ...S ABMCPTTB("OUT","DEF")=$P(Y,U,4)
  1.  ..S ABMCPTTB("OUT","L")=$P(Y,U,4)
  1.  ..S ABMCPTTB("OUT","H")=$P(Y,U,5)
  1.  K AUPNCPT
  1.  S X=$$CPT^AUPNCPT(ABMVDFN)
  1.  ;Make this code act different depending on SERVCAT
  1.  I '$D(ABMP("RELBENE")) D REL^ABMDVSTH,BENE^ABMDVSTH S ABMP("RELBENE")=1
  1.  ;We'll kinda do it the old way for SERVCAT=H & grab subsequent days
  1.  ;from the I visits.  How will we know the discharge visit?
  1.  ;ABMP("DDT") should have the discharge date in it for comparison
  1.  ;There exist special CPT codes for observation.  I need to find out
  1.  ;if they are being handled OK by this code.
  1.  ;In this rtn need the serv cat for child visit not the H visit
  1.  N SERVCAT
  1.  S SERVCAT=$P(ABMCHV0,U,7)
  1.  I "HOS"[SERVCAT,'$D(ABMP("DDT")) D HOSP Q
  1.  ; I need to compare the current date with discharge date.
  1.  I "ID"[SERVCAT,$D(ABMP("DDT")),ABMCHVDT<ABMP("DDT") D MIDDAY^ABMDVSTH Q
  1.  I "ID"[SERVCAT,$D(ABMP("DDT")),ABMCHVDT=ABMP("DDT") D DISCHRG^ABMDVSTH Q
  1.  I "AR"[SERVCAT D OP
  1.  Q
  1.  ;
  1.  ;If either of the following ifs are false the code in 1.6 would goto
  1.  ;the OP section
  1. HOSP ;
  1.  I $D(^AUPNVINP("AD",ABMVDFN))=10 S ABMDA=$O(^AUPNVINP("AD",ABMVDFN,"")) I $D(^AUPNVINP(ABMDA,0)) D  K ABMI Q
  1.  .S ABMI(0)=^AUPNVINP(ABMDA,0)
  1.  .;ABMI("ATYPE") is 3P code
  1.  .;ABMI("DSTAT") discharge status
  1.  .;S ABMI("ATYPE")=2,ABMI("DSTAT")=1,ABMI("ASRC")=2  ;abm*2.6*21 IHS/SD/SDR HEAT161981
  1.  .S ABMI("ATYPE")=2,ABMI("DSTAT")="01",ABMI("ASRC")=2  ;abm*2.6*21 IHS/SD/SDR HEAT161981
  1.  .I $P(ABMI(0),U,4)]"",$P($G(^DIC(45.7,$P(ABMI(0),U,4),9999999)),U)="07" S ABMI("ATYPE")=4
  1.  .;2 is transfer, 4-7 is death, 1 & 3 are discharge, 
  1.  .I $P(ABMI(0),U,6)]"",$D(^DIC(42.2,$P(ABMI(0),U,6),9999999)) S ABMI("DSTAT")=$S($P(^(9999999),U)=2:2,$P(^(9999999),U)>3&($P(^(9999999),U)<8):20,1:1)
  1.  .I $P(ABMI(0),U,7)]"","23"[$P($G(^DIC(42.1,$P(ABMI(0),U,7),9999999)),U) S ABMI("ASRC")=4
  1.  .I $D(ABMP("NEWBORN")) S ABMI("ATYPE")=4
  1.  .;A for admission source, N for newborn
  1.  .S ABM("ASRC")="A" I ABMI("ATYPE")=4 S ABMI("ASRC")=1,ABM("ASRC")="N"
  1.  .;On 3P Code file.  T is admission type code, 3rd subscript is
  1.  .;.01 field.
  1.  .;Here ATYPE gets converted to the ien for the code
  1.  .;P is for discharge status
  1.  .S ABMI("ATYPE")=$O(^ABMDCODE("AC","T",ABMI("ATYPE"),""))
  1.  .;2nd subscript is A or N
  1.  .S ABMI("ASRC")=$O(^ABMDCODE("AC",ABM("ASRC"),ABMI("ASRC"),""))
  1.  .S ABMI("DSTAT")=$O(^ABMDCODE("AC","P",ABMI("DSTAT"),""))
  1.  .;DDT is date of discharge
  1.  .S (ABMP("DDT"),ABMI("DDT"))=$P($P(ABMI(0),U),".")
  1.  .;DHR discharge hour
  1.  .S ABMI("DHR")=$E($P($P(ABMI(0),U,1),".",2),1,2)
  1.  .S ABMI("DHR")=$S(ABMI("DHR")="":12,ABMI("DHR")>-1&(ABMI("DHR")<24):ABMI("DHR"),1:12)
  1.  .S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN")
  1.  .S DR=".63////"_ABMI("DDT")_";.64////"_ABMI("DHR")_";.59////"_$P(ABMI(0),U,12)_";.51////"_ABMI("ATYPE")_";.52////"_ABMI("ASRC")_";.53////"_ABMI("DSTAT")
  1.  .D ^DIE
  1.  .K DA,DIE,DR
  1.  .;ADT is the date from the visit file - admission date
  1.  .S (ABMI("ADT"),ABMP("ADMITDT"),ABMP("HDATE"))=$P($P(ABMP("V0"),U),".")
  1.  .S ABMI("AHR")=$E($P(+ABMP("V0"),".",2),1,2)
  1.  .S ABMI("AHR")=$S(ABMI("AHR")="":12,ABMI("AHR")>-1&(ABMI("AHR")<24):ABMI("AHR"),1:12)
  1.  .S ABMI("SAMEDAY")=0,X1=ABMI("DDT"),X2=ABMI("ADT") D ^%DTC S ABMI("COVD")=$S(X>0:X,1:1) S:X=0 ABMI("SAMEDAY")=1
  1.  .S Y=$P(ABML(ABMP("PRI"),ABMP("INS")),U,4,5)
  1.  .I $L(Y)>1 D
  1.  ..S X1=$S($P(Y,U,2):$P(Y,U,2),1:ABMI("DDT"))
  1.  ..S X2=$S(+Y:+Y,1:ABMI("ADT"))
  1.  ..D ^%DTC
  1.  ..S ABMI("COVD")=X
  1.  .S:'$D(^ABMDCLM(DUZ(2),ABMP("CDFN"),25,0)) ^ABMDCLM(DUZ(2),ABMP("CDFN"),25,0)="^9002274.3025P"
  1.  .S DA(1)=ABMP("CDFN")
  1.  .D CLEAN(25)
  1.  .;Node 25 contains the revenue code subfile
  1.  .;The CLEAN subrtn prevents dupes in subfiles
  1.  .S DIC="^ABMDCLM(DUZ(2),"_DA(1)_",25,"
  1.  .;S DIC(0)="LE",X=120,DIC("DR")=".02////"_ABMI("COVD")_";.03////"_$P($G(^ABMDFEE(ABMP("FEE"),31,X,0)),U,2)  ;abm*2.6*2 3PMS10003A
  1.  .S DIC(0)="LE",X=120,DIC("DR")=".02////"_ABMI("COVD")_";.03////"_$P($$ONE^ABMFEAPI(ABMP("FEE"),31,X,ABMP("VDT")),U)  ;abm*2.6*2 3PMS10003A
  1.  .;Q:(+$G(X)&($P($G(^ABMDFEE(ABMP("FEE"),31,X,0)),U,2)=0)&($P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,14)'="Y"))  ;abm*2.6*2 3PMS10003A
  1.  .;Q:(+$G(X)&($P($$ONE^ABMFEAPI(ABMP("FEE"),31,X,ABMP("VDT")),U)=0)&($P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,14)'="Y"))  ;abm*2.6*2 3PMS10003A  ;abm*2.6*4 HEAT15806
  1.  .S ABMSRC="02|"_ABMDA_"|CPT"
  1.  .S DIC("DR")=DIC("DR")_";.17////"_ABMSRC
  1.  .;K DD,DO D FILE^DICN  ;abm*2.6*4 HEAT15806
  1.  .I ($P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,14)="Y") K DD,DO D FILE^DICN  ;abm*2.6*4 HEAT15806
  1.  .I (($P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,14)'="Y")&(+$G(X)&($P($$ONE^ABMFEAPI(ABMP("FEE"),31,X,ABMP("VDT")),U)'=0))) K DD,DO D FILE^DICN  ;abm*2.6*4 HEAT15806
  1.  .S:'$D(^ABMDCLM(DUZ(2),ABMP("CDFN"),27,0)) ^ABMDCLM(DUZ(2),ABMP("CDFN"),27,0)="^9002274.3027P"
  1.  .;Node 27 is the medical procedure subfile
  1.  .;This first one is entering the CPT code for the day of admission
  1.  .S DA(1)=ABMP("CDFN"),DIC="^ABMDCLM(DUZ(2),"_DA(1)_",27,",DIC(0)="LE"
  1.  .D CLEAN(27)
  1.  .;note:uncommented above line during patch 10 testing
  1.  .S X=$$CPT^ABMDVSTH("INI")
  1.  .;Q:($P($G(^ABMDFEE(ABMP("FEE"),19,X,0)),U,2)=0&($P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,14)'="Y"))  ;abm*2.6*2 3PMS10003A
  1.  .;Q:($P($$ONE^ABMFEAPI(ABMP("FEE"),19,X,ABMP("VDT")),U)=0&($P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,14)'="Y"))  ;abm*2.6*2 3PMS10003A  ;abm*2.6*4 HEAT15806
  1.  .;S DIC("DR")=".03////1;.04////"_$P($G(^ABMDFEE(ABMP("FEE"),19,X,0)),U,2)  ;abm*2.6*2 3PMS10003A
  1.  .S DIC("DR")=".03////1;.04////"_$P($$ONE^ABMFEAPI(ABMP("FEE"),19,X,ABMP("VDT")),U)  ;abm*2.6*2 3PMS10003A
  1.  .;Next line set correspond diagnosis if only 1 POV
  1.  .I $D(ABMP("CORRSDIAG")) S DIC("DR")=DIC("DR")_";.06////1"
  1.  .S DIC("DR")=DIC("DR")_";.07////"_ABMCHVDT
  1.  .S DIC("DR")=DIC("DR")_";.17////"_ABMSRC
  1.  .;K DD,DO D FILE^DICN  ;abm*2.6*4 HEAT15806
  1.  .I ($P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,14)="Y") K DD,DO D FILE^DICN  ;abm*2.6*4 HEAT15806
  1.  .I (($P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,14)'="Y")&(+$G(X)&($P($$ONE^ABMFEAPI(ABMP("FEE"),31,X,ABMP("VDT")),U)'=0))) K DD,DO D FILE^DICN  ;abm*2.6*4 HEAT15806
  1.  .S ABMP("COVD",ABMCHVDT)=""
  1.  .S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN")
  1.  .S DR=".61////"_ABMI("ADT")_";.62////"_ABMI("AHR")_";.71////"_ABMI("ADT")_";.72////"_ABMI("DDT")_";.54////90;.55////"_ABMI("ADT")_";.56////"_ABMI("DDT") D ^DIE
  1.  .S ABMI("PCD")=$S('ABMI("SAMEDAY"):ABMI("COVD")+1,1:1)
  1.  .S DR=".57////"_ABMI("PCD")_";.73////"_ABMI("COVD")_";.74////N;.75////N"
  1.  .D ^DIE K DR
  1.  .Q
  1.  Q:SERVCAT="H"   ;Treat as OP if O or S
  1. OP ; Outpatient
  1.  S DIE="^ABMDCLM(DUZ(2),"
  1.  S DA=ABMP("CDFN")
  1.  S ABMI("ATYPE")=2,ABMI("DSTAT")="01",ABMI("ASRC")=1
  1.  S DR=".51///"_ABMI("ATYPE")_";.52///"_ABMI("ASRC")_";.53///"_ABMI("DSTAT")
  1.  D ^DIE
  1.  I $G(ABMP("PRIMVSIT")) D
  1.  .;ADT is the date from the visit file - admission date
  1.  .S (ABMI("ADT"),ABMP("ADMITDT"),ABMP("HDATE"))=$P($P(ABMP("V0"),U),".")
  1.  .S ABMI("AHR")=$E($P(+ABMP("V0"),".",2),1,2)
  1.  .S ABMI("AHDR")=$S(ABMI("AHR")="":12,ABMI("AHR")>-1&(ABMI("AHR")<24):ABMI("AHR"),1:12)
  1.  .S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN")
  1.  .S DR=".61////"_ABMI("ADT")_";.62////"_ABMI("AHR")  ;admit date/hour
  1.  .S DR=DR_";.63////"_ABMI("ADT")  ;discharge date
  1.  .S DR=DR_";.64////"_$S($P($G(^AUTNINS(ABMP("INS"),0)),U)["NORTH CAROLINA MEDICAID":(ABMI("AHR")+1),1:ABMI("AHR"))  ;discharge hour
  1.  .D ^DIE
  1.  D WT  ;get patient weight from PCC
  1.  S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN")
  1.  S Y=^ABMDCLM(DUZ(2),ABMP("CDFN"),7)
  1.  I $P(Y,U,2)<Y D
  1.  .S DR=".72////"_+Y
  1.  .D ^DIE
  1.  I $P(^ABMDCLM(DUZ(2),ABMP("CDFN"),7),U,3)<2,ABMP("V0")'=ABMCHV0 D
  1.  .;Don't change it if already >1 and child visit
  1.  .S DR=".73////"_1 D ^DIE
  1.  ; There is an assumption
  1.  ;that if the ABMP("MD") var is true the patient saw a doctor 
  1.  ;and it is a chargeable visit.
  1.  ;Piece 7 of the param file is Auto Set level of svc.
  1.  ; clinic 39 is pharmacy
  1.  K ABMX
  1.  S ABMSRC="BC|DEF|CPT"
  1.  N N
  1.  S N=""
  1.  F  S N=$O(AUPNCPT(N)) Q:N=""  D  Q:$D(ABMX)
  1.  .;If the CPT code is not in the range it is not the code for visit
  1.  .I +AUPNCPT(N)<ABMCPTTB("OUT","L") Q
  1.  .I +AUPNCPT(N)>ABMCPTTB("OUT","H") Q
  1.  .S ABMX=+AUPNCPT(N)
  1.  .S ABMSRC=$P($P(AUPNCPT(N),U,4),".",2)_"|"_$P(AUPNCPT(N),U,5)_"|CPT"
  1.  ;If the CPT code is not in the V file, the provider is an MD, the
  1.  ;clinic is not pharmacy, and the Auto Set Level of Svc parameter is
  1.  ;set then set CPT to the default outpatient level.
  1.  I '$D(ABMX),ABMP("MD"),ABMP("CLN")'=39,$P($G(^ABMDPARM(DUZ(2),1,2)),U,7)'=0 D
  1.  .S ABMX=ABMCPTTB("OUT","DEF")
  1.  I '$D(ABMX) Q                  ;Quit if no CPT code
  1.  S:'$D(^ABMDCLM(DUZ(2),ABMP("CDFN"),27,0)) ^(0)="^9002274.3027P"
  1.  S DA(1)=ABMP("CDFN"),DIC="^ABMDCLM(DUZ(2),"_DA(1)_",27,",DIC(0)="LE"
  1.  D CLEAN(27)
  1.  S X=ABMX
  1.  ;Q:($P($G(^ABMDFEE(ABMP("FEE"),19,X,0)),U,2)&($P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,14)'="Y"))  ;abm*2.6*2 3PMS10003A
  1.  Q:($P($$ONE^ABMFEAPI(ABMP("FEE"),19,X,ABMP("VDT")),U)&($P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,14)'="Y"))  ;abm*2.6*2 3PMS10003A
  1.  ;S DIC("DR")=".03////1;.04////"_$P($G(^ABMDFEE(ABMP("FEE"),19,X,0)),U,2)  ;abm*2.6*2 3PMS10003A
  1.  S DIC("DR")=".03////1;.04////"_$P($$ONE^ABMFEAPI(ABMP("FEE"),19,X,ABMP("VDT")),U)  ;abm*2.6*2 3PMS10003A
  1.  ;Next line set correspond diagnosis if only 1 POV
  1.  I $D(ABMP("CORRSDIAG")) S DIC("DR")=DIC("DR")_";.06////1"
  1.  S DIC("DR")=DIC("DR")_";.07////"_ABMCHVDT
  1.  S DIC("DR")=DIC("DR")_";.17////"_ABMSRC
  1.  K DD,DO D FILE^DICN
  1.  K ABMI,ABMX,DA,DIC,DIE,DR
  1.  Q
  1.  ;
  1. CLEAN(ABMSUB,ABMALL) ;EP - Clean out old values from ABMSUB node
  1.  N ABMJ,ABMFDA,FILE,IENS
  1.  S ABMALL=$G(ABMALL)
  1.  S:'$D(DA) DA(1)=ABMP("CDFN")
  1.  I $G(ABMCHV0)=$G(ABMP("V0")),$D(^ABMDCLM(DUZ(2),DA(1),ABMSUB))>1 D
  1.  .S ABMJ=0
  1.  .F  S ABMJ=$O(^ABMDCLM(DUZ(2),DA(1),ABMSUB,ABMJ)) Q:'ABMJ  D
  1.  ..Q:'$D(^ABMDCLM(DUZ(2),DA(1),ABMSUB,ABMJ,0))
  1.  ..S Y=^ABMDCLM(DUZ(2),DA(1),ABMSUB,ABMJ,0)
  1.  ..I 'ABMALL,($P(Y,U,17)="M") Q
  1.  ..S IENS=ABMJ_","_DA(1)_","
  1.  ..S FILE=9002274.30+(ABMSUB/10000)
  1.  ..S ABMFDA(FILE,IENS,.01)="@"
  1.  ..D FILE^DIE("KE","ABMFDA")
  1.  ..K ABMFDA(FILE)
  1.  ..Q:'ABMALL
  1.  ..S ABMSRC=""
  1.  ..F  S ABMSRC=$O(^ABMDCLM(DUZ(2),DA(1),"ASRC",ABMSRC)) Q:ABMSRC=""  D
  1.  ...Q:'$D(^ABMDCLM(DUZ(2),DA(1),"ASRC",ABMSRC,ABMJ))
  1.  ...K ^ABMDCLM(DUZ(2),DA(1),"ASRC",ABMSRC,ABMJ,ABMSUB)
  1.  Q
  1. WT ; get patient weight from V Measurement file
  1.  S ABMVMIEN=0
  1.  S ABMVMFLG=0
  1.  F  S ABMVMIEN=$O(^AUPNVMSR("AD",ABMVDFN,ABMVMIEN)) Q:ABMVMIEN=""  D  Q:ABMVMFLG=1
  1.  .Q:$P($G(^AUPNVMSR(ABMVMIEN,0)),U,2)'=ABMP("PDFN")  ;verify patient
  1.  .Q:($O(^AUTTMSR("B","WT",0)))'=($P($G(^AUPNVMSR(ABMVMIEN,0)),U))
  1.  .S DR=".1211////"_$P($G(^AUPNVMSR(ABMVMIEN,0)),U,4)
  1.  .D ^DIE
  1.  Q