- 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 Jan 18, 2025@03:29:04 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