ABMDE23P.m

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