ABPAARHD.m

ABPAARHD ;UTILIZATION REPORT HEADER; [ 03/17/91  8:48 AM ]

 ;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991

START D ^%AUCLS S X=0,SITENAME=$P(^DIC(4,DUZ(2),0),"^",1)

NXTX S X=$O(ABPA("HD",X)) G:+X=0 MOVE

 S AU("MAX")=X G NXTX

MOVE F I=AU("MAX"):-1:1 S ABPA("HD",I+2)=ABPA("HD",I)

WRITE S ABPA("HD",1)=SITENAME,$P(AU("LINE"),"-",$L(SITENAME)+1)=""

 S ABPA("HD",2)=AU("LINE"),AU("MAX")=AU("MAX")+2

 S XX="",$P(XX,"*",132)=""

 D NOW^%DTC S Y=% X ^DD("DD") S RUNTM=$P(Y,"@",2)

 S RUNDT=+%I(1)_"/"_+%I(2)_"/"_+$E(+%I(3),2,3)_" AT "_RUNTM

 S ABPAPG=ABPAPG+1 S PG="PAGE: "_ABPAPG

 W "RUN DATE: ",RUNDT

 S X="(Task number: "_ZTSK_")" W ?(66-(($L(X)/2))),X

 W ?(131-($L(PG))),PG,!,XX

 F I=1:1:AU("MAX") W !,"*",?66-(($L(ABPA("HD",I))/2)),ABPA("HD",I),?130,"*"

 W !,XX I PART2 W !! G L7A

SUBHD W !!!?63,"CLAIMS ISSUED",!?33 F I=1:1:71 W "="

 W !?41,"INPATIENT",?68,"OUTPATIENT",?92,"TOTAL",?113,"COLLECTIONS",!

 D SUBHD2

 W !?34,"UNDUP   DAYS/",?61,"UNDUP",?68,"VISITS/",?87,"UNDUP",?106,"DAYS/"

 W ?113,"VISITS/",?123,"TOTAL",!?34,"PERS.   DISCH    DOLLARS   "

 W "PERS.  CLAIMS    DOLLARS  PERS.     DOLLARS  DISCH  CLAIMS    DOLLARS"

L7 W !,"FACILITY",?34,"SRVD.   BILL.    BILLED    SRVD.  "

 W "BILLED    BILLED   SRVD.     BILLED   COLL.  COLL.     COLLECTED",!

 D SUBHD2 W !

 K X,Y,I,AU("MAX"),SITENAME,XX,AU("LINE"),RUNDT,RUNTM,PG

 F I=3:1 Q:$D(ABPA("HD",I))=0  D  K ABPA("HD",I)

 .S ABPA("HD",(I-2))=ABPA("HD",I)

QUIT Q

L7A W !?102,"DOLLARS",!?20,"FACILITY",?102,"COLLECTED"

 W !?20 F I=1:1:40 W "="

 W ?99 F I=1:1:12 W "="

 W ! Q

 ;

SUBHD2 F I=1:1:31 W "="

 W "  " F I=1:1:25 W "="

 W "   " F I=1:1:24 W "="

 W "  " F I=1:1:17 W "="

 W "  " F I=1:1:26 W "="

 Q

ABPAARHD  ;UTILIZATION REPORT HEADER; [ 03/17/91  8:48 AM ]

 +1       ;;1.4;AO PVT-INS TRACKING;*0*;IHS-OKC/KJR;JULY 25, 1991

START      DO ^%AUCLS

           SET X=0

           SET SITENAME=$PIECE(^DIC(4,DUZ(2),0),"^",1)

NXTX       SET X=$ORDER(ABPA("HD",X))

           IF +X=0

               GOTO MOVE

 +1        SET AU("MAX")=X

           GOTO NXTX

MOVE       FOR I=AU("MAX"):-1:1

               SET ABPA("HD",I+2)=ABPA("HD",I)

WRITE      SET ABPA("HD",1)=SITENAME

           SET $PIECE(AU("LINE"),"-",$LENGTH(SITENAME)+1)=""

 +1        SET ABPA("HD",2)=AU("LINE")

           SET AU("MAX")=AU("MAX")+2

 +2        SET XX=""

           SET $PIECE(XX,"*",132)=""

 +3        DO NOW^%DTC

           SET Y=%

           XECUTE ^DD("DD")

           SET RUNTM=$PIECE(Y,"@",2)

 +4        SET RUNDT=+%I(1)_"/"_+%I(2)_"/"_+$EXTRACT(+%I(3),2,3)_" AT "_RUNTM

 +5        SET ABPAPG=ABPAPG+1

           SET PG="PAGE: "_ABPAPG

 +6        WRITE "RUN DATE: ",RUNDT

 +7        SET X="(Task number: "_ZTSK_")"

           WRITE ?(66-(($LENGTH(X)/2))),X

 +8        WRITE ?(131-($LENGTH(PG))),PG,!,XX

 +9        FOR I=1:1:AU("MAX")

               WRITE !,"*",?66-(($LENGTH(ABPA("HD",I))/2)),ABPA("HD",I),?130,"*"

 +10       WRITE !,XX

           IF PART2

               WRITE !!

               GOTO L7A

SUBHD      WRITE !!!?63,"CLAIMS ISSUED",!?33

           FOR I=1:1:71

               WRITE "="

 +1        WRITE !?41,"INPATIENT",?68,"OUTPATIENT",?92,"TOTAL",?113,"COLLECTIONS",!

 +2        DO SUBHD2

 +3        WRITE !?34,"UNDUP   DAYS/",?61,"UNDUP",?68,"VISITS/",?87,"UNDUP",?106,"DAYS/"

 +4        WRITE ?113,"VISITS/",?123,"TOTAL",!?34,"PERS.   DISCH    DOLLARS   "

 +5        WRITE "PERS.  CLAIMS    DOLLARS  PERS.     DOLLARS  DISCH  CLAIMS    DOLLARS"

L7         WRITE !,"FACILITY",?34,"SRVD.   BILL.    BILLED    SRVD.  "

 +1        WRITE "BILLED    BILLED   SRVD.     BILLED   COLL.  COLL.     COLLECTED",!

 +2        DO SUBHD2

           WRITE !

 +3        KILL X,Y,I,AU("MAX"),SITENAME,XX,AU("LINE"),RUNDT,RUNTM,PG

 +4        FOR I=3:1

               IF $DATA(ABPA("HD",I))=0

                   QUIT 

               Begin DoDot:1

 +5                SET ABPA("HD",(I-2))=ABPA("HD",I)

               End DoDot:1

               KILL ABPA("HD",I)

QUIT       QUIT 

L7A        WRITE !?102,"DOLLARS",!?20,"FACILITY",?102,"COLLECTED"

 +1        WRITE !?20

           FOR I=1:1:40

               WRITE "="

 +2        WRITE ?99

           FOR I=1:1:12

               WRITE "="

 +3        WRITE !

           QUIT 

 +4       ;

SUBHD2     FOR I=1:1:31

               WRITE "="

 +1        WRITE "  "

           FOR I=1:1:25

               WRITE "="

 +2        WRITE "   "

           FOR I=1:1:24

               WRITE "="

 +3        WRITE "  "

           FOR I=1:1:17

               WRITE "="

 +4        WRITE "  "

           FOR I=1:1:26

               WRITE "="

 +5        QUIT