ABMDE2XA ; IHS/SD/SDR - PAGE 2 - INSURER data chk - cont ;
;;2.6;IHS 3P BILLING SYSTEM;**11,21,26**;NOV 12, 2009;Build 440
;
;IHS/SD/SDR V2.5 P2 4/17/02 - NOIS NEA-0401-180046 Modified to print coverage type on insurer view option in claim generator
;IHS/SD/SDR v2.5 p3 3/4/03 - NDA-0203-180075 Modified to quit if there are no eligibility dates for RR
;IHS/SD/SDR v2.5 p8 IM15314/IM15448 <UNDEF>PRVT+18^ABMDE2XA
;IHS/SD/SDR v2.5 p9 IM16155 Patient's ID number instead of policy holder number
;IHS/SD/SDR v2.5 p9 IM18938 Added code to get RATE CODE
;IHS/SD/SDR v2.5 p9 IM19449 Commented out line to fix policy holder from being date on page 2 of CE
;IHS/SD/SDR v2.5 p10 IM20165 Policy number missing on page 2 for PI
;
;IHS/SD/SDR 2.6*21 HEAT266450 - Made change to claim editor warning #66. Now it will also
; check the VA Patient file for the gender if the active insurer is Medicare or Medicaid.
;IHS/SD/SDR 2.6*21 VMBP RQMT_109 - Added code for new VAMB Eligible file
;IHS/SD/SDR 2.6*26 CR9265 Made changes to ABMV("X1") for Medicare/RR HICN number to use AUPN API to get either the MBI or use old code to get HIC.
;
; *********************************************************************
;
MCD ;EP - Entry Point for setting MCD Info
S $P(ABMV("X1"),U,4)=$P(ABMX("REC"),U,3)
I '+$O(^AUPNMCD(ABMX(2),11,0)) S ABME(103)=""
I $D(^AUPNMCD(ABMX(2),21)) D
.S:$P(^AUPNMCD(ABMX(2),21),U)]"" $P(ABMV("X1"),U,5)=$P(^AUPNMCD(ABMX(2),21),U)
.S:$P(^AUPNMCD(ABMX(2),21),U,2)]"" $P(ABMV("X1"),U,6)=$P(^AUPNMCD(ABMX(2),21),U,2)
;I $P($G(^AUPNMCD(ABMX(2),0)),U,7)=""!($P($G(^AUPNMCD(ABMX(2),0)),U,7)="U") S ABME(66)="" ;abm*2.6*11 MU2 gender ;abm*2.6*21 IHS/SD/SDR HEAT266450 update gender check
I ($P($G(^AUPNMCD(ABMX(2),0)),U,7)=""!($P($G(^AUPNMCD(ABMX(2),0)),U,7)="U"))&($$GET1^DIQ(2,ABMP("PDFN"),".02","I")="U"!($$GET1^DIQ(2,ABMP("PDFN"),".02","I")="")) S ABME(66)="" ;abm*2.6*21 IHS/SD/SDR HEAT266450 update gender check
S ABMLDT=9999999
K ABMP("COV")
F S ABMLDT=$O(^AUPNMCD(ABMX(2),11,ABMLDT),-1) Q:'ABMLDT D
.Q:$P($G(^AUPNMCD(ABMX(2),11,ABMLDT,0)),U)>ABMP("VDT")
.Q:($P($G(^AUPNMCD(ABMX(2),11,ABMLDT,0)),U,2)'="")&($P($G(^AUPNMCD(ABMX(2),11,ABMLDT,0)),U,2)<ABMP("VDT"))
.S ABMPCOV=$P($G(^AUPNMCD(ABMX(2),11,ABMLDT,0)),U,3)
.I ABMPCOV="" S ABMPCOV="NONE"
.Q:$D(ABMP("COV",ABMPCOV))
.S (ABMCOVT,ABMP("COV",ABMPCOV))=$P($G(^AUPNMCD(ABMX(2),11,ABMLDT,0)),U)_U_$P($G(^AUPNMCD(ABMX(2),11,ABMLDT,0)),U,2)
K ABMLDT,ABMESDT,ABMCOVT,ABMEEDT
S $P(ABMV("X1"),U,13)=$P($G(^AUPNMCD(ABMX(2),0)),U,11) ;rate code
K ABMLDT,ABMESDT,ABMEEDT,ABMCOVT
Q
;
; *********************************************************************
PRVT ;EP - Entry Point for setting PI Info
I '$D(^AUPNPRVT(ABMX(2),11,ABMX(1),0)) Q
Q:$P($G(^AUPNPRVT(ABMX(2),11,ABMX(1),0)),U)=""
S ABMX("REC")=^AUPNPRVT(ABMX(2),11,ABMX(1),0)
I $P(ABMX("REC"),U,6)="" S ABME(103)=""
I $P(ABMX("REC"),U,8)]"" D
.S $P(ABMV("X1"),U,4)=$P($G(^AUPN3PPH($P(ABMX("REC"),U,8),0)),U,4)
.S $P(ABMV("X2"),U,1)=$P(ABMX("REC"),U,8)
.S $P(ABMV("X2"),U,2)=$P(ABMX("REC"),U,5)
S:$P(ABMV("X2"),U,1)="" ABME(65)=""
S:$P(ABMV("X2"),U,2)="" ABME(67)=""
S:$P(ABMX("REC"),U,11)]"" $P(ABMV("X1"),U,6)=$P(ABMX("REC"),U,11)
S ABMPH=$P(ABMX("REC"),U,8)
I ABMPH'="" S ABMCOVT=$P($G(^AUPN3PPH(ABMPH,0)),U,5)
;start new code abm*2.6*11 MU2 gender
I ABMPH'="" D
.I $P($G(^AUPN3PPH(ABMPH,0)),U,8)=""!($P($G(^AUPN3PPH(ABMPH,0)),U,8)="U") S ABME(66)=""
;end new code MU2 gender
I ABMPH'=""
K ABMP("COV")
S:$G(ABMCOVT)'="" ABMP("COV",$P($G(^AUTTPIC(ABMCOVT,0)),U))=$P($G(ABMX("REC")),U,6)_U_$P($G(ABMX("REC")),U,7)
S $P(ABMV("X1"),U,10)=$P($G(ABMX("REC")),U,6)
S $P(ABMV("X1"),U,11)=$P($G(ABMX("REC")),U,7)
S $P(ABMV("X1"),U,12)=$S($P($G(^AUPNPRVT(ABMX(2),11,ABMX(1),2)),U)'="":$P(^AUPNPRVT(ABMX(2),11,ABMX(1),2),U),+$P($G(^AUPNPRVT(ABMX(2),11,ABMX(1),0)),U,8)'=0:$P($G(^AUPN3PPH($P(^AUPNPRVT(ABMX(2),11,ABMX(1),0),U,8),0)),U,4),1:"")
K ABMPH,ABMCOVT
Q
;
; *********************************************************************
MCR ;EP - Entry Point for setting MCR Info
;S $P(ABMV("X1"),U,4)=$P(ABMX("REC"),U,3)_$S($P(ABMX("REC"),U,4)]"":"-"_$P(^AUTTMCS($P(ABMX("REC"),U,4),0),U),1:"") ;abm*2.6*26 IHS/SD/SDR CR9265
;start new abm*2.6*26 IHS/SD/SDR CR9265
K ABMMBI
S ABMMBI=""
S ABMMBI=$$HISTMBI^AUPNMBI(ABMX(2),.ABMMBI)
S ABMMBI=+$O(ABMMBI(999999999),-1)
S:(ABMMBI'=0) $P(ABMV("X1"),U,4)=$P(ABMMBI(ABMMBI),U)
I $P($G(ABMV("X1")),U,4)="" S $P(ABMV("X1"),U,4)=$P(ABMX("REC"),U,3)_$S($P(ABMX("REC"),U,4)]"":"-"_$P(^AUTTMCS($P(ABMX("REC"),U,4),0),U),1:"")
;end new abm*2.6*26 IHS/SD/SDR CR9265
I '+$O(^AUPNMCR(ABMX(2),11,0)) S ABME(103)=""
I $D(^AUPNMCR(ABMX(2),21)) D
.S:$P(^AUPNMCR(ABMX(2),21),U)]"" $P(ABMV("X1"),U,5)=$P(^AUPNMCR(ABMX(2),21),U)
.S:$P(^AUPNMCR(ABMX(2),21),U,2)]"" $P(ABMV("X1"),U,6)=$P(^AUPNMCR(ABMX(2),21),U,2)
S ABMLDT=9999999
K ABMP("COV")
F S ABMLDT=$O(^AUPNMCR(ABMX(2),11,ABMLDT),-1) Q:'ABMLDT D
.Q:$P($G(^AUPNMCR(ABMX(2),11,ABMLDT,0)),U)>ABMP("VDT")
.Q:($P($G(^AUPNMCR(ABMX(2),11,ABMLDT,0)),U,2)'="")&($P($G(^AUPNMCR(ABMX(2),11,ABMLDT,0)),U,2)<ABMP("VDT"))
.S ABMPCOV=$P($G(^AUPNMCR(ABMX(2),11,ABMLDT,0)),U,3)
.Q:ABMPCOV=""
.Q:$D(ABMP("COV",ABMPCOV))
.S (ABMCOVT,ABMP("COV",ABMPCOV))=$P($G(^AUPNMCR(ABMX(2),11,ABMLDT,0)),U)_U_$P($G(^AUPNMCR(ABMX(2),11,ABMLDT,0)),U,2)
.I $P($G(^AUPNMCR(ABMX(2),11,ABMLDT,0)),U,8)=""!($P($G(^AUPNMCR(ABMX(2),11,ABMLDT,0)),U,8)="U") S ABME(66)="" ;abm*2.6*11 MU2 gender
K ABMLDT,ABMESDT,ABMCOVT,ABMEEDT
Q
;
; *********************************************************************
;start new abm*2.6*21 IHS/SD/SDR VMBP RQMT_109
VAMB ;EP - Entry Point for setting VAMB Info
S $P(ABMV("X1"),U,4)=$P(ABMX("REC"),U,6)
I '+$O(^AUPNVAMB(ABMX(2),11,0)) S ABME(103)=""
I $P($G(^AUPNVAMB(ABMX(2),0)),U,8)=""!($P($G(^AUPNVAMB(ABMX(2),0)),U,8)="U") S ABME(66)="" ;MU2 gender
S ABMLDT=9999999
K ABMP("COV")
F S ABMLDT=$O(^AUPNVAMB(ABMX(2),11,ABMLDT),-1) Q:'ABMLDT D
.Q:$P($G(^AUPNVAMB(ABMX(2),11,ABMLDT,0)),U)>ABMP("VDT")
.Q:($P($G(^AUPNVAMB(ABMX(2),11,ABMLDT,0)),U,2)'="")&($P($G(^AUPNVAMB(ABMX(2),11,ABMLDT,0)),U,2)<ABMP("VDT"))
.S ABMPCOV=$$GET1^DIQ(9999999.65,$P($G(^AUPNVAMB(ABMX(2),11,ABMLDT,0)),U,3),".01","E")
.Q:ABMPCOV=""
.Q:$D(ABMP("COV",ABMPCOV))
.S (ABMCOVT,ABMP("COV",ABMPCOV))=$P($G(^AUPNVAMB(ABMX(2),11,ABMLDT,0)),U)_U_$P($G(^AUPNVAMB(ABMX(2),11,ABMLDT,0)),U,2)
K ABMLDT,ABMESDT,ABMCOVT,ABMEEDT
Q
;end new abm*2.6*21 IHS/SD/SDR VMBP RQMT_109
; *********************************************************************
RRE ;EP - Entry Point for setting RR Info
;I $P(ABMX("REC"),U,3)]"" S $P(ABMV("X1"),U,4)=$P(^AUTTRRP($P(ABMX("REC"),U,3),0),U)_$S($P(ABMX("REC"),U,4)]"":"-"_$P(ABMX("REC"),U,4),1:"") ;abm*2.6*26 IHS/SD/SDR CR9265
;start new abm*2.6*26 IHS/SD/SDR CR9265
K ABMMBI
S ABMMBI=""
S ABMMBI=$$HISTMBI^AUPNMBI(ABMX(2),.ABMMBI)
S ABMMBI=+$O(ABMMBI(999999999),-1)
S:(ABMMBI'=0) $P(ABMV("X1"),U,4)=$P(ABMMBI(ABMMBI),U)
I $P($G(ABMV("X1")),U,4)="" I $P(ABMX("REC"),U,3)]"" S $P(ABMV("X1"),U,4)=$P(^AUTTRRP($P(ABMX("REC"),U,3),0),U)_$S($P(ABMX("REC"),U,4)]"":"-"_$P(ABMX("REC"),U,4),1:"")
;end new abm*2.6*26 IHS/SD/SDR CR9265
I '+$O(^AUPNRRE(ABMX(2),11,0)) S ABME(103)=""
I $D(^AUPNRRE(ABMX(2),21)) D
.S:$P(^AUPNRRE(ABMX(2),21),U)]"" $P(ABMV("X1"),U,5)=$P(^AUPNRRE(ABMX(2),21),U)
.S:$P(^AUPNRRE(ABMX(2),21),U,2)]"" $P(ABMV("X1"),U,6)=$P(^AUPNRRE(ABMX(2),21),U,2)
S ABMLDT=9999999
K ABMP("COV")
F S ABMLDT=$O(^AUPNRRE(ABMX(2),11,ABMLDT),-1) Q:'ABMLDT D
.Q:$P($G(^AUPNRRE(ABMX(2),11,ABMLDT,0)),U)>ABMP("VDT")
.Q:($P($G(^AUPNRRE(ABMX(2),11,ABMLDT,0)),U,2)'="")&($P($G(^AUPNRRE(ABMX(2),11,ABMLDT,0)),U,2)<ABMP("VDT"))
.S ABMPCOV=$P($G(^AUPNRRE(ABMX(2),11,ABMLDT,0)),U,3)
.Q:$D(ABMP("COV",ABMPCOV))
.S (ABMCOVT,ABMP("COV",ABMPCOV))=$P($G(^AUPNRRE(ABMX(2),11,ABMLDT,0)),U)_U_$P($G(^AUPNRRE(ABMX(2),11,ABMLDT,0)),U,2)
.I $P($G(^AUPNRRE(ABMX(2),11,ABMLDT,0)),U,8)=""!($P($G(^AUPNRRE(ABMX(2),11,ABMLDT,0)),U,8)="U") S ABME(66)="" ;abm*2.6*11 MU2 gender
K ABMLDT,ABMESDT,ABMCOVT,ABMEED
Q
;
; *********************************************************************
COV ;EP - Entry Point for setting Coverage Type Info
Q
ABMDE2XA ; IHS/SD/SDR - PAGE 2 - INSURER data chk - cont ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**11,21,26**;NOV 12, 2009;Build 440
+2 ;
+3 ;IHS/SD/SDR V2.5 P2 4/17/02 - NOIS NEA-0401-180046 Modified to print coverage type on insurer view option in claim generator
+4 ;IHS/SD/SDR v2.5 p3 3/4/03 - NDA-0203-180075 Modified to quit if there are no eligibility dates for RR
+5 ;IHS/SD/SDR v2.5 p8 IM15314/IM15448 <UNDEF>PRVT+18^ABMDE2XA
+6 ;IHS/SD/SDR v2.5 p9 IM16155 Patient's ID number instead of policy holder number
+7 ;IHS/SD/SDR v2.5 p9 IM18938 Added code to get RATE CODE
+8 ;IHS/SD/SDR v2.5 p9 IM19449 Commented out line to fix policy holder from being date on page 2 of CE
+9 ;IHS/SD/SDR v2.5 p10 IM20165 Policy number missing on page 2 for PI
+10 ;
+11 ;IHS/SD/SDR 2.6*21 HEAT266450 - Made change to claim editor warning #66. Now it will also
+12 ; check the VA Patient file for the gender if the active insurer is Medicare or Medicaid.
+13 ;IHS/SD/SDR 2.6*21 VMBP RQMT_109 - Added code for new VAMB Eligible file
+14 ;IHS/SD/SDR 2.6*26 CR9265 Made changes to ABMV("X1") for Medicare/RR HICN number to use AUPN API to get either the MBI or use old code to get HIC.
+15 ;
+16 ; *********************************************************************
+17 ;
MCD ;EP - Entry Point for setting MCD Info
+1 SET $PIECE(ABMV("X1"),U,4)=$PIECE(ABMX("REC"),U,3)
+2 IF '+$ORDER(^AUPNMCD(ABMX(2),11,0))
SET ABME(103)=""
+3 IF $DATA(^AUPNMCD(ABMX(2),21))
Begin DoDot:1
+4 IF $PIECE(^AUPNMCD(ABMX(2),21),U)]""
SET $PIECE(ABMV("X1"),U,5)=$PIECE(^AUPNMCD(ABMX(2),21),U)
+5 IF $PIECE(^AUPNMCD(ABMX(2),21),U,2)]""
SET $PIECE(ABMV("X1"),U,6)=$PIECE(^AUPNMCD(ABMX(2),21),U,2)
End DoDot:1
+6 ;I $P($G(^AUPNMCD(ABMX(2),0)),U,7)=""!($P($G(^AUPNMCD(ABMX(2),0)),U,7)="U") S ABME(66)="" ;abm*2.6*11 MU2 gender ;abm*2.6*21 IHS/SD/SDR HEAT266450 update gender check
+7 ;abm*2.6*21 IHS/SD/SDR HEAT266450 update gender check
IF ($PIECE($GET(^AUPNMCD(ABMX(2),0)),U,7)=""!($PIECE($GET(^AUPNMCD(ABMX(2),0)),U,7)="U"))&($$GET1^DIQ(2,ABMP("PDFN"),".02","I")="U"!($$GET1^DIQ(2,ABMP("PDFN"),".02","I")=""))
SET ABME(66)=""
+8 SET ABMLDT=9999999
+9 KILL ABMP("COV")
+10 FOR
SET ABMLDT=$ORDER(^AUPNMCD(ABMX(2),11,ABMLDT),-1)
IF 'ABMLDT
QUIT
Begin DoDot:1
+11 IF $PIECE($GET(^AUPNMCD(ABMX(2),11,ABMLDT,0)),U)>ABMP("VDT")
QUIT
+12 IF ($PIECE($GET(^AUPNMCD(ABMX(2),11,ABMLDT,0)),U,2)'="")&($PIECE($GET(^AUPNMCD(ABMX(2),11,ABMLDT,0)),U,2)<ABMP("VDT"))
QUIT
+13 SET ABMPCOV=$PIECE($GET(^AUPNMCD(ABMX(2),11,ABMLDT,0)),U,3)
+14 IF ABMPCOV=""
SET ABMPCOV="NONE"
+15 IF $DATA(ABMP("COV",ABMPCOV))
QUIT
+16 SET (ABMCOVT,ABMP("COV",ABMPCOV))=$PIECE($GET(^AUPNMCD(ABMX(2),11,ABMLDT,0)),U)_U_$PIECE($GET(^AUPNMCD(ABMX(2),11,ABMLDT,0)),U,2)
End DoDot:1
+17 KILL ABMLDT,ABMESDT,ABMCOVT,ABMEEDT
+18 ;rate code
SET $PIECE(ABMV("X1"),U,13)=$PIECE($GET(^AUPNMCD(ABMX(2),0)),U,11)
+19 KILL ABMLDT,ABMESDT,ABMEEDT,ABMCOVT
+20 QUIT
+21 ;
+22 ; *********************************************************************
PRVT ;EP - Entry Point for setting PI Info
+1 IF '$DATA(^AUPNPRVT(ABMX(2),11,ABMX(1),0))
QUIT
+2 IF $PIECE($GET(^AUPNPRVT(ABMX(2),11,ABMX(1),0)),U)=""
QUIT
+3 SET ABMX("REC")=^AUPNPRVT(ABMX(2),11,ABMX(1),0)
+4 IF $PIECE(ABMX("REC"),U,6)=""
SET ABME(103)=""
+5 IF $PIECE(ABMX("REC"),U,8)]""
Begin DoDot:1
+6 SET $PIECE(ABMV("X1"),U,4)=$PIECE($GET(^AUPN3PPH($PIECE(ABMX("REC"),U,8),0)),U,4)
+7 SET $PIECE(ABMV("X2"),U,1)=$PIECE(ABMX("REC"),U,8)
+8 SET $PIECE(ABMV("X2"),U,2)=$PIECE(ABMX("REC"),U,5)
End DoDot:1
+9 IF $PIECE(ABMV("X2"),U,1)=""
SET ABME(65)=""
+10 IF $PIECE(ABMV("X2"),U,2)=""
SET ABME(67)=""
+11 IF $PIECE(ABMX("REC"),U,11)]""
SET $PIECE(ABMV("X1"),U,6)=$PIECE(ABMX("REC"),U,11)
+12 SET ABMPH=$PIECE(ABMX("REC"),U,8)
+13 IF ABMPH'=""
SET ABMCOVT=$PIECE($GET(^AUPN3PPH(ABMPH,0)),U,5)
+14 ;start new code abm*2.6*11 MU2 gender
+15 IF ABMPH'=""
Begin DoDot:1
+16 IF $PIECE($GET(^AUPN3PPH(ABMPH,0)),U,8)=""!($PIECE($GET(^AUPN3PPH(ABMPH,0)),U,8)="U")
SET ABME(66)=""
End DoDot:1
+17 ;end new code MU2 gender
+18 IF ABMPH'=""
+19 KILL ABMP("COV")
+20 IF $GET(ABMCOVT)'=""
SET ABMP("COV",$PIECE($GET(^AUTTPIC(ABMCOVT,0)),U))=$PIECE($GET(ABMX("REC")),U,6)_U_$PIECE($GET(ABMX("REC")),U,7)
+21 SET $PIECE(ABMV("X1"),U,10)=$PIECE($GET(ABMX("REC")),U,6)
+22 SET $PIECE(ABMV("X1"),U,11)=$PIECE($GET(ABMX("REC")),U,7)
+23 SET $PIECE(ABMV("X1"),U,12)=$SELECT($PIECE($GET(^AUPNPRVT(ABMX(2),11,ABMX(1),2)),U)'="":$PIECE(^AUPNPRVT(ABMX(2),11,ABMX(1),2),U),+$PIECE(...
... $GET(^AUPNPRVT(ABMX(2),11,ABMX(1),0)),U,8)'=0:$PIECE($GET(^AUPN3PPH($PIECE(^AUPNPRVT(ABMX(2),11,ABMX(1),0),U,8),0)),U,4),1:"")
+24 KILL ABMPH,ABMCOVT
+25 QUIT
+26 ;
+27 ; *********************************************************************
MCR ;EP - Entry Point for setting MCR Info
+1 ;S $P(ABMV("X1"),U,4)=$P(ABMX("REC"),U,3)_$S($P(ABMX("REC"),U,4)]"":"-"_$P(^AUTTMCS($P(ABMX("REC"),U,4),0),U),1:"") ;abm*2.6*26 IHS/SD/SDR CR9265
+2 ;start new abm*2.6*26 IHS/SD/SDR CR9265
+3 KILL ABMMBI
+4 SET ABMMBI=""
+5 SET ABMMBI=$$HISTMBI^AUPNMBI(ABMX(2),.ABMMBI)
+6 SET ABMMBI=+$ORDER(ABMMBI(999999999),-1)
+7 IF (ABMMBI'=0)
SET $PIECE(ABMV("X1"),U,4)=$PIECE(ABMMBI(ABMMBI),U)
+8 IF $PIECE($GET(ABMV("X1")),U,4)=""
SET $PIECE(ABMV("X1"),U,4)=$PIECE(ABMX("REC"),U,3)_$SELECT($PIECE(ABMX("REC"),U,4)]"":"-"_$PIECE(^AUTTMCS($PIECE(ABMX("REC"),U,4),0),U),1:"")
+9 ;end new abm*2.6*26 IHS/SD/SDR CR9265
+10 IF '+$ORDER(^AUPNMCR(ABMX(2),11,0))
SET ABME(103)=""
+11 IF $DATA(^AUPNMCR(ABMX(2),21))
Begin DoDot:1
+12 IF $PIECE(^AUPNMCR(ABMX(2),21),U)]""
SET $PIECE(ABMV("X1"),U,5)=$PIECE(^AUPNMCR(ABMX(2),21),U)
+13 IF $PIECE(^AUPNMCR(ABMX(2),21),U,2)]""
SET $PIECE(ABMV("X1"),U,6)=$PIECE(^AUPNMCR(ABMX(2),21),U,2)
End DoDot:1
+14 SET ABMLDT=9999999
+15 KILL ABMP("COV")
+16 FOR
SET ABMLDT=$ORDER(^AUPNMCR(ABMX(2),11,ABMLDT),-1)
IF 'ABMLDT
QUIT
Begin DoDot:1
+17 IF $PIECE($GET(^AUPNMCR(ABMX(2),11,ABMLDT,0)),U)>ABMP("VDT")
QUIT
+18 IF ($PIECE($GET(^AUPNMCR(ABMX(2),11,ABMLDT,0)),U,2)'="")&($PIECE($GET(^AUPNMCR(ABMX(2),11,ABMLDT,0)),U,2)<ABMP("VDT"))
QUIT
+19 SET ABMPCOV=$PIECE($GET(^AUPNMCR(ABMX(2),11,ABMLDT,0)),U,3)
+20 IF ABMPCOV=""
QUIT
+21 IF $DATA(ABMP("COV",ABMPCOV))
QUIT
+22 SET (ABMCOVT,ABMP("COV",ABMPCOV))=$PIECE($GET(^AUPNMCR(ABMX(2),11,ABMLDT,0)),U)_U_$PIECE($GET(^AUPNMCR(ABMX(2),11,ABMLDT,0)),U,2)
+23 ;abm*2.6*11 MU2 gender
IF $PIECE($GET(^AUPNMCR(ABMX(2),11,ABMLDT,0)),U,8)=""!($PIECE($GET(^AUPNMCR(ABMX(2),11,ABMLDT,0)),U,8)="U")
SET ABME(66)=""
End DoDot:1
+24 KILL ABMLDT,ABMESDT,ABMCOVT,ABMEEDT
+25 QUIT
+26 ;
+27 ; *********************************************************************
+28 ;start new abm*2.6*21 IHS/SD/SDR VMBP RQMT_109
VAMB ;EP - Entry Point for setting VAMB Info
+1 SET $PIECE(ABMV("X1"),U,4)=$PIECE(ABMX("REC"),U,6)
+2 IF '+$ORDER(^AUPNVAMB(ABMX(2),11,0))
SET ABME(103)=""
+3 ;MU2 gender
IF $PIECE($GET(^AUPNVAMB(ABMX(2),0)),U,8)=""!($PIECE($GET(^AUPNVAMB(ABMX(2),0)),U,8)="U")
SET ABME(66)=""
+4 SET ABMLDT=9999999
+5 KILL ABMP("COV")
+6 FOR
SET ABMLDT=$ORDER(^AUPNVAMB(ABMX(2),11,ABMLDT),-1)
IF 'ABMLDT
QUIT
Begin DoDot:1
+7 IF $PIECE($GET(^AUPNVAMB(ABMX(2),11,ABMLDT,0)),U)>ABMP("VDT")
QUIT
+8 IF ($PIECE($GET(^AUPNVAMB(ABMX(2),11,ABMLDT,0)),U,2)'="")&($PIECE($GET(^AUPNVAMB(ABMX(2),11,ABMLDT,0)),U,2)<ABMP("VDT"))
QUIT
+9 SET ABMPCOV=$$GET1^DIQ(9999999.65,$PIECE($GET(^AUPNVAMB(ABMX(2),11,ABMLDT,0)),U,3),".01","E")
+10 IF ABMPCOV=""
QUIT
+11 IF $DATA(ABMP("COV",ABMPCOV))
QUIT
+12 SET (ABMCOVT,ABMP("COV",ABMPCOV))=$PIECE($GET(^AUPNVAMB(ABMX(2),11,ABMLDT,0)),U)_U_$PIECE($GET(^AUPNVAMB(ABMX(2),11,ABMLDT,0)),U,2)
End DoDot:1
+13 KILL ABMLDT,ABMESDT,ABMCOVT,ABMEEDT
+14 QUIT
+15 ;end new abm*2.6*21 IHS/SD/SDR VMBP RQMT_109
+16 ; *********************************************************************
RRE ;EP - Entry Point for setting RR Info
+1 ;I $P(ABMX("REC"),U,3)]"" S $P(ABMV("X1"),U,4)=$P(^AUTTRRP($P(ABMX("REC"),U,3),0),U)_$S($P(ABMX("REC"),U,4)]"":"-"_$P(ABMX("REC"),U,4),1:"") ;abm*2.6*26 IHS/SD/SDR CR9265
+2 ;start new abm*2.6*26 IHS/SD/SDR CR9265
+3 KILL ABMMBI
+4 SET ABMMBI=""
+5 SET ABMMBI=$$HISTMBI^AUPNMBI(ABMX(2),.ABMMBI)
+6 SET ABMMBI=+$ORDER(ABMMBI(999999999),-1)
+7 IF (ABMMBI'=0)
SET $PIECE(ABMV("X1"),U,4)=$PIECE(ABMMBI(ABMMBI),U)
+8 IF $PIECE($GET(ABMV("X1")),U,4)=""
IF $PIECE(ABMX("REC"),U,3)]""
SET $PIECE(ABMV("X1"),U,4)=$PIECE(^AUTTRRP($PIECE(ABMX("REC"),U,3),0),U)_$SELECT($PIECE(ABMX("REC"),U,4)]"":"-"_$PIECE(ABMX("REC"),U,4),1:"")
+9 ;end new abm*2.6*26 IHS/SD/SDR CR9265
+10 IF '+$ORDER(^AUPNRRE(ABMX(2),11,0))
SET ABME(103)=""
+11 IF $DATA(^AUPNRRE(ABMX(2),21))
Begin DoDot:1
+12 IF $PIECE(^AUPNRRE(ABMX(2),21),U)]""
SET $PIECE(ABMV("X1"),U,5)=$PIECE(^AUPNRRE(ABMX(2),21),U)
+13 IF $PIECE(^AUPNRRE(ABMX(2),21),U,2)]""
SET $PIECE(ABMV("X1"),U,6)=$PIECE(^AUPNRRE(ABMX(2),21),U,2)
End DoDot:1
+14 SET ABMLDT=9999999
+15 KILL ABMP("COV")
+16 FOR
SET ABMLDT=$ORDER(^AUPNRRE(ABMX(2),11,ABMLDT),-1)
IF 'ABMLDT
QUIT
Begin DoDot:1
+17 IF $PIECE($GET(^AUPNRRE(ABMX(2),11,ABMLDT,0)),U)>ABMP("VDT")
QUIT
+18 IF ($PIECE($GET(^AUPNRRE(ABMX(2),11,ABMLDT,0)),U,2)'="")&($PIECE($GET(^AUPNRRE(ABMX(2),11,ABMLDT,0)),U,2)<ABMP("VDT"))
QUIT
+19 SET ABMPCOV=$PIECE($GET(^AUPNRRE(ABMX(2),11,ABMLDT,0)),U,3)
+20 IF $DATA(ABMP("COV",ABMPCOV))
QUIT
+21 SET (ABMCOVT,ABMP("COV",ABMPCOV))=$PIECE($GET(^AUPNRRE(ABMX(2),11,ABMLDT,0)),U)_U_$PIECE($GET(^AUPNRRE(ABMX(2),11,ABMLDT,0)),U,2)
+22 ;abm*2.6*11 MU2 gender
IF $PIECE($GET(^AUPNRRE(ABMX(2),11,ABMLDT,0)),U,8)=""!($PIECE($GET(^AUPNRRE(ABMX(2),11,ABMLDT,0)),U,8)="U")
SET ABME(66)=""
End DoDot:1
+23 KILL ABMLDT,ABMESDT,ABMCOVT,ABMEED
+24 QUIT
+25 ;
+26 ; *********************************************************************
COV ;EP - Entry Point for setting Coverage Type Info
+1 QUIT
