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
