ABMDRST1 ; IHS/ASDST/DMJ - Statistical Report - Part 3 ;
;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
;Original;TMD;
;
; IHS/ASDS/LSL - 03/19/2001 - V2.4 Patch 9 - NOIS XXX-0301-200059
; Modified code to accomodate deleted visit type 141.
; "DELETED 141" will appear in this instance.
;
; *********************************************************************
;
PRINT ;EP for writing data
S ABM("PG")=0
D HDB S ABM("L")="" F ABM("NL")=1:1 S ABM("L")=$O(ABM(ABM("L"))) Q:'ABM("L") D G XIT:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
.I $Y>(IOSL-7) D HD Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
.W !!,$P(^DIC(4,ABM("L"),0),U)
.S (ABM("N"),ABM("B"),ABM("P"))=0
.S ABM("V")="" F S ABM("V")=$O(ABM(ABM("L"),ABM("V"))) Q:'ABM("V") D G XIT:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
..I $Y>(IOSL-6) D HD Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT) W !,$P(^DIC(4,ABM("L"),0),U)," (cont)"
..;Nest line prints visit type
..W !?3
..I ABMY("SORT")="V" D
...I $P($G(^ABMDVTYP(ABM("V"),0)),U)]"" W $E($P(^ABMDVTYP(ABM("V"),0),U),1,15) Q
...W "DELETED ",ABM("V")
..E W $E($P(^DIC(40.7,ABM("V"),0),U),1,15)
..W ?22,$J($FN($P(ABM(ABM("L"),ABM("V")),U),",",0),5),?30,$J($FN($P(ABM(ABM("L"),ABM("V")),U,2),",",0),5)
..;Next line writes $ with comma and cents
..W ?37,$J($FN($P(ABM(ABM("L"),ABM("V")),U,3),",",2),13)
..W ?50,$J($FN($P(ABM(ABM("L"),ABM("V")),U,4),",",2),13)
..W ?66,$J($FN(($P(ABM(ABM("L"),ABM("V")),U,3)-$P(ABM(ABM("L"),ABM("V")),U,4)),",",2),13)
..S ABM("N")=$P(ABM(ABM("L"),ABM("V")),U,1)+ABM("N"),ABM("NLN")=ABM("NLN")+$P(ABM(ABM("L"),ABM("V")),U,1)
..S ABM("B")=$P(ABM(ABM("L"),ABM("V")),U,3)+ABM("B"),ABM("NLB")=ABM("NLB")+$P(ABM(ABM("L"),ABM("V")),U,3)
..S ABM("P")=$P(ABM(ABM("L"),ABM("V")),U,4)+ABM("P"),ABM("NLP")=ABM("NLP")+$P(ABM(ABM("L"),ABM("V")),U,4)
.W !,?22,"------",?30,"------",?40,"----------",?53,"----------",?69,"----------"
.W !?22,$J($FN(ABM("N"),",",0),5)
.W ?30,$J($FN(ABM("LC",ABM("L")),",",0),5)
.W ?37,$J($FN(ABM("B"),",",2),13)
.W ?50,$J($FN(ABM("P"),",",2),13)
.W ?66,$J($FN(ABM("B")-ABM("P"),",",2),13)
.;PRINT INPATIENT DAYS - WILL PRINT 0 DAYS ALSO
.W !!
.W "TOTAL COVERED INPATIENT DAYS ",+$GET(ABM(ABM("L"),"COVD"))
.W !
I ABM("NL")<3 G XIT
W !,?22,"======",?30,"======",?40,"==========",?53,"==========",?69,"=========="
;TOOK OUT TOTAL UNDUP CNT 2/98 SL
W !?10,"Total:",?22,$J($FN(ABM("NLN"),",",0),5)
W ?37,$J($FN(ABM("NLB"),",",2),13)
W ?50,$J($FN(ABM("NLP"),",",2),13)
W ?66,$J($FN(ABM("NLB")-ABM("NLP"),",",2),13)
G XIT
;
HD D PAZ^ABMDRUTL Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
HDB S ABM("PG")=ABM("PG")+1,ABM("I")="" D WHD^ABMDRHD
W !!?3,$S(ABMY("SORT")="V":"VISIT",1:""),?22,"NUMBER",?32,"UNDUP",?44,"BILLED",?58,"PAID",?72,"UNPAID"
W !?3,$S(ABMY("SORT")="V":"TYPE",1:"CLINIC"),?22,"VISITS",?32,"PATIENTS",?44,"AMOUNT",?57,"AMOUNT",?72,"AMOUNT"
W !,"-------------------------------------------------------------------------------"
Q
;
XIT K ^TMP($J,"ABM-ST")
Q
ABMDRST1 ; IHS/ASDST/DMJ - Statistical Report - Part 3 ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
+2 ;Original;TMD;
+3 ;
+4 ; IHS/ASDS/LSL - 03/19/2001 - V2.4 Patch 9 - NOIS XXX-0301-200059
+5 ; Modified code to accomodate deleted visit type 141.
+6 ; "DELETED 141" will appear in this instance.
+7 ;
+8 ; *********************************************************************
+9 ;
PRINT ;EP for writing data
+1 SET ABM("PG")=0
+2 DO HDB
SET ABM("L")=""
FOR ABM("NL")=1:1
SET ABM("L")=$ORDER(ABM(ABM("L")))
IF 'ABM("L")
QUIT
Begin DoDot:1
+3 IF $Y>(IOSL-7)
DO HD
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
+4 WRITE !!,$PIECE(^DIC(4,ABM("L"),0),U)
+5 SET (ABM("N"),ABM("B"),ABM("P"))=0
+6 SET ABM("V")=""
FOR
SET ABM("V")=$ORDER(ABM(ABM("L"),ABM("V")))
IF 'ABM("V")
QUIT
Begin DoDot:2
+7 IF $Y>(IOSL-6)
DO HD
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
WRITE !,$PIECE(^DIC(4,ABM("L"),0),U)," (cont)"
+8 ;Nest line prints visit type
+9 WRITE !?3
+10 IF ABMY("SORT")="V"
Begin DoDot:3
+11 IF $PIECE($GET(^ABMDVTYP(ABM("V"),0)),U)]""
WRITE $EXTRACT($PIECE(^ABMDVTYP(ABM("V"),0),U),1,15)
QUIT
+12 WRITE "DELETED ",ABM("V")
End DoDot:3
+13 IF '$TEST
WRITE $EXTRACT($PIECE(^DIC(40.7,ABM("V"),0),U),1,15)
+14 WRITE ?22,$JUSTIFY($FNUMBER($PIECE(ABM(ABM("L"),ABM("V")),U),",",0),5),?30,$JUSTIFY($FNUMBER($PIECE(ABM(ABM("L"),ABM("V")),U,2),",",0),5)
+15 ;Next line writes $ with comma and cents
+16 WRITE ?37,$JUSTIFY($FNUMBER($PIECE(ABM(ABM("L"),ABM("V")),U,3),",",2),13)
+17 WRITE ?50,$JUSTIFY($FNUMBER($PIECE(ABM(ABM("L"),ABM("V")),U,4),",",2),13)
+18 WRITE ?66,$JUSTIFY($FNUMBER(($PIECE(ABM(ABM("L"),ABM("V")),U,3)-$PIECE(ABM(ABM("L"),ABM("V")),U,4)),",",2),13)
+19 SET ABM("N")=$PIECE(ABM(ABM("L"),ABM("V")),U,1)+ABM("N")
SET ABM("NLN")=ABM("NLN")+$PIECE(ABM(ABM("L"),ABM("V")),U,1)
+20 SET ABM("B")=$PIECE(ABM(ABM("L"),ABM("V")),U,3)+ABM("B")
SET ABM("NLB")=ABM("NLB")+$PIECE(ABM(ABM("L"),ABM("V")),U,3)
+21 SET ABM("P")=$PIECE(ABM(ABM("L"),ABM("V")),U,4)+ABM("P")
SET ABM("NLP")=ABM("NLP")+$PIECE(ABM(ABM("L"),ABM("V")),U,4)
End DoDot:2
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
GOTO XIT
+22 WRITE !,?22,"------",?30,"------",?40,"----------",?53,"----------",?69,"----------"
+23 WRITE !?22,$JUSTIFY($FNUMBER(ABM("N"),",",0),5)
+24 WRITE ?30,$JUSTIFY($FNUMBER(ABM("LC",ABM("L")),",",0),5)
+25 WRITE ?37,$JUSTIFY($FNUMBER(ABM("B"),",",2),13)
+26 WRITE ?50,$JUSTIFY($FNUMBER(ABM("P"),",",2),13)
+27 WRITE ?66,$JUSTIFY($FNUMBER(ABM("B")-ABM("P"),",",2),13)
+28 ;PRINT INPATIENT DAYS - WILL PRINT 0 DAYS ALSO
+29 WRITE !!
+30 WRITE "TOTAL COVERED INPATIENT DAYS ",+$GET(ABM(ABM("L"),"COVD"))
+31 WRITE !
End DoDot:1
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
GOTO XIT
+32 IF ABM("NL")<3
GOTO XIT
+33 WRITE !,?22,"======",?30,"======",?40,"==========",?53,"==========",?69,"=========="
+34 ;TOOK OUT TOTAL UNDUP CNT 2/98 SL
+35 WRITE !?10,"Total:",?22,$JUSTIFY($FNUMBER(ABM("NLN"),",",0),5)
+36 WRITE ?37,$JUSTIFY($FNUMBER(ABM("NLB"),",",2),13)
+37 WRITE ?50,$JUSTIFY($FNUMBER(ABM("NLP"),",",2),13)
+38 WRITE ?66,$JUSTIFY($FNUMBER(ABM("NLB")-ABM("NLP"),",",2),13)
+39 GOTO XIT
+40 ;
HD DO PAZ^ABMDRUTL
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
HDB SET ABM("PG")=ABM("PG")+1
SET ABM("I")=""
DO WHD^ABMDRHD
+1 WRITE !!?3,$SELECT(ABMY("SORT")="V":"VISIT",1:""),?22,"NUMBER",?32,"UNDUP",?44,"BILLED",?58,"PAID",?72,"UNPAID"
+2 WRITE !?3,$SELECT(ABMY("SORT")="V":"TYPE",1:"CLINIC"),?22,"VISITS",?32,"PATIENTS",?44,"AMOUNT",?57,"AMOUNT",?72,"AMOUNT"
+3 WRITE !,"-------------------------------------------------------------------------------"
+4 QUIT
+5 ;
XIT KILL ^TMP($JOB,"ABM-ST")
+1 QUIT
