- 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
