ABMDRST.m

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