ABPAADR2.m

ABPAADR2 ;PRINT DISTRIBUTION REPORT; [ 03/24/91  1:42 PM ]

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

 W !!,"<<< NOT AN ENTRY POINT - ACCESS DENIED >>>",!! Q

COMMA D COMMA^%DTC Q

 ;

HEAD K ABPA("HD") S ABPA("HD",1)="R E P O R T   O F   P R I V A T E   "

 S ABPA("HD",1)=ABPA("HD",1)_"I N S U R A N C E   F U N D   "

 S ABPA("HD",1)=ABPA("HD",1)_"D I S T R I B U T I O N"

 S ABPA("HD",2)="for the period "_$E(BDT,4,5)_"/"_$E(BDT,6,7)_"/"

 S ABPA("HD",2)=ABPA("HD",2)_$E(BDT,2,3)_" to "_$E(EDT,4,5)_"/"

 S ABPA("HD",2)=ABPA("HD",2)_$E(EDT,6,7)_"/"_$E(EDT,2,3)

 D ^ABPAARHD Q

 ;

FC S FC=0 F T=1:1:15 S @("T"_T)=0

 S TABLST="32^39^47^57^66^74^93^103^112^100^82^39^105^66^112"

 S WDLST="6^6^12^6^6^12^12^6^6^12^5^6^6^6^6"

NXTFC S FC=$O(^%ZTSK(ZTSK,"SITE",FC)) G SUM:FC="" S DATA=^%ZTSK(ZTSK,FC)

 I ($P(DATA,"^",10)=0) G NXTFC

 D:$Y>55 HEAD W !?20,FC

 F P=1:1:15 S @("P"_P)=$P(DATA,"^",P),@("T"_P)=@("T"_P)+@("P"_P)

 S P=10 D

 .S TAB=$P(TABLST,"^",P),TAB="?"_TAB,WD=$P(WDLST,"^",P)

 .S X=@("P"_P) D COMMA F I=1:1:12 Q:$E(X,I)'=" "

 .W @TAB,$J(X,WD),!

 G NXTFC

 ;

SUM F I=1:1:132 W "-"

 W !?63,"D I S T R I B U T E D   T O T A L"

 S T=10 D

 .S TAB=$P(TABLST,"^",T),TAB="?"_TAB,WD=$P(WDLST,"^",T)

 .S X=@("T"_T) D COMMA F I=1:1:12 Q:$E(X,I)'=" "

 .S X=$E(X,I,12)

 .W @TAB,$J(X,WD),!?99 F I=1:1:12 W "-"

 D ^%AUCLS I $D(A("PRINT",10))=1 W @(A("PRINT",10))

 X ^%ZIS("C") S IOP=$I D ^%ZIS K IOP

 Q

 ;

MAIN S IOP=ABPA("IO") D ^%ZIS K IOP

 D ^ABPAPRT I $D(A("PRINT",16))=1 W @(A("PRINT",16))

 S ABPAPG=0,PART2=1,ZTSK=ABPA("TASK") D HEAD G FC

ABPAADR2  ;PRINT DISTRIBUTION REPORT; [ 03/24/91  1:42 PM ]

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

 +2        WRITE !!,"<<< NOT AN ENTRY POINT - ACCESS DENIED >>>",!!

           QUIT 

COMMA      DO COMMA^%DTC

           QUIT 

 +1       ;

HEAD       KILL ABPA("HD")

           SET ABPA("HD",1)="R E P O R T   O F   P R I V A T E   "

 +1        SET ABPA("HD",1)=ABPA("HD",1)_"I N S U R A N C E   F U N D   "

 +2        SET ABPA("HD",1)=ABPA("HD",1)_"D I S T R I B U T I O N"

 +3        SET ABPA("HD",2)="for the period "_$EXTRACT(BDT,4,5)_"/"_$EXTRACT(BDT,6,7)_"/"

 +4        SET ABPA("HD",2)=ABPA("HD",2)_$EXTRACT(BDT,2,3)_" to "_$EXTRACT(EDT,4,5)_"/"

 +5        SET ABPA("HD",2)=ABPA("HD",2)_$EXTRACT(EDT,6,7)_"/"_$EXTRACT(EDT,2,3)

 +6        DO ^ABPAARHD

           QUIT 

 +7       ;

FC         SET FC=0

           FOR T=1:1:15

               SET @("T"_T)=0

 +1        SET TABLST="32^39^47^57^66^74^93^103^112^100^82^39^105^66^112"

 +2        SET WDLST="6^6^12^6^6^12^12^6^6^12^5^6^6^6^6"

NXTFC      SET FC=$ORDER(^%ZTSK(ZTSK,"SITE",FC))

           IF FC=""

               GOTO SUM

           SET DATA=^%ZTSK(ZTSK,FC)

 +1        IF ($PIECE(DATA,"^",10)=0)

               GOTO NXTFC

 +2        IF $Y>55

               DO HEAD

           WRITE !?20,FC

 +3        FOR P=1:1:15

               SET @("P"_P)=$PIECE(DATA,"^",P)

               SET @("T"_P)=@("T"_P)+@("P"_P)

 +4        SET P=10

           Begin DoDot:1

 +5            SET TAB=$PIECE(TABLST,"^",P)

               SET TAB="?"_TAB

               SET WD=$PIECE(WDLST,"^",P)

 +6            SET X=@("P"_P)

               DO COMMA

               FOR I=1:1:12

                   IF $EXTRACT(X,I)'=" "

                       QUIT 

 +7            WRITE @TAB,$JUSTIFY(X,WD),!

           End DoDot:1

 +8        GOTO NXTFC

 +9       ;

SUM        FOR I=1:1:132

               WRITE "-"

 +1        WRITE !?63,"D I S T R I B U T E D   T O T A L"

 +2        SET T=10

           Begin DoDot:1

 +3            SET TAB=$PIECE(TABLST,"^",T)

               SET TAB="?"_TAB

               SET WD=$PIECE(WDLST,"^",T)

 +4            SET X=@("T"_T)

               DO COMMA

               FOR I=1:1:12

                   IF $EXTRACT(X,I)'=" "

                       QUIT 

 +5            SET X=$EXTRACT(X,I,12)

 +6            WRITE @TAB,$JUSTIFY(X,WD),!?99

               FOR I=1:1:12

                   WRITE "-"

           End DoDot:1

 +7        DO ^%AUCLS

           IF $DATA(A("PRINT",10))=1

               WRITE @(A("PRINT",10))

 +8        XECUTE ^%ZIS("C")

           SET IOP=$IO

           DO ^%ZIS

           KILL IOP

 +9        QUIT 

 +10      ;

MAIN       SET IOP=ABPA("IO")

           DO ^%ZIS

           KILL IOP

 +1        DO ^ABPAPRT

           IF $DATA(A("PRINT",16))=1

               WRITE @(A("PRINT",16))

 +2        SET ABPAPG=0

           SET PART2=1

           SET ZTSK=ABPA("TASK")

           DO HEAD

           GOTO FC