PSULR6.m

PSULR6 ;BIR/PDW - PBM Laboratory Printer Controller ;25 AUG 1998

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

EN ;EP for printing reports      

 S PSUPG=0

 S PSULRJOB=PSUJOB

 S PSULRSUB="PSULR_"_PSULRJOB

DIVISION ;EP loop by divisions

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

 Q

 ;

REPORT ;EP Perform Prints COUNTS & PATIENTS for Division

 ;

 ;

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

 I $Y>5 U IO W @IOF

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

 U IO W !!,@IOF

 ;

 ;VMP OIFO BAY PINES;ELR;PSU*3.0*32

 I (($E($G(IOST))="P")&($G(IOST)'["P-MESS")) Q

REPORT2 ; Print Report 2

 S PSUPG("PG")=1

 D PGHDR

 S L=5 F  S L=$O(^XTMP(PSULRSUB,"REPORT2",PSUDIV,L)) Q:L=""  S X=^(L) U IO W !,X I $Y+4>IOSL D PG Q:$G(PSUQUIT)

 W !!

 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

 U IO W @IOF

 ;

PGHDR ; Write Page Header (SUBJECT of MAILMESSAGE)

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

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

 F I=3:1:5 I $D(^XTMP(PSULRSUB,"REPORT2",PSUDIV,I)) W !,^(I)

 Q

PSULR6    ;BIR/PDW - PBM Laboratory Printer Controller ;25 AUG 1998

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

EN        ;EP for printing reports      

 +1        SET PSUPG=0

 +2        SET PSULRJOB=PSUJOB

 +3        SET PSULRSUB="PSULR_"_PSULRJOB

DIVISION  ;EP loop by divisions

 +1        SET PSUDIV=""

           FOR 

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

               IF PSUDIV=""

                   QUIT 

               DO REPORT

 +2        QUIT 

 +3       ;

REPORT    ;EP Perform Prints COUNTS & PATIENTS for Division

 +1       ;

 +2       ;

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

 +4        IF $Y>5

               USE IO

               WRITE @IOF

 +5        SET L=""

           FOR 

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

               IF L=""

                   QUIT 

               SET X=^(L)

               USE IO

               WRITE !,X

               IF L=2

                   WRITE !,?60,"PAGE: 1"

 +6        USE IO

           WRITE !!,@IOF

 +7       ;

 +8       ;VMP OIFO BAY PINES;ELR;PSU*3.0*32

 +9        IF (($EXTRACT($GET(IOST))="P")&($GET(IOST)'["P-MESS"))

               QUIT 

REPORT2   ; Print Report 2

 +1        SET PSUPG("PG")=1

 +2        DO PGHDR

 +3        SET L=5

           FOR 

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

               IF L=""

                   QUIT 

               SET X=^(L)

               USE IO

               WRITE !,X

               IF $Y+4>IOSL

                   DO PG

                   IF $GET(PSUQUIT)

                       QUIT 

 +4        WRITE !!

 +5        QUIT 

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        USE IO

           WRITE @IOF

 +6       ;

PGHDR     ; Write Page Header (SUBJECT of MAILMESSAGE)

 +1        FOR I=1,2

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

 +2        WRITE !,?60,"PAGE: ",PSUPG("PG")

 +3        FOR I=3:1:5

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

                   WRITE !,^(I)

 +4        QUIT