- 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 Feb 18, 2025@23:54:01 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