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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSULR6 1318 printed Sep 23, 2025@20:03:38 Page 2
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
