- ABMDTX0 ; IHS/ASDST/DMJ - EXPORT BILLS FROM FACILITY ;
- ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
- ;
- DATA ; EP
- K ^TMP("ABMDTX",$J) S Y=DT X ^DD("DD") S ^TMP("ABMDTX",$J,0)=Y
- S ABM("CNT")=0
- D REDO:ABM("REDO"),NEW:'ABM("REDO")
- Q
- ;--------------------------------------------------------------------
- NEW S ABM("BDFN")=0 F S ABM("BDFN")=$O(^ABMDBILL(DUZ(2),"AA","A",ABM("BDFN"))) Q:'ABM("BDFN") D BILL
- Q
- ;--------------------------------------------------------------------
- REDO S ABM("BDFN")=0 F S ABM("BDFN")=$O(^ABMDBILL(DUZ(2),"AZ",ABM("ADFN"),ABM("BDFN"))) Q:'ABM("BDFN") D BILL
- Q
- ;--------------------------------------------------------------------
- BILL Q:'$D(^ABMDBILL(DUZ(2),ABM("BDFN"),0)) S ABM(0)=^ABMDBILL(DUZ(2),ABM("BDFN"),0)
- I $P(ABM(0),U,4)="X" D Q ; If cancelled bill del export status & q
- . S DA=ABM("BDFN")
- . S DIE="^ABMDBILL(DUZ(2),"
- . S DR=".16///@"
- . D ^ABMDDIE
- . Q
- I $P($G(^ABMDBILL(DUZ(2),ABM("BDFN"),1)),U,7) S ^TMP("ABMDTX",$J,"EXP",$P(^(1),U,7))=""
- S ABM("ITYPES")=$P($G(^ABMDPARM(DUZ(2),1,3)),"^",5) S:ABM("ITYPES")="" ABM("ITYPES")="PHF"
- I ABM("ITYPES")'[$P($G(^AUTNINS($P(ABM(0),U,8),2)),U) G RSET
- S ABM("IDFN")=$P(ABM(0),U,8) D INSCHK
- S ABM("PNAME")=$P(^DPT($P(ABM(0),U,5),0),U)
- S ^TMP("ABMDTX",$J,"SORT",ABM("PNAME"),$P(ABM(0),U,3),ABM("BDFN"))=""
- S ^TMP("ABMDTX",$J,ABM("BDFN"))=""
- S ABM("CNT")=ABM("CNT")+1
- Q
- ;--------------------------------------------------------------------
- RSET ;SET STATUS FIELDS
- S DA=ABM("BDFN"),DIE="^ABMDBILL(DUZ(2),",DR=".16///@" D ^ABMDDIE
- Q:$P(^ABMDBILL(DUZ(2),ABM("BDFN"),0),"^",4)="C"
- S DR=".04////T" D ^ABMDDIE
- Q
- ;--------------------------------------------------------------------
- WRT ;EP for Printing Transmittal List
- D HEADER^ABMDTX1
- S (ABM("CT"),ABM("AMT"))=0
- S ABM("P")=0 F S ABM("P")=$O(^TMP("ABMDTX",$J,"SORT",ABM("P"))) Q:ABM("P")="" D
- .S ABM("L")=0 F S ABM("L")=$O(^TMP("ABMDTX",$J,"SORT",ABM("P"),ABM("L"))) Q:'ABM("L") D
- ..S ABM("BDFN")=0 F S ABM("BDFN")=$O(^TMP("ABMDTX",$J,"SORT",ABM("P"),ABM("L"),ABM("BDFN"))) Q:'ABM("BDFN") D
- ...S ABM(0)=^ABMDBILL(DUZ(2),ABM("BDFN"),0),ABM(1)=^(1),X=$P(ABM(1),U,5)
- ...W ?1,$$SDT^ABMDUTL(X)
- ...S ABM("PDFN")=$P(ABM(0),U,5)
- ...W ?12,$J($P(ABM(0),U),7),?20,$E(ABM("P"),1,30)
- ...S ABM("HRN")=$S($D(^AUPNPAT(ABM("PDFN"),41,ABM("L"),0)):$P(^(0),U,2),1:0) I 'ABM("HRN"),$D(^AUTTSITE(1,0)),$D(^AUPNPAT(ABM("PDFN"),41,+^(0),0)) S ABM("HRN")=$P(^(0),U,2)
- ...W ?52,$J(ABM("HRN"),6)
- ...S X=+^ABMDBILL(DUZ(2),ABM("BDFN"),7) W ?61,$$SDT^ABMDUTL(X)
- ...S ABM("IDFN")=$P(ABM(0),U,8)
- ...W ?73,$E($P(^AUTNINS(ABM("IDFN"),0),U),1,28)
- ...W ?103,$J($FN($P(^ABMDBILL(DUZ(2),ABM("BDFN"),2),U),",",2),8)
- ...S ABM("CT")=ABM("CT")+1,ABM("AMT")=ABM("AMT")+^ABMDBILL(DUZ(2),ABM("BDFN"),2)
- ...W ?113,$S($P(ABM(0),U,7)=111:"I",$P(ABM(0),U,7)=998:"D",1:"O")
- ...W ?117,$J($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),2),!
- ...I $Y+6>IOSL,$E(IOST,1)="P" D HEADER^ABMDTX1
- ...I $Y+3>IOSL,$E(IOST,1)="C" S DIR(0)="E" D ^DIR K DIR D HEADER^ABMDTX1
- ...I $Y+3>IOSL,$E(IOST,1)="C" D
- ....S DIR(0)="E" D ^DIR K DIR I 'Y S ABM("P")="ZZZ" Q
- ....D HEADER^ABMDTX1
- W ?5 F I=1:1:110 W "-"
- W !,?5,"TOTAL CLAIMS = ",ABM("CT"),?45,"TOTAL CLAIM AMT = ",?64,$J($FN(ABM("AMT"),",",2),8),!!
- S DIE="^ABMDAOTX(DUZ(2),",DA=ABM("ADFN"),DR=".02////"_ABM("CT")_";.04////"_ABM("AMT") D ^ABMDDIE
- Q
- ;--------------------------------------------------------------------
- INSCHK ;PROCEDURE TO INSPECT FOR COMPLETE INSURANCE RECORD
- S ABM("IERR")=0,ABM("ND")="" G NXTNODE
- IERR S ABM("IERR")=ABM("IERR")_1
- NXTNODE S ABM("ND")=$O(^AUTNINS(ABM("IDFN"),ABM("ND"))) G:(ABM("ND")="")!(+ABM("ND")>1) INSCHKC
- S ABM("I")=^AUTNINS(ABM("IDFN"),ABM("ND"))
- I ABM("ND")=1 I $P(ABM("I"),U)="",$P(ABM("I"),U,5)="" G NXTNODE
- G IERR:$L($P(ABM("I"),U,2))<2!($L($P(ABM("I"),U,3))<2)!(+$P(ABM("I"),U,4)<1)
- G IERR:'$D(^DIC(5,+$P(ABM("I"),U,4),0))
- I $L($P(ABM("I"),U,5))<5!($P(ABM("I"),U,5)'?5N.E) G IERR
- S ABM("IERR")=ABM("IERR")_0 G NXTNODE
- INSCHKC I ABM("IERR")="01"!(ABM("IERR")="010") S ^TMP("ABMDTX",$J,"INS-ERR",ABM("IDFN"))=""
- I ABM("IERR")="001"!(ABM("IERR")="011") S ^TMP("ABMDTX",$J,"INS-ERR",ABM("IDFN"))="*"
- Q
- ABMDTX0 ; IHS/ASDST/DMJ - EXPORT BILLS FROM FACILITY ;
- +1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
- +2 ;
- DATA ; EP
- +1 KILL ^TMP("ABMDTX",$JOB)
- SET Y=DT
- XECUTE ^DD("DD")
- SET ^TMP("ABMDTX",$JOB,0)=Y
- +2 SET ABM("CNT")=0
- +3 IF ABM("REDO")
- DO REDO
- IF 'ABM("REDO")
- DO NEW
- +4 QUIT
- +5 ;--------------------------------------------------------------------
- NEW SET ABM("BDFN")=0
- FOR
- SET ABM("BDFN")=$ORDER(^ABMDBILL(DUZ(2),"AA","A",ABM("BDFN")))
- IF 'ABM("BDFN")
- QUIT
- DO BILL
- +1 QUIT
- +2 ;--------------------------------------------------------------------
- REDO SET ABM("BDFN")=0
- FOR
- SET ABM("BDFN")=$ORDER(^ABMDBILL(DUZ(2),"AZ",ABM("ADFN"),ABM("BDFN")))
- IF 'ABM("BDFN")
- QUIT
- DO BILL
- +1 QUIT
- +2 ;--------------------------------------------------------------------
- BILL IF '$DATA(^ABMDBILL(DUZ(2),ABM("BDFN"),0))
- QUIT
- SET ABM(0)=^ABMDBILL(DUZ(2),ABM("BDFN"),0)
- +1 ; If cancelled bill del export status & q
- IF $PIECE(ABM(0),U,4)="X"
- Begin DoDot:1
- +2 SET DA=ABM("BDFN")
- +3 SET DIE="^ABMDBILL(DUZ(2),"
- +4 SET DR=".16///@"
- +5 DO ^ABMDDIE
- +6 QUIT
- End DoDot:1
- QUIT
- +7 IF $PIECE($GET(^ABMDBILL(DUZ(2),ABM("BDFN"),1)),U,7)
- SET ^TMP("ABMDTX",$JOB,"EXP",$PIECE(^(1),U,7))=""
- +8 SET ABM("ITYPES")=$PIECE($GET(^ABMDPARM(DUZ(2),1,3)),"^",5)
- IF ABM("ITYPES")=""
- SET ABM("ITYPES")="PHF"
- +9 IF ABM("ITYPES")'[$PIECE($GET(^AUTNINS($PIECE(ABM(0),U,8),2)),U)
- GOTO RSET
- +10 SET ABM("IDFN")=$PIECE(ABM(0),U,8)
- DO INSCHK
- +11 SET ABM("PNAME")=$PIECE(^DPT($PIECE(ABM(0),U,5),0),U)
- +12 SET ^TMP("ABMDTX",$JOB,"SORT",ABM("PNAME"),$PIECE(ABM(0),U,3),ABM("BDFN"))=""
- +13 SET ^TMP("ABMDTX",$JOB,ABM("BDFN"))=""
- +14 SET ABM("CNT")=ABM("CNT")+1
- +15 QUIT
- +16 ;--------------------------------------------------------------------
- RSET ;SET STATUS FIELDS
- +1 SET DA=ABM("BDFN")
- SET DIE="^ABMDBILL(DUZ(2),"
- SET DR=".16///@"
- DO ^ABMDDIE
- +2 IF $PIECE(^ABMDBILL(DUZ(2),ABM("BDFN"),0),"^",4)="C"
- QUIT
- +3 SET DR=".04////T"
- DO ^ABMDDIE
- +4 QUIT
- +5 ;--------------------------------------------------------------------
- WRT ;EP for Printing Transmittal List
- +1 DO HEADER^ABMDTX1
- +2 SET (ABM("CT"),ABM("AMT"))=0
- +3 SET ABM("P")=0
- FOR
- SET ABM("P")=$ORDER(^TMP("ABMDTX",$JOB,"SORT",ABM("P")))
- IF ABM("P")=""
- QUIT
- Begin DoDot:1
- +4 SET ABM("L")=0
- FOR
- SET ABM("L")=$ORDER(^TMP("ABMDTX",$JOB,"SORT",ABM("P"),ABM("L")))
- IF 'ABM("L")
- QUIT
- Begin DoDot:2
- +5 SET ABM("BDFN")=0
- FOR
- SET ABM("BDFN")=$ORDER(^TMP("ABMDTX",$JOB,"SORT",ABM("P"),ABM("L"),ABM("BDFN")))
- IF 'ABM("BDFN")
- QUIT
- Begin DoDot:3
- +6 SET ABM(0)=^ABMDBILL(DUZ(2),ABM("BDFN"),0)
- SET ABM(1)=^(1)
- SET X=$PIECE(ABM(1),U,5)
- +7 WRITE ?1,$$SDT^ABMDUTL(X)
- +8 SET ABM("PDFN")=$PIECE(ABM(0),U,5)
- +9 WRITE ?12,$JUSTIFY($PIECE(ABM(0),U),7),?20,$EXTRACT(ABM("P"),1,30)
- +10 SET ABM("HRN")=$SELECT($DATA(^AUPNPAT(ABM("PDFN"),41,ABM("L"),0)):$PIECE(^(0),U,2),1:0)
- IF 'ABM("HRN")
- IF $DATA(^AUTTSITE(1,0))
- IF $DATA(^AUPNPAT(ABM("PDFN"),41,+^(0),0))
- SET ABM("HRN")=$PIECE(^(0),U,2)
- +11 WRITE ?52,$JUSTIFY(ABM("HRN"),6)
- +12 SET X=+^ABMDBILL(DUZ(2),ABM("BDFN"),7)
- WRITE ?61,$$SDT^ABMDUTL(X)
- +13 SET ABM("IDFN")=$PIECE(ABM(0),U,8)
- +14 WRITE ?73,$EXTRACT($PIECE(^AUTNINS(ABM("IDFN"),0),U),1,28)
- +15 WRITE ?103,$JUSTIFY($FNUMBER($PIECE(^ABMDBILL(DUZ(2),ABM("BDFN"),2),U),",",2),8)
- +16 SET ABM("CT")=ABM("CT")+1
- SET ABM("AMT")=ABM("AMT")+^ABMDBILL(DUZ(2),ABM("BDFN"),2)
- +17 WRITE ?113,$SELECT($PIECE(ABM(0),U,7)=111:"I",$PIECE(ABM(0),U,7)=998:"D",1:"O")
- +18 WRITE ?117,$JUSTIFY($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),2),!
- +19 IF $Y+6>IOSL
- IF $EXTRACT(IOST,1)="P"
- DO HEADER^ABMDTX1
- +20 IF $Y+3>IOSL
- IF $EXTRACT(IOST,1)="C"
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- DO HEADER^ABMDTX1
- +21 IF $Y+3>IOSL
- IF $EXTRACT(IOST,1)="C"
- Begin DoDot:4
- +22 SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- IF 'Y
- SET ABM("P")="ZZZ"
- QUIT
- +23 DO HEADER^ABMDTX1
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +24 WRITE ?5
- FOR I=1:1:110
- WRITE "-"
- +25 WRITE !,?5,"TOTAL CLAIMS = ",ABM("CT"),?45,"TOTAL CLAIM AMT = ",?64,$JUSTIFY($FNUMBER(ABM("AMT"),",",2),8),!!
- +26 SET DIE="^ABMDAOTX(DUZ(2),"
- SET DA=ABM("ADFN")
- SET DR=".02////"_ABM("CT")_";.04////"_ABM("AMT")
- DO ^ABMDDIE
- +27 QUIT
- +28 ;--------------------------------------------------------------------
- INSCHK ;PROCEDURE TO INSPECT FOR COMPLETE INSURANCE RECORD
- +1 SET ABM("IERR")=0
- SET ABM("ND")=""
- GOTO NXTNODE
- IERR SET ABM("IERR")=ABM("IERR")_1
- NXTNODE SET ABM("ND")=$ORDER(^AUTNINS(ABM("IDFN"),ABM("ND")))
- IF (ABM("ND")="")!(+ABM("ND")>1)
- GOTO INSCHKC
- +1 SET ABM("I")=^AUTNINS(ABM("IDFN"),ABM("ND"))
- +2 IF ABM("ND")=1
- IF $PIECE(ABM("I"),U)=""
- IF $PIECE(ABM("I"),U,5)=""
- GOTO NXTNODE
- +3 IF $LENGTH($PIECE(ABM("I"),U,2))<2!($LENGTH($PIECE(ABM("I"),U,3))<2)!(+$PIECE(ABM("I"),U,4)<1)
- GOTO IERR
- +4 IF '$DATA(^DIC(5,+$PIECE(ABM("I"),U,4),0))
- GOTO IERR
- +5 IF $LENGTH($PIECE(ABM("I"),U,5))<5!($PIECE(ABM("I"),U,5)'?5N.E)
- GOTO IERR
- +6 SET ABM("IERR")=ABM("IERR")_0
- GOTO NXTNODE
- INSCHKC IF ABM("IERR")="01"!(ABM("IERR")="010")
- SET ^TMP("ABMDTX",$JOB,"INS-ERR",ABM("IDFN"))=""
- +1 IF ABM("IERR")="001"!(ABM("IERR")="011")
- SET ^TMP("ABMDTX",$JOB,"INS-ERR",ABM("IDFN"))="*"
- +2 QUIT
