ABMDTX3.m

ABMDTX3 ; IHS/ASDST/DMJ - PT 4 OF CLAIM EXPORT PROGRAM ;

 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009

 ;

 S (ABM("BDFN"),ABM("AMT"),ABM("CNT"))=0

 F  S ABM("BDFN")=$O(^TMP("ABMDTX",$J,ABM("BDFN"))) Q:'ABM("BDFN")  D

 . Q:'$D(^ABMDBILL(DUZ(2),ABM("BDFN"),0))

 . S ABM(0)=^ABMDBILL(DUZ(2),ABM("BDFN"),0)

 . S ABM(1)=^ABMDBILL(DUZ(2),ABM("BDFN"),1)

 . S ABM("IDFN")=$P(ABM(0),U,8)           ; Active Insurer IEN

 . S ABM("X1")="ABP1"

 . S ABM("P")=$P(ABM(0),U,5)              ; Patient IEN

 . S ABM("L")=$P(ABM(0),U,3)              ; Location IEN

 . S $P(ABM("X1"),U,2)=$P(^DPT(ABM("P"),0),U)  ; Patient name

 . S $P(ABM("X1"),U,23)=$P(^DPT(ABM("P"),0),U,9)

 . S $P(ABM("X1"),U,3)=$P(^AUTTLOC(ABM("L"),0),U,10)  ; ASU fac index

 . S ABM("HRN")=$S($D(^AUPNPAT(ABM("P"),41,ABM("L"),0)):$P(^(0),U,2),1:0)

 . I 'ABM("HRN"),$D(^AUTTSITE(1,0)),$D(^AUPNPAT(ABM("P"),41,+^(0),0)) S ABM("HRN")=$P(^(0),U,2)

 . S $P(ABM("X1"),U,4)=ABM("HRN")

 . S $P(ABM("X1"),U,5)=$P(^ABMDBILL(DUZ(2),ABM("BDFN"),7),U)

 . S ABMP("VDT")=$P(ABM("X1"),U,5)

 . S $P(ABM("X1"),U,6)=$S($P(ABM(0),U,7)=111:"I",$P(ABM(0),U,7)=998:"D",1:"O")

 . S $P(ABM("X1"),U,7)=$S($P(ABM(0),U,7)=111:$P(^ABMDBILL(DUZ(2),ABM("BDFN"),7),U,3),$P($G(^ABMDBILL(DUZ(2),ABM("BDFN"),6)),U,9)>0:$P(^(6),U,9),1:1)

 . S $P(ABM("X1"),U,8)=+$FN($P(^ABMDBILL(DUZ(2),ABM("BDFN"),2),U),"T",2)

 . S ABM("AMT")=ABM("AMT")+$P(ABM("X1"),U,8)

 . S $P(ABM("X1"),U,22)=$P(^ABMDBILL(DUZ(2),ABM("BDFN"),2),U,2)

 . K ABMV

 . S ABMP("PDFN")=ABM("P")

 . S ABMP("LDFN")=ABM("L")

 . S ABMP("VTYP")=$P(ABM(0),U,7)

 . S ABMP("BDFN")=ABM("BDFN")

 . S ABMP("GL")="^ABMDBILL(DUZ(2),"_ABM("BDFN")_","

 . S Y=ABM("IDFN")

 . S ABM("XIEN")=ABM("IDFN")

 . D SEL^ABMDE2X

 . I $D(ABMV("X1")) D

 . . S $P(ABM("X1"),U,11)=$P(ABMV("X1"),U,4)

 . . S $P(ABM("X1"),U,12)=$P($P(ABMV("X2"),U),";",2)

 . S $P(ABM("X1"),U,10)=$P(ABM(1),U,5)

 . S ABM("IDFN")=$P(ABM(0),U,8)

 . S:+$P(^AUTNINS(ABM("IDFN"),0),U,8) $P(ABM("X1"),U,9)=$P(^(0),U,8)

 . F ABM("I")=1:1:6 S $P(ABM("X1"),U,ABM("I")+12)=$P(^AUTNINS(ABM("IDFN"),0),U,ABM("I"))

 . S $P(ABM("X1"),U,19)=$P(^AUTNINS(ABM("IDFN"),0),U,9)

 . S ABM("X2")="ABP2"

 . I $D(^AUTNINS(ABM("IDFN"),1))=1 D

 . . S ABM(1)=^AUTNINS(ABM("IDFN"),1)

 . . F ABM("I")=1:1:5 S $P(ABM("X2"),U,ABM("I")+1)=$P(ABM(1),U,ABM("I"))

 . S $P(ABM("X1"),U,20)=$P(ABM(0),U)

 . S $P(ABM("X1"),U,21)=$S(ABM("REDO"):ABM("ADFN"),1:DT)

 . S ABM("CNT")=ABM("CNT")+1

 . S ^TMP($J,ABM("CNT"))=ABM("X1")

 . S:ABM("CNT")=1 (ABM("FDT"),ABM("EDT"))=$P(ABM("X1"),U,10)

 . S ABM("CNT")=ABM("CNT")+1

 . S ^TMP($J,ABM("CNT"))=ABM("X2")

 . I ABM("CNT")#4=0,'$D(ABMP("AUTO")) U IO(0) W $J((ABM("CNT")/2),8)

 . I $P(ABM("X1"),U,10)<ABM("FDT") S ABM("FDT")=$P(ABM("X1"),U,10)

 . I $P(ABM("X1"),U,10)>ABM("EDT") S ABM("EDT")=$P(ABM("X1"),U,10)

 . S ABM("LREC")=ABM("BDFN")

 Q

