Routine: PSUPR6

PSUPR6 ;BIR/PDW - PBM Procurement Printer Controller ;25 AUG 1998

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

EN ;EP for printing reports

 N PSUQUIT

 S PSUPG=0

 S PSUPRJOB=PSUJOB

 S PSUPRSUB="PSUPR_"_PSUPRJOB

DIVISION ;EP loop by divisions

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

REPORT ;EP Perform Prints Category & Drug for Division

CATRPT ;

 ; 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(PSUPRSUB,"REPORT1",PSUDIV,L)) Q:L=""  S X=^(L) U IO W !,X I L=2 W !,?60,"PAGE: 1"

 U IO W !!,@IOF

DRUGRPT ; Print Drug Summary

 I '$D(^XTMP(PSUPRSUB,"REPORT2",PSUDIV)) Q

 S PSUPG("PG")=1 D PGHDR

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

 W @IOF

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)

 I '$D(^XTMP(PSUPRSUB,"REPORT2",PSUDIV)) Q

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

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

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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSUPR6   1336     printed  Apr 09, 2024@21:30:28                                                                                                                                                                                                      Page 2

PSUPR6    ;BIR/PDW - PBM Procurement Printer Controller ;25 AUG 1998

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

EN        ;EP for printing reports

 +1        NEW PSUQUIT

 +2        SET PSUPG=0

 +3        SET PSUPRJOB=PSUJOB

 +4        SET PSUPRSUB="PSUPR_"_PSUPRJOB

DIVISION  ;EP loop by divisions

 +1        SET PSUDIV=""

FOR

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

               if PSUDIV=""

                   QUIT

               DO REPORT

 +2        QUIT

 +3       ;

REPORT    ;EP Perform Prints Category & Drug for Division

 +1       ;

CATRPT    ;

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

 +2        IF $Y>5

               USE IO

               WRITE @IOF

 +3        SET L=""

FOR

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

               if L=""

                   QUIT

               SET X=^(L)

               USE IO

               WRITE !,X

               IF L=2

                   WRITE !,?60,"PAGE: 1"

 +4        USE IO

           WRITE !!,@IOF

 +5       ;

DRUGRPT   ; Print Drug Summary

 +1        IF '$DATA(^XTMP(PSUPRSUB,"REPORT2",PSUDIV))

               QUIT

 +2        SET PSUPG("PG")=1

           DO PGHDR

 +3        SET L=6

FOR

               SET L=$ORDER(^XTMP(PSUPRSUB,"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 @IOF

 +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        IF '$DATA(^XTMP(PSUPRSUB,"REPORT2",PSUDIV))

               QUIT

 +2        FOR I=1,2

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

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

 +4        FOR I=3:1:6

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

                   WRITE !,^(I)

 +5        QUIT

PSUPR6.m