- 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
