PSUAR5.m

PSUAR5 ;BIR/PDW - PRINT CYCLE CONTROLLER ;25 AUG 1998

 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005

EN ;EP for printing reports

 N PSUQUIT

 S PSUPG=0

CATRPT ;

 ; Printing Device should be opened by PSUDBQUE by now & IO set

 ;For summary print for each division

 I '$D(PSUARSUB) S PSUARSUB="PSUAR_"_PSUJOB

 S PSUDIV=0 F  S PSUDIV=$O(^XTMP(PSUARSUB,"REPORT1",PSUDIV)) Q:PSUDIV=""  D

 . S L="" F  S L=$O(^XTMP(PSUARSUB,"REPORT1",PSUDIV,L)) Q:L=""  S X=^(L) U IO W !,X I L=2 W !,?60,"PAGE: 1"

 .;VMP-IOFO BAY PINES;ELR;PSU*3.0*26 - REMOVED FORM FEED

 . ;U IO W @IOF

 ;

 D DRUGRPT

 I '$D(^XTMP("PSU_"_PSUJOB,"CBAMIS")) D PRTAMIS  ;Print AR/WS AMIS report

 Q

 ;

PRTAMIS ;Print AMIS summary report

 ;

 S PSUPGS("PG")=1

 D PGHDR1

 S PSUL=4

 F  S PSUL=$O(^XTMP("PSU_"_PSUJOB,"ARAMIS",PSUL)) Q:PSUL=""  D

 .I (LNCNT+4)>IOSL D PGHDR1

 .W !,^XTMP("PSU_"_PSUJOB,"ARAMIS",PSUL)

 .S LNCNT=LNCNT+1

 Q

 ;

DRUGRPT ; Print Drug Summary

 S PSUDIV=0 F  S PSUDIV=$O(^XTMP(PSUARSUB,"REPORT2",PSUDIV)) Q:PSUDIV=""  D

 . S PSUPG("PG")=1 D PGHDR S L=7 F  S L=$O(^XTMP(PSUARSUB,"REPORT2",PSUDIV,L)) Q:L=""  S X=^(L) U IO W !,X I $Y+4>IOSL D PG Q:$G(PSUQUIT)

 . U IO W @IOF

 Q

 ;

PG ;EP  Page controller

 S PSUQUIT=0

 I $Y<(IOSL-4) Q

 S:'$D(PSUPG("PG")) PSUPG("PG")=0 S PSUPG("PG")=PSUPG("PG")+1

 I $E(IOST)="C" K DIR S DIR(0)="E" D ^DIR I ($G(DIROUT)!$G(DUOUT)!$G(DTOUT)!$G(DROUT)) S PSUQUIT=1

 ;

PGHDR ;PAGE HEADER

 U IO W @IOF

 F I=1,2 W !,^XTMP(PSUARSUB,"REPORT2",PSUDIV,I)

 W !,?60,"Page: ",PSUPG("PG")

 F I=4:1:7 I $D(^XTMP(PSUARSUB,"REPORT2",PSUDIV,I)) W !,^(I)

 Q

PGHDR1 ; Write Page Header (SUBJECT of MAILMESSAGE)

 U IO W @IOF

 F I=1,2 W !,^XTMP("PSU_"_PSUJOB,"ARAMIS",I)

 W !,?68,"Page: ",PSUPG("PG")

 S PSUPG("PG")=PSUPG("PG")+1

 S LNCNT=3

 Q

PSUAR5    ;BIR/PDW - PRINT CYCLE CONTROLLER ;25 AUG 1998

 +1       ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005

EN        ;EP for printing reports

 +1        NEW PSUQUIT

 +2        SET PSUPG=0

