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