ABMDRST ; IHS/ASDST/DMJ - Statistical Report ;
;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
;Original;TMD;
; P-1=VISIT CNT, P-2=UNDUP CNT, P-3=$BILLED, P-4=$PAID
K ABM,ABMY
S ABM("RTYP")=0,ABM("PAY")=""
D ^ABMDRSEL G XIT:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
S ABM("HD",0)="STATISTICAL REPORT" D ^ABMDRHD
S ABMQ("RC")="COMPUTE^ABMDRST",ABMQ("RX")="POUT^ABMDRUTL",ABMQ("NS")="ABM",ABMQ("RP")="PRINT^ABMDRST1"
D ^ABMDRDBQ
Q
;
COMPUTE ;EP - Entry Point for Setting up Data
S ABMP("RTN")="ABMDRST"
S ABMDUZ2=DUZ(2)
S DUZ(2)=0
F S DUZ(2)=$O(^ABMDBILL(DUZ(2))) Q:'DUZ(2) D
.K ^TMP($J,"ABM-ST")
.K ^TMP($J,"ABM-B")
.S (ABM("NLN"),ABM("NLC"),ABM("NLB"),ABM("NLP"))=0
.D LOOP^ABMDRUTL
S DUZ(2)=ABMDUZ2
Q
;
DATA ;
NEW ABMREC,ABMSTAT,ABMTYP
S ABMREC=$G(^ABMDBILL(DUZ(2),ABM,0)) ;MOVE BILL FILE TO ABMREC
S ABMSTAT=$P(ABMREC,U,4) ;SET BILL STATUS FRM BILL FILE TO ABMSTAT
S ABMTYP=$P(ABMREC,U,7) ;SET VISIT TYPE FROM BILL FILE TO ABMTYP
Q:ABMSTAT="X" ;QUIT IF BILL STATUS IS EQUAL TO X
S ABMP("HIT")=0 D ^ABMDRCHK Q:'ABMP("HIT")
I ABMY("SORT")="C" S ABM("V")=ABM("C")
S ABM("PT")=$P(^ABMDBILL(DUZ(2),ABM,0),U,5)
S:'$D(ABM("LC",ABM("L"))) ABM("LC",ABM("L"))=0
I '$D(ABM(ABM("L"),ABM("V"))) D
.S ABM(ABM("L"),ABM("V"))="0^0^0^0"
;Next line counts # undup pats
I '$D(^TMP($J,"ABM-ST",ABM("L"),ABM("V"),ABM("PT"))) D
.S ^TMP($J,"ABM-ST",ABM("L"),ABM("V"),ABM("PT"))=""
.S $P(ABM(ABM("L"),ABM("V")),U,2)=$P(ABM(ABM("L"),ABM("V")),U,2)+1
; NEXT 5 LINES ADDING PAID AMOUNTS
S ABM("P")=0
F S ABM("P")=$O(^ABMDBILL(DUZ(2),ABM,3,ABM("P"))) Q:'ABM("P") D
.S ABM("PDD")=+^ABMDBILL(DUZ(2),ABM,3,ABM("P"),0)
.I $G(ABMY("DT"))="P",ABM("PDD")<ABMY("DT",1)!(ABM("PDD")>ABMY("DT",2)) Q
.S $P(ABM(ABM("L"),ABM("V")),U,4)=$P(ABM(ABM("L"),ABM("V")),U,4)+$P(^ABMDBILL(DUZ(2),ABM,3,ABM("P"),0),U,2)
; NEXT 3 LINES COUNT TOTAL NUMBER OF UNDUP PATIENTS
I '$D(^TMP($J,"ABM-ST",ABM("L"),ABM("PT"))) DO
.S ^TMP($J,"ABM-ST",ABM("L"),ABM("PT"))=""
.S ABM("LC",ABM("L"))=ABM("LC",ABM("L"))+1
I '$D(^TMP($J,"ABM-ST",ABM("PT"))) DO
.S ^TMP($J,"ABM-ST",ABM("PT"))=""
.S ABM("NLC")=ABM("NLC")+1
; NEXT 3 LINES CHECKS FOR FIRST VALID BILL
SET ABMBILL=+ABMREC ;SET BILL WITHOUT NUMBER
Q:$D(^TMP($J,"ABM-B",ABMBILL)) ;CK IF IS FOUND
SET ^TMP($J,"ABM-B",ABMBILL)="" ;CK IF TMP IS UNIQUE USING ABM-B
; NEXT LINE COUNTS # OF VISITS
S $P(ABM(ABM("L"),ABM("V")),U)=$P(ABM(ABM("L"),ABM("V")),U)+1
;Next line is adding billed amount
S $P(ABM(ABM("L"),ABM("V")),U,3)=$P(ABM(ABM("L"),ABM("V")),U,3)+$P(^ABMDBILL(DUZ(2),ABM,2),U,3)
I ABMTYP=111 D ;CK IF NOT EQUAL TO OUTPATIENT-NEED ONLY INPATIENTS
.S ABM(ABM("L"),"COVD")=$G(ABM(ABM("L"),"COVD"))+$P(^ABMDBILL(DUZ(2),ABM,7),U,3)
Q
;
XIT K ABM,ABMY,ABMP
Q
ABMDRST ; IHS/ASDST/DMJ - Statistical Report ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
+2 ;Original;TMD;
+3 ; P-1=VISIT CNT, P-2=UNDUP CNT, P-3=$BILLED, P-4=$PAID
+4 KILL ABM,ABMY
+5 SET ABM("RTYP")=0
SET ABM("PAY")=""
+6 DO ^ABMDRSEL
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
GOTO XIT
+7 SET ABM("HD",0)="STATISTICAL REPORT"
DO ^ABMDRHD
+8 SET ABMQ("RC")="COMPUTE^ABMDRST"
SET ABMQ("RX")="POUT^ABMDRUTL"
SET ABMQ("NS")="ABM"
SET ABMQ("RP")="PRINT^ABMDRST1"
+9 DO ^ABMDRDBQ
+10 QUIT
+11 ;
COMPUTE ;EP - Entry Point for Setting up Data
+1 SET ABMP("RTN")="ABMDRST"
+2 SET ABMDUZ2=DUZ(2)
+3 SET DUZ(2)=0
+4 FOR
SET DUZ(2)=$ORDER(^ABMDBILL(DUZ(2)))
IF 'DUZ(2)
QUIT
Begin DoDot:1
+5 KILL ^TMP($JOB,"ABM-ST")
+6 KILL ^TMP($JOB,"ABM-B")
+7 SET (ABM("NLN"),ABM("NLC"),ABM("NLB"),ABM("NLP"))=0
+8 DO LOOP^ABMDRUTL
End DoDot:1
+9 SET DUZ(2)=ABMDUZ2
+10 QUIT
+11 ;
DATA ;
+1 NEW ABMREC,ABMSTAT,ABMTYP
+2 ;MOVE BILL FILE TO ABMREC
SET ABMREC=$GET(^ABMDBILL(DUZ(2),ABM,0))
+3 ;SET BILL STATUS FRM BILL FILE TO ABMSTAT
SET ABMSTAT=$PIECE(ABMREC,U,4)
+4 ;SET VISIT TYPE FROM BILL FILE TO ABMTYP
SET ABMTYP=$PIECE(ABMREC,U,7)
+5 ;QUIT IF BILL STATUS IS EQUAL TO X
IF ABMSTAT="X"
QUIT
+6 SET ABMP("HIT")=0
DO ^ABMDRCHK
IF 'ABMP("HIT")
QUIT
+7 IF ABMY("SORT")="C"
SET ABM("V")=ABM("C")
+8 SET ABM("PT")=$PIECE(^ABMDBILL(DUZ(2),ABM,0),U,5)
+9 IF '$DATA(ABM("LC",ABM("L")))
SET ABM("LC",ABM("L"))=0
+10 IF '$DATA(ABM(ABM("L"),ABM("V")))
Begin DoDot:1
+11 SET ABM(ABM("L"),ABM("V"))="0^0^0^0"
End DoDot:1
+12 ;Next line counts # undup pats
+13 IF '$DATA(^TMP($JOB,"ABM-ST",ABM("L"),ABM("V"),ABM("PT")))
Begin DoDot:1
+14 SET ^TMP($JOB,"ABM-ST",ABM("L"),ABM("V"),ABM("PT"))=""
+15 SET $PIECE(ABM(ABM("L"),ABM("V")),U,2)=$PIECE(ABM(ABM("L"),ABM("V")),U,2)+1
End DoDot:1
+16 ; NEXT 5 LINES ADDING PAID AMOUNTS
+17 SET ABM("P")=0
+18 FOR
SET ABM("P")=$ORDER(^ABMDBILL(DUZ(2),ABM,3,ABM("P")))
IF 'ABM("P")
QUIT
Begin DoDot:1
+19 SET ABM("PDD")=+^ABMDBILL(DUZ(2),ABM,3,ABM("P"),0)
+20 IF $GET(ABMY("DT"))="P"
IF ABM("PDD")<ABMY("DT",1)!(ABM("PDD")>ABMY("DT",2))
QUIT
+21 SET $PIECE(ABM(ABM("L"),ABM("V")),U,4)=$PIECE(ABM(ABM("L"),ABM("V")),U,4)+$PIECE(^ABMDBILL(DUZ(2),ABM,3,ABM("P"),0),U,2)
End DoDot:1
+22 ; NEXT 3 LINES COUNT TOTAL NUMBER OF UNDUP PATIENTS
+23 IF '$DATA(^TMP($JOB,"ABM-ST",ABM("L"),ABM("PT")))
Begin DoDot:1
+24 SET ^TMP($JOB,"ABM-ST",ABM("L"),ABM("PT"))=""
+25 SET ABM("LC",ABM("L"))=ABM("LC",ABM("L"))+1
End DoDot:1
+26 IF '$DATA(^TMP($JOB,"ABM-ST",ABM("PT")))
Begin DoDot:1
+27 SET ^TMP($JOB,"ABM-ST",ABM("PT"))=""
+28 SET ABM("NLC")=ABM("NLC")+1
End DoDot:1
+29 ; NEXT 3 LINES CHECKS FOR FIRST VALID BILL
+30 ;SET BILL WITHOUT NUMBER
SET ABMBILL=+ABMREC
+31 ;CK IF IS FOUND
IF $DATA(^TMP($JOB,"ABM-B",ABMBILL))
QUIT
+32 ;CK IF TMP IS UNIQUE USING ABM-B
SET ^TMP($JOB,"ABM-B",ABMBILL)=""
+33 ; NEXT LINE COUNTS # OF VISITS
+34 SET $PIECE(ABM(ABM("L"),ABM("V")),U)=$PIECE(ABM(ABM("L"),ABM("V")),U)+1
+35 ;Next line is adding billed amount
+36 SET $PIECE(ABM(ABM("L"),ABM("V")),U,3)=$PIECE(ABM(ABM("L"),ABM("V")),U,3)+$PIECE(^ABMDBILL(DUZ(2),ABM,2),U,3)
+37 ;CK IF NOT EQUAL TO OUTPATIENT-NEED ONLY INPATIENTS
IF ABMTYP=111
Begin DoDot:1
+38 SET ABM(ABM("L"),"COVD")=$GET(ABM(ABM("L"),"COVD"))+$PIECE(^ABMDBILL(DUZ(2),ABM,7),U,3)
End DoDot:1
+39 QUIT
+40 ;
XIT KILL ABM,ABMY,ABMP
+1 QUIT
