ABPAPCHD.m

ABPAPCHD ;PROCESSED CLAIM REPORTS HEADER; [ 05/23/91  1:41 PM ]

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

START 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_" - "_ABPATLE

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

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

 S XX="",$P(XX,"*",+IOM)=""

 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 @IOF

 W "RUN DATE: ",RUNDT S X="(Task #"_ZTNN_")"

 W ?((+IOM/2)-($L(X)/2)),X,?((+IOM-1)-($L(PG))),PG,!,XX

 F I=1:1:AU("MAX") D  W:I=AU("MAX") !,XX

 .W !,"*",?(+IOM/2)-(($L(ABPA("HD",I))/2)),ABPA("HD",I),?(+IOM-2),"*"

 I ABPA("RFMT")=1&('EOF) D

 .W !!,"PATIENT NAME",?36,"SSN",?52,"SUBSCRIBER NAME",?79,"DOS"

 .W ?87,"LOCATION OF SERVICE",?119,"CLAIM AMT"

 .W ! F I=1:1:(+IOM-1) W "="

 E  I 'EOF D

 .W !!?45,"Total",?57,"Total",!,"Insurance Company",?45,"Billed"

 .W ?57,"Payments",?70,"Write-off",! F I=1:1:(+IOM-1) W "="

 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

ABPAPCHD  ;PROCESSED CLAIM REPORTS HEADER; [ 05/23/91  1:41 PM ]

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

START      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_" - "_ABPATLE

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

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

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

 +3        SET XX=""

           SET $PIECE(XX,"*",+IOM)=""

 +4        DO NOW^%DTC

           SET Y=%

           XECUTE ^DD("DD")

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

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

 +6        SET ABPAPG=ABPAPG+1

           SET PG="PAGE: "_ABPAPG

           WRITE @IOF

 +7        WRITE "RUN DATE: ",RUNDT

           SET X="(Task #"_ZTNN_")"

 +8        WRITE ?((+IOM/2)-($LENGTH(X)/2)),X,?((+IOM-1)-($LENGTH(PG))),PG,!,XX

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

               Begin DoDot:1

 +10               WRITE !,"*",?(+IOM/2)-(($LENGTH(ABPA("HD",I))/2)),ABPA("HD",I),?(+IOM-2),"*"

               End DoDot:1

               IF I=AU("MAX")

                   WRITE !,XX

 +11       IF ABPA("RFMT")=1&('EOF)

               Begin DoDot:1

 +12               WRITE !!,"PATIENT NAME",?36,"SSN",?52,"SUBSCRIBER NAME",?79,"DOS"

 +13               WRITE ?87,"LOCATION OF SERVICE",?119,"CLAIM AMT"

 +14               WRITE !

                   FOR I=1:1:(+IOM-1)

                       WRITE "="

               End DoDot:1

 +15      IF '$TEST

               IF 'EOF

                   Begin DoDot:1

 +16                   WRITE !!?45,"Total",?57,"Total",!,"Insurance Company",?45,"Billed"

 +17                   WRITE ?57,"Payments",?70,"Write-off",!

                       FOR I=1:1:(+IOM-1)

                           WRITE "="

                   End DoDot:1

 +18       WRITE !

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

 +19       FOR I=3:1

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

                   QUIT 

               Begin DoDot:1

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

               End DoDot:1

               KILL ABPA("HD",I)

QUIT       QUIT