ABMDVSTH ; IHS/ASDST/DMJ - PCC Visit Stuff - PART 5 (HOSPITALIZATION) CONTD ;
;;2.6;IHS Third Party Billing System;**2,4**;NOV 12, 2009
; IHS/SD/SDR - v2.5 p10 - IM20022 - Use AOB/ROI multiples
; IHS/SD/SDR - abm*2.6*2 - 3PMS10003A - modified to call ABMFEAPI
; IHS/SD/SDR - abm*2.6*4 - HEAT15806 - admit date/time not showing due to ABMFEAPI quit; moved up or made conditional
;
;This is a continuation of ABMDVST4
Q ;Not to be called from the top
CPT(SUB,LVL) ;EP - rtn CPT code
K X,ABMSRC
N N,L
S:'$D(LVL) LVL="LOW"
S (L,N)=""
F S N=$O(AUPNCPT(N)) Q:N="" D Q:$D(X)
.F S L=$O(ABMCPTTB("HOS",SUB,L)) Q:L="" D Q:$D(X)
..Q:(+AUPNCPT(N))'=ABMCPTTB("HOS",SUB,L)
..S X=+AUPNCPT(N)
..S ABMSRC=$P($P(AUPNCPT(N),U,4),".",2)_"|"_$P(AUPNCPT(N),U,5)_"|CPT"
I '$D(X) D
.S X=ABMCPTTB("HOS",SUB,LVL)
.S ABMSRC="02|"_$S($D(ABMDA):ABMDA,1:"DEF")_"|CPT"
Q X
;
; the following code to be executed when SERVCAT=I or D
MIDDAY ;EP - The following is for the middle days of care
N ABMCOVD,ABMEDIT,QUIT
S X1=ABMCHVDT
S X2=ABMP("HDATE")
D ^%DTC
S ABMCOVD=X
I ABMCOVD<1 D Q:$G(QUIT)
.I $D(ABMP("COVD",ABMCHVDT)) S QUIT=1 Q
.S DA=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),27,"C",ABMCHVDT,""))
.I DA S ABMEDIT=1
E I ABMCOVD>1 D MAKEDY
S ABMP("COVD",ABMCHVDT)=""
I ABMCHVDT>ABMP("HDATE") S ABMP("HDATE")=ABMCHVDT
Q:ABMCOVD>1
S ABMD=ABMCHVDT
MIDDAY2 S DA(1)=ABMP("CDFN"),DIC="^ABMDCLM(DUZ(2),"_DA(1)_",27,",DIC(0)="LE"
S X=$$CPT("SUB")
;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 ;abm*2.6*4 HEAT15806
I (($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")) Q ;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////"_ABMD
S DIC("DR")=DIC("DR")_";.17////"_ABMSRC
I $G(ABMEDIT) D Q
.S DIE=DIC
.S DR=DIC("DR")
.K DIC(0)
.D ^DIE
.K ABMI
K DD,DO D FILE^DICN
K ABMI
Q
;
MAKEDY ;Put in each day separately
F ABM=1:1:ABMCOVD D
.S X1=ABMP("HDATE")
.S X2=ABM
.D C^%DTC
.S ABMD=X
.Q:$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),27,"C",ABMD,""))
.D MIDDAY2
Q
;
DISCHRG ;EP - The following is for discharge care
N DISNOTCV,COVD
S Y=$P(ABML(ABMP("PRI"),ABMP("INS")),U,4,5)
S X1=$S($P(Y,U,2):$P(Y,U,2),1:ABMP("DDT"))
I X1<ABMP("DDT") S DISNOTCV=1
S X2=$S(+Y>ABMP("HDATE"):+Y,1:ABMP("HDATE"))
D ^%DTC
;If discharge date not covered just do middle days if they exist
I $D(DISNOTCV) D Q
.I X>0 D
..S ABMCOVD=X
..I ABMCOVD>1 D MAKEDY Q
..S ABMD=ABMCHVDT
..D MIDDAY2
E I X>1 D
.S ABMCOVD=X-1
.I ABMCOVD>1 D MAKEDY Q
.S X1=ABMCHVDT
.S X2=-1
.D C^%DTC
.S ABMD=X
.D MIDDAY2
S ABMP("HDATE")=ABMCHVDT
S DA(1)=ABMP("CDFN"),DIC="^ABMDCLM(DUZ(2),"_DA(1)_",27,",DIC(0)="LE"
S X=$$CPT("DIS","LT ")
;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 ;abm*2.6*4 HEAT15806
I (($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")) Q ;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
K ABMI
Q
;
REL ;EP - RELEASE OF INFORMATION
K DIE S DIE="^ABMDCLM(DUZ(2),",DA=ABMP("CDFN")
S DR=".74////N"
I ($D(^AUPNPAT(ABMP("PDFN"),36,0)))>10,($O(^AUPNPAT(ABMP("PDFN"),36,"B",9999999),-1)<ABMP("VDT")) S DR=".74////Y;.711////"_$O(^AUPNPAT(ABMP("PDFN"),36,"B",9999999),-1)
D ^DIE K DR
Q
;
BENE ;EP - ASSIGNMENT OF BENEFITS
S DR=".75////N"
I ($D(^AUPNPAT(ABMP("PDFN"),71,0)))>10,($O(^AUPNPAT(ABMP("PDFN"),71,"B",9999999),-1)<ABMP("VDT")) S DR=".75////Y;.712////"_$O(^AUPNPAT(ABMP("PDFN"),71,"B",9999999),-1)
D ^DIE K DR
Q
ABMDVSTH ; IHS/ASDST/DMJ - PCC Visit Stuff - PART 5 (HOSPITALIZATION) CONTD ;
+1 ;;2.6;IHS Third Party Billing System;**2,4**;NOV 12, 2009
+2 ; IHS/SD/SDR - v2.5 p10 - IM20022 - Use AOB/ROI multiples
+3 ; IHS/SD/SDR - abm*2.6*2 - 3PMS10003A - modified to call ABMFEAPI
+4 ; IHS/SD/SDR - abm*2.6*4 - HEAT15806 - admit date/time not showing due to ABMFEAPI quit; moved up or made conditional
+5 ;
+6 ;This is a continuation of ABMDVST4
+7 ;Not to be called from the top
QUIT
CPT(SUB,LVL) ;EP - rtn CPT code
+1 KILL X,ABMSRC
+2 NEW N,L
+3 IF '$DATA(LVL)
SET LVL="LOW"
+4 SET (L,N)=""
+5 FOR
SET N=$ORDER(AUPNCPT(N))
IF N=""
QUIT
Begin DoDot:1
+6 FOR
SET L=$ORDER(ABMCPTTB("HOS",SUB,L))
IF L=""
QUIT
Begin DoDot:2
+7 IF (+AUPNCPT(N))'=ABMCPTTB("HOS",SUB,L)
QUIT
+8 SET X=+AUPNCPT(N)
+9 SET ABMSRC=$PIECE($PIECE(AUPNCPT(N),U,4),".",2)_"|"_$PIECE(AUPNCPT(N),U,5)_"|CPT"
End DoDot:2
IF $DATA(X)
QUIT
End DoDot:1
IF $DATA(X)
QUIT
+10 IF '$DATA(X)
Begin DoDot:1
+11 SET X=ABMCPTTB("HOS",SUB,LVL)
+12 SET ABMSRC="02|"_$SELECT($DATA(ABMDA):ABMDA,1:"DEF")_"|CPT"
End DoDot:1
+13 QUIT X
+14 ;
+15 ; the following code to be executed when SERVCAT=I or D
MIDDAY ;EP - The following is for the middle days of care
+1 NEW ABMCOVD,ABMEDIT,QUIT
+2 SET X1=ABMCHVDT
+3 SET X2=ABMP("HDATE")
+4 DO ^%DTC
+5 SET ABMCOVD=X
+6 IF ABMCOVD<1
Begin DoDot:1
+7 IF $DATA(ABMP("COVD",ABMCHVDT))
SET QUIT=1
QUIT
+8 SET DA=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),27,"C",ABMCHVDT,""))
+9 IF DA
SET ABMEDIT=1
End DoDot:1
IF $GET(QUIT)
QUIT
+10 IF '$TEST
IF ABMCOVD>1
DO MAKEDY
+11 SET ABMP("COVD",ABMCHVDT)=""
+12 IF ABMCHVDT>ABMP("HDATE")
SET ABMP("HDATE")=ABMCHVDT
+13 IF ABMCOVD>1
QUIT
+14 SET ABMD=ABMCHVDT
MIDDAY2 SET DA(1)=ABMP("CDFN")
SET DIC="^ABMDCLM(DUZ(2),"_DA(1)_",27,"
SET DIC(0)="LE"
+1 SET X=$$CPT("SUB")
+2 ;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
+3 ;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 ;abm*2.6*4 HEAT15806
+4 ;abm*2.6*2 3PMS10003A ;abm*2.6*4 HEAT15806
IF (($PIECE($$ONE^ABMFEAPI(ABMP("FEE"),19,X,ABMP("VDT")),U)=0)&($PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,14)'="Y"))
QUIT
+5 ;S DIC("DR")=".03////1;.04////"_$P($G(^ABMDFEE(ABMP("FEE"),19,X,0)),U,2) ;abm*2.6*2 3PMS10003A
+6 ;abm*2.6*2 3PMS10003A
SET DIC("DR")=".03////1;.04////"_$PIECE($$ONE^ABMFEAPI(ABMP("FEE"),19,X,ABMP("VDT")),U)
+7 ;Next line set correspond diagnosis if only 1 POV
+8 IF $DATA(ABMP("CORRSDIAG"))
SET DIC("DR")=DIC("DR")_";.06////1"
+9 SET DIC("DR")=DIC("DR")_";.07////"_ABMD
+10 SET DIC("DR")=DIC("DR")_";.17////"_ABMSRC
+11 IF $GET(ABMEDIT)
Begin DoDot:1
+12 SET DIE=DIC
+13 SET DR=DIC("DR")
+14 KILL DIC(0)
+15 DO ^DIE
+16 KILL ABMI
End DoDot:1
QUIT
+17 KILL DD,DO
DO FILE^DICN
+18 KILL ABMI
+19 QUIT
+20 ;
MAKEDY ;Put in each day separately
+1 FOR ABM=1:1:ABMCOVD
Begin DoDot:1
+2 SET X1=ABMP("HDATE")
+3 SET X2=ABM
+4 DO C^%DTC
+5 SET ABMD=X
+6 IF $ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),27,"C",ABMD,""))
QUIT
+7 DO MIDDAY2
End DoDot:1
+8 QUIT
+9 ;
DISCHRG ;EP - The following is for discharge care
+1 NEW DISNOTCV,COVD
+2 SET Y=$PIECE(ABML(ABMP("PRI"),ABMP("INS")),U,4,5)
+3 SET X1=$SELECT($PIECE(Y,U,2):$PIECE(Y,U,2),1:ABMP("DDT"))
+4 IF X1<ABMP("DDT")
SET DISNOTCV=1
+5 SET X2=$SELECT(+Y>ABMP("HDATE"):+Y,1:ABMP("HDATE"))
+6 DO ^%DTC
+7 ;If discharge date not covered just do middle days if they exist
+8 IF $DATA(DISNOTCV)
Begin DoDot:1
+9 IF X>0
Begin DoDot:2
+10 SET ABMCOVD=X
+11 IF ABMCOVD>1
DO MAKEDY
QUIT
+12 SET ABMD=ABMCHVDT
+13 DO MIDDAY2
End DoDot:2
End DoDot:1
QUIT
+14 IF '$TEST
IF X>1
Begin DoDot:1
+15 SET ABMCOVD=X-1
+16 IF ABMCOVD>1
DO MAKEDY
QUIT
+17 SET X1=ABMCHVDT
+18 SET X2=-1
+19 DO C^%DTC
+20 SET ABMD=X
+21 DO MIDDAY2
End DoDot:1
+22 SET ABMP("HDATE")=ABMCHVDT
+23 SET DA(1)=ABMP("CDFN")
SET DIC="^ABMDCLM(DUZ(2),"_DA(1)_",27,"
SET DIC(0)="LE"
+24 SET X=$$CPT("DIS","LT ")
+25 ;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
+26 ;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 ;abm*2.6*4 HEAT15806
+27 ;abm*2.6*2 3PMS10003A ;abm*2.6*4 HEAT15806
IF (($PIECE($$ONE^ABMFEAPI(ABMP("FEE"),19,X,ABMP("VDT")),U)=0)&($PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,14)'="Y"))
QUIT
+28 ;S DIC("DR")=".03////1;.04////"_$P($G(^ABMDFEE(ABMP("FEE"),19,X,0)),U,2) ;abm*2.6*2 3PMS10003A
+29 ;abm*2.6*2 3PMS10003A
SET DIC("DR")=".03////1;.04////"_$PIECE($$ONE^ABMFEAPI(ABMP("FEE"),19,X,ABMP("VDT")),U)
+30 ;Next line set correspond diagnosis if only 1 POV
+31 IF $DATA(ABMP("CORRSDIAG"))
SET DIC("DR")=DIC("DR")_";.06////1"
+32 SET DIC("DR")=DIC("DR")_";.07////"_ABMCHVDT
+33 SET DIC("DR")=DIC("DR")_";.17///"_ABMSRC
+34 KILL DD,DO
DO FILE^DICN
+35 KILL ABMI
+36 QUIT
+37 ;
REL ;EP - RELEASE OF INFORMATION
+1 KILL DIE
SET DIE="^ABMDCLM(DUZ(2),"
SET DA=ABMP("CDFN")
+2 SET DR=".74////N"
+3 IF ($DATA(^AUPNPAT(ABMP("PDFN"),36,0)))>10
IF ($ORDER(^AUPNPAT(ABMP("PDFN"),36,"B",9999999),-1)<ABMP("VDT"))
SET DR=".74////Y;.711////"_$ORDER(^AUPNPAT(ABMP("PDFN"),36,"B",9999999),-1)
+4 DO ^DIE
KILL DR
+5 QUIT
+6 ;
BENE ;EP - ASSIGNMENT OF BENEFITS
+1 SET DR=".75////N"
+2 IF ($DATA(^AUPNPAT(ABMP("PDFN"),71,0)))>10
IF ($ORDER(^AUPNPAT(ABMP("PDFN"),71,"B",9999999),-1)<ABMP("VDT"))
SET DR=".75////Y;.712////"_$ORDER(^AUPNPAT(ABMP("PDFN"),71,"B",9999999),-1)
+3 DO ^DIE
KILL DR
+4 QUIT
