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
Q
;
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
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)
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)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSUPR6 1336 printed Sep 23, 2025@20:04:02 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