CATRPT    ;

 +1       ; Printing Device should be opened by PSUDBQUE by now & IO set

 +2       ;For summary print for each division

 +3        IF '$DATA(PSUARSUB)

               SET PSUARSUB="PSUAR_"_PSUJOB

 +4        SET PSUDIV=0

           FOR 

               SET PSUDIV=$ORDER(^XTMP(PSUARSUB,"REPORT1",PSUDIV))

               IF PSUDIV=""

                   QUIT 

               Begin DoDot:1

 +5                SET L=""

                   FOR 

                       SET L=$ORDER(^XTMP(PSUARSUB,"REPORT1",PSUDIV,L))

                       IF L=""

                           QUIT 

                       SET X=^(L)

                       USE IO

                       WRITE !,X

                       IF L=2

                           WRITE !,?60,"PAGE: 1"

 +6       ;VMP-IOFO BAY PINES;ELR;PSU*3.0*26 - REMOVED FORM FEED

 +7       ;U IO W @IOF

               End DoDot:1

 +8       ;

 +9        DO DRUGRPT

 +10      ;Print AR/WS AMIS report

           IF '$DATA(^XTMP("PSU_"_PSUJOB,"CBAMIS"))

               DO PRTAMIS

 +11       QUIT 

 +12      ;

PRTAMIS   ;Print AMIS summary report

 +1       ;

 +2        SET PSUPGS("PG")=1

 +3        DO PGHDR1

 +4        SET PSUL=4

 +5        FOR 

               SET PSUL=$ORDER(^XTMP("PSU_"_PSUJOB,"ARAMIS",PSUL))

               IF PSUL=""

                   QUIT 

               Begin DoDot:1

 +6                IF (LNCNT+4)>IOSL

                       DO PGHDR1

 +7                WRITE !,^XTMP("PSU_"_PSUJOB,"ARAMIS",PSUL)

 +8                SET LNCNT=LNCNT+1

               End DoDot:1

 +9        QUIT 

 +10      ;

DRUGRPT   ; Print Drug Summary

 +1        SET PSUDIV=0

           FOR 

               SET PSUDIV=$ORDER(^XTMP(PSUARSUB,"REPORT2",PSUDIV))

               IF PSUDIV=""

                   QUIT 

               Begin DoDot:1

 +2                SET PSUPG("PG")=1

                   DO PGHDR

                   SET L=7

                   FOR 

                       SET L=$ORDER(^XTMP(PSUARSUB,"REPORT2",PSUDIV,L))

                       IF L=""

                           QUIT 

                       SET X=^(L)

                       USE IO

                       WRITE !,X

                       IF $Y+4>IOSL

                           DO PG

                           IF $GET(PSUQUIT)

                               QUIT 

 +3                USE IO

                   WRITE @IOF

               End DoDot:1

 +4        QUIT 

 +5       ;

PG        ;EP  Page controller

 +1        SET PSUQUIT=0

 +2        IF $Y<(IOSL-4)

               QUIT 

 +3        IF '$DATA(PSUPG("PG"))

               SET PSUPG("PG")=0

           SET PSUPG("PG")=PSUPG("PG")+1

 +4        IF $EXTRACT(IOST)="C"

               KILL DIR

               SET DIR(0)="E"

               DO ^DIR

               IF ($GET(DIROUT)!$GET(DUOUT)!$GET(DTOUT)!$GET(DROUT))

                   SET PSUQUIT=1

 +5       ;

PGHDR     ;PAGE HEADER

 +1        USE IO

           WRITE @IOF

 +2        FOR I=1,2

               WRITE !,^XTMP(PSUARSUB,"REPORT2",PSUDIV,I)

 +3        WRITE !,?60,"Page: ",PSUPG("PG")

 +4        FOR I=4:1:7

               IF $DATA(^XTMP(PSUARSUB,"REPORT2",PSUDIV,I))

                   WRITE !,^(I)

 +5        QUIT 

PGHDR1    ; Write Page Header (SUBJECT of MAILMESSAGE)

 +1        USE IO

           WRITE @IOF

 +2        FOR I=1,2

               WRITE !,^XTMP("PSU_"_PSUJOB,"ARAMIS",I)

 +3        WRITE !,?68,"Page: ",PSUPG("PG")

 +4        SET PSUPG("PG")=PSUPG("PG")+1

 +5        SET LNCNT=3

 +6        QUIT