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