ABMDE23P ; IHS/SD/SDR - PAGE 2 - 3RD PARTY SOURCES ;
;;2.6;IHS 3P BILLING SYSTEM;**26**;NOV 12, 2009;Build 440
;IHS/SD/SDR 2.6*26 CR9265 Changed to use AUPN API to get the MBI or use old code to get HIC
;
; *********************************************************************
;
MCD ;
S $P(ABMV("X1"),U,4)=$P(ABMX("REC"),U,3)
I $P(ABMX("REC"),U,9)]"" D
.S $P(ABMV("X2"),U,1)=$P(ABMX("REC"),U,9)
.S $P(ABMV("X2"),U,2)=$P(ABMX("REC"),U,6)
S:$P(ABMV("X2"),U,1)="" ABME(65)=""
S:$P(ABMV("X2"),U,2)="" ABME(67)=""
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)
D COV
Q
;
; *********************************************************************
PRVT ;
I '$D(^AUPNPRVT(ABMX(2),11,ABMX(1),0)) D Q
.S DA(1)=ABMP("CDFN")
.S DIK="^ABMDCLM(DUZ(2),"_DA(1)_",13,"
.S DA=ABMX(1)
.D ^DIK
S ABMX("REC")=^AUPNPRVT(ABMX(2),11,ABMX(1),0)
S $P(ABMV("X1"),U,4)=$P(ABMX("REC"),U,2)
I $P(ABMX("REC"),U,8)]"" D
.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,9)]"" $P(ABMV("X1"),U,5)=$P(ABMX("REC"),U,9)
S:$P(ABMX("REC"),U,11)]"" $P(ABMV("X1"),U,6)=$P(ABMX("REC"),U,11)
D COV
Q
;
; *********************************************************************
MCR ;
;S $P(ABMV("X1"),U,4)=$P(ABMX("REC"),U,3)_"-"_$P(^AUTTMCS($P(ABMX("REC"),U,4),0),U) ;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)_"-"_$P(^AUTTMCS($P(ABMX("REC"),U,4),0),U)
;end new abm*2.6*26 IHS/SD/SDR CR9265
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)
D COV
Q
;
; *********************************************************************
RRE ;
;S $P(ABMV("X1"),U,4)=$P(^AUTTRRP($P(ABMX("REC"),U,3),0),U)_"-"_$P(ABMX("REC"),U,4) ;abm*2.6*26 IHS/SD/SDR HCR9265
;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(^AUTTRRP($P(ABMX("REC"),U,3),0),U)_"-"_$P(ABMX("REC"),U,4)
;end new abm*2.6*26 IHS/SD/SDR CR9265
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)
D COV
Q
;
; *********************************************************************
NON ;
Q
;
; *********************************************************************
COV ;
S ABMX=0
F ABMX("C")=1:1 S ABMX=$O(@(ABMP("GL")_"13,"_ABMX("INS")_",11,"_ABMX_")")) Q:'ABMX S $P(ABMV("X1"),U,9)=$S($P(ABMV("X1"),U,9)]"":$P(ABMV("X1"),U,9)_";"_$P(^AUTTPIC(ABMX,0),U),1:$P(^AUTTPIC(ABMX,0),U))
Q
;
; *********************************************************************
XIT ;
K ABMX
Q
ABMDE23P ; IHS/SD/SDR - PAGE 2 - 3RD PARTY SOURCES ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**26**;NOV 12, 2009;Build 440
+2 ;IHS/SD/SDR 2.6*26 CR9265 Changed to use AUPN API to get the MBI or use old code to get HIC
+3 ;
+4 ; *********************************************************************
+5 ;
MCD ;
+1 SET $PIECE(ABMV("X1"),U,4)=$PIECE(ABMX("REC"),U,3)
+2 IF $PIECE(ABMX("REC"),U,9)]""
Begin DoDot:1
+3 SET $PIECE(ABMV("X2"),U,1)=$PIECE(ABMX("REC"),U,9)
+4 SET $PIECE(ABMV("X2"),U,2)=$PIECE(ABMX("REC"),U,6)
End DoDot:1
+5 IF $PIECE(ABMV("X2"),U,1)=""
SET ABME(65)=""
+6 IF $PIECE(ABMV("X2"),U,2)=""
SET ABME(67)=""
+7 IF $DATA(^AUPNMCD(ABMX(2),21))
Begin DoDot:1
+8 IF $PIECE(^AUPNMCD(ABMX(2),21),U)]""
SET $PIECE(ABMV("X1"),U,5)=$PIECE(^AUPNMCD(ABMX(2),21),U)
+9 IF $PIECE(^AUPNMCD(ABMX(2),21),U,2)]""
SET $PIECE(ABMV("X1"),U,6)=$PIECE(^AUPNMCD(ABMX(2),21),U,2)
End DoDot:1
+10 DO COV
+11 QUIT
+12 ;
+13 ; *********************************************************************
PRVT ;
+1 IF '$DATA(^AUPNPRVT(ABMX(2),11,ABMX(1),0))
Begin DoDot:1
+2 SET DA(1)=ABMP("CDFN")
+3 SET DIK="^ABMDCLM(DUZ(2),"_DA(1)_",13,"
+4 SET DA=ABMX(1)
+5 DO ^DIK
End DoDot:1
QUIT
+6 SET ABMX("REC")=^AUPNPRVT(ABMX(2),11,ABMX(1),0)
+7 SET $PIECE(ABMV("X1"),U,4)=$PIECE(ABMX("REC"),U,2)
+8 IF $PIECE(ABMX("REC"),U,8)]""
Begin DoDot:1
+9 SET $PIECE(ABMV("X2"),U,1)=$PIECE(ABMX("REC"),U,8)
+10 SET $PIECE(ABMV("X2"),U,2)=$PIECE(ABMX("REC"),U,5)
End DoDot:1
+11 IF $PIECE(ABMV("X2"),U,1)=""
SET ABME(65)=""
+12 IF $PIECE(ABMV("X2"),U,2)=""
SET ABME(67)=""
+13 IF $PIECE(ABMX("REC"),U,9)]""
SET $PIECE(ABMV("X1"),U,5)=$PIECE(ABMX("REC"),U,9)
+14 IF $PIECE(ABMX("REC"),U,11)]""
SET $PIECE(ABMV("X1"),U,6)=$PIECE(ABMX("REC"),U,11)
+15 DO COV
+16 QUIT
+17 ;
+18 ; *********************************************************************
MCR ;
+1 ;S $P(ABMV("X1"),U,4)=$P(ABMX("REC"),U,3)_"-"_$P(^AUTTMCS($P(ABMX("REC"),U,4),0),U) ;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)_"-"_$PIECE(^AUTTMCS($PIECE(ABMX("REC"),U,4),0),U)
+9 ;end new abm*2.6*26 IHS/SD/SDR CR9265
+10 IF $DATA(^AUPNMCR(ABMX(2),21))
Begin DoDot:1
+11 IF $PIECE(^AUPNMCR(ABMX(2),21),U)]""
SET $PIECE(ABMV("X1"),U,5)=$PIECE(^AUPNMCR(ABMX(2),21),U)
+12 IF $PIECE(^AUPNMCR(ABMX(2),21),U,2)]""
SET $PIECE(ABMV("X1"),U,6)=$PIECE(^AUPNMCR(ABMX(2),21),U,2)
End DoDot:1
+13 DO COV
+14 QUIT
+15 ;
+16 ; *********************************************************************
RRE ;
+1 ;S $P(ABMV("X1"),U,4)=$P(^AUTTRRP($P(ABMX("REC"),U,3),0),U)_"-"_$P(ABMX("REC"),U,4) ;abm*2.6*26 IHS/SD/SDR HCR9265
+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(^AUTTRRP($PIECE(ABMX("REC"),U,3),0),U)_"-"_$PIECE(ABMX("REC"),U,4)
+9 ;end new abm*2.6*26 IHS/SD/SDR CR9265
+10 IF $DATA(^AUPNRRE(ABMX(2),21))
Begin DoDot:1
+11 IF $PIECE(^AUPNRRE(ABMX(2),21),U)]""
SET $PIECE(ABMV("X1"),U,5)=$PIECE(^AUPNRRE(ABMX(2),21),U)
+12 IF $PIECE(^AUPNRRE(ABMX(2),21),U,2)]""
SET $PIECE(ABMV("X1"),U,6)=$PIECE(^AUPNRRE(ABMX(2),21),U,2)
End DoDot:1
+13 DO COV
+14 QUIT
+15 ;
+16 ; *********************************************************************
NON ;
+1 QUIT
+2 ;
+3 ; *********************************************************************
COV ;
+1 SET ABMX=0
+2 FOR ABMX("C")=1:1
SET ABMX=$ORDER(@(ABMP("GL")_"13,"_ABMX("INS")_",11,"_ABMX_")"))
IF 'ABMX
QUIT
SET $PIECE(ABMV("X1"),U,9)=$SELECT($PIECE(ABMV("X1"),U,9)]"":$PIECE(ABMV("X1"),U,9)_";"_$PIECE(^AUTTPIC(ABMX,0),U),1:$PIECE(^AUTTPIC(ABMX,0),U))
+3 QUIT
+4 ;
+5 ; *********************************************************************
XIT ;
+1 KILL ABMX
+2 QUIT