ABMDTX3   ; IHS/ASDST/DMJ - PT 4 OF CLAIM EXPORT PROGRAM ;

 +1       ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009

 +2       ;

 +3        SET (ABM("BDFN"),ABM("AMT"),ABM("CNT"))=0

 +4        FOR 

               SET ABM("BDFN")=$ORDER(^TMP("ABMDTX",$JOB,ABM("BDFN")))

               IF 'ABM("BDFN")

                   QUIT 

               Begin DoDot:1

 +5                IF '$DATA(^ABMDBILL(DUZ(2),ABM("BDFN"),0))

                       QUIT 

 +6                SET ABM(0)=^ABMDBILL(DUZ(2),ABM("BDFN"),0)

 +7                SET ABM(1)=^ABMDBILL(DUZ(2),ABM("BDFN"),1)

 +8       ; Active Insurer IEN

                   SET ABM("IDFN")=$PIECE(ABM(0),U,8)

 +9                SET ABM("X1")="ABP1"

 +10      ; Patient IEN

                   SET ABM("P")=$PIECE(ABM(0),U,5)

 +11      ; Location IEN

                   SET ABM("L")=$PIECE(ABM(0),U,3)

 +12      ; Patient name

                   SET $PIECE(ABM("X1"),U,2)=$PIECE(^DPT(ABM("P"),0),U)

 +13               SET $PIECE(ABM("X1"),U,23)=$PIECE(^DPT(ABM("P"),0),U,9)

 +14      ; ASU fac index

                   SET $PIECE(ABM("X1"),U,3)=$PIECE(^AUTTLOC(ABM("L"),0),U,10)

 +15               SET ABM("HRN")=$SELECT($DATA(^AUPNPAT(ABM("P"),41,ABM("L"),0)):$PIECE(^(0),U,2),1:0)

 +16               IF 'ABM("HRN")

                       IF $DATA(^AUTTSITE(1,0))

                           IF $DATA(^AUPNPAT(ABM("P"),41,+^(0),0))

                               SET ABM("HRN")=$PIECE(^(0),U,2)

 +17               SET $PIECE(ABM("X1"),U,4)=ABM("HRN")

 +18               SET $PIECE(ABM("X1"),U,5)=$PIECE(^ABMDBILL(DUZ(2),ABM("BDFN"),7),U)

 +19               SET ABMP("VDT")=$PIECE(ABM("X1"),U,5)

 +20               SET $PIECE(ABM("X1"),U,6)=$SELECT($PIECE(ABM(0),U,7)=111:"I",$PIECE(ABM(0),U,7)=998:"D",1:"O")

 +21               SET $PIECE(ABM("X1"),U,7)=$SELECT($PIECE(ABM(0),U,7)=111:$PIECE(^ABMDBILL(DUZ(2),ABM("BDFN"),7),U,3),$PIECE($GET(^ABMDBILL(DUZ(2),ABM("BDFN"),6)),U,9)>0:$PIECE(^(6),U,9),1:1)

 +22               SET $PIECE(ABM("X1"),U,8)=+$FNUMBER($PIECE(^ABMDBILL(DUZ(2),ABM("BDFN"),2),U),"T",2)

 +23               SET ABM("AMT")=ABM("AMT")+$PIECE(ABM("X1"),U,8)

 +24               SET $PIECE(ABM("X1"),U,22)=$PIECE(^ABMDBILL(DUZ(2),ABM("BDFN"),2),U,2)

 +25               KILL ABMV

 +26               SET ABMP("PDFN")=ABM("P")

 +27               SET ABMP("LDFN")=ABM("L")

 +28               SET ABMP("VTYP")=$PIECE(ABM(0),U,7)

 +29               SET ABMP("BDFN")=ABM("BDFN")

 +30               SET ABMP("GL")="^ABMDBILL(DUZ(2),"_ABM("BDFN")_","

 +31               SET Y=ABM("IDFN")

 +32               SET ABM("XIEN")=ABM("IDFN")

 +33               DO SEL^ABMDE2X

 +34               IF $DATA(ABMV("X1"))

                       Begin DoDot:2

 +35                       SET $PIECE(ABM("X1"),U,11)=$PIECE(ABMV("X1"),U,4)

 +36                       SET $PIECE(ABM("X1"),U,12)=$PIECE($PIECE(ABMV("X2"),U),";",2)

                       End DoDot:2

 +37               SET $PIECE(ABM("X1"),U,10)=$PIECE(ABM(1),U,5)

 +38               SET ABM("IDFN")=$PIECE(ABM(0),U,8)

 +39               IF +$PIECE(^AUTNINS(ABM("IDFN"),0),U,8)

                       SET $PIECE(ABM("X1"),U,9)=$PIECE(^(0),U,8)

 +40               FOR ABM("I")=1:1:6

                       SET $PIECE(ABM("X1"),U,ABM("I")+12)=$PIECE(^AUTNINS(ABM("IDFN"),0),U,ABM("I"))

 +41               SET $PIECE(ABM("X1"),U,19)=$PIECE(^AUTNINS(ABM("IDFN"),0),U,9)

 +42               SET ABM("X2")="ABP2"

 +43               IF $DATA(^AUTNINS(ABM("IDFN"),1))=1

                       Begin DoDot:2

 +44                       SET ABM(1)=^AUTNINS(ABM("IDFN"),1)

 +45                       FOR ABM("I")=1:1:5

                               SET $PIECE(ABM("X2"),U,ABM("I")+1)=$PIECE(ABM(1),U,ABM("I"))

                       End DoDot:2

 +46               SET $PIECE(ABM("X1"),U,20)=$PIECE(ABM(0),U)

 +47               SET $PIECE(ABM("X1"),U,21)=$SELECT(ABM("REDO"):ABM("ADFN"),1:DT)

 +48               SET ABM("CNT")=ABM("CNT")+1

 +49               SET ^TMP($JOB,ABM("CNT"))=ABM("X1")

 +50               IF ABM("CNT")=1

                       SET (ABM("FDT"),ABM("EDT"))=$PIECE(ABM("X1"),U,10)

 +51               SET ABM("CNT")=ABM("CNT")+1

 +52               SET ^TMP($JOB,ABM("CNT"))=ABM("X2")

 +53               IF ABM("CNT")#4=0

                       IF '$DATA(ABMP("AUTO"))

                           USE IO(0)

                           WRITE $JUSTIFY((ABM("CNT")/2),8)

 +54               IF $PIECE(ABM("X1"),U,10)<ABM("FDT")

                       SET ABM("FDT")=$PIECE(ABM("X1"),U,10)

 +55               IF $PIECE(ABM("X1"),U,10)>ABM("EDT")

                       SET ABM("EDT")=$PIECE(ABM("X1"),U,10)

 +56               SET ABM("LREC")=ABM("BDFN")

               End DoDot:1

 +57       QUIT