PSUOP6 ;BIR/REG - PSU PBM Outpatient Pharmacy Printer Output ;10 JUL 1999
;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
;
;DBIA(s)
; Reference to file #59 supported by DBIA 2510
;
;PRINT CYCLE CONTROLLER FOR OUTPATIENT PHARMACY SUMMARY REPORT
;
EP ;
NEW PSUI,PSUH,PSUL,PSUM,PSUPGS
D DT^DILF("E",PSUSDT,.EXTD)
S PSURP("START")=EXTD(0)
D DT^DILF("E",PSUEDT,.EXTD)
S PSURP("END")=EXTD(0)
U IO
;
PRTSUMS ;
; Find first Division/Facility in the summary by division
; then DO the PRTALL routine
S PSUOPSUB="PSUOP_"_PSUJOB
I '$D(^XTMP(PSUOPSUB,"STATSUM")) D
.S ^XTMP("PSU_"_PSUJOB,"PSUNONE2")=""
.S ^XTMP(PSUOPSUB,"STATSUM",PSUSNDR,1)="Outpatient Statistical Data Summary for "_PSURP("START")_" through "_PSURP("END")
.S ^XTMP(PSUOPSUB,"STATSUM",PSUSNDR,2)=" "
.S ^XTMP(PSUOPSUB,"STATSUM",PSUSNDR,3)="No data to report"
;
S PSUFACN=""
;VMP-IOFO BAY PINES;ELR;PSU*3.0*26
NEW PSUFIRST
F S PSUFACN=$O(^XTMP(PSUOPSUB,"STATSUM",PSUFACN)) Q:PSUFACN="" D PRTALL
;
I '$D(^XTMP("PSU_"_PSUJOB,"CBAMIS")) D PRTAMIS ;Print OPAMIS SUMMARY
;
D PULL^PSUCP
F I=1:1:$L(PSUOPTS,",") S PSUMOD($P(PSUOPTS,",",I))=""
;
;Call Pt. Demographics summary report/No data when user selects
;(1)IV and (2)UD and (4)Rx
;(1)IV and (4)Rx
;(2)UD and (4)Rx
I $D(PSUMOD(1))!$D(PSUMOD(2)) D IVSUM^PSUDEM0
;
;Call Pt. Demographics summary report/No data when user selects
;(4)IV alone.
I '$D(PSUMOD(1))&'$D(PSUMOD(2)) D IVSUM^PSUDEM0
;
; Find the first Division/Facility in the summary by drug by division
; then DO the PRTDRUG routine
Q:PSUSMRY ; 'summary only' was selected don't print 'by drug'
S PSUFACN=""
I '$D(^XTMP(PSUOPSUB,"DRUGSUM")) D
.S ^XTMP(PSUOPSUB,"DRUGSUM",PSUSNDR,1)="Outpatient Statistical Data for "_PSURP("START")_" through "_PSURP("END")
.S ^XTMP(PSUOPSUB,"DRUGSUM",PSUSNDR,2)=" Page"
.S ^XTMP(PSUOPSUB,"DRUGSUM",PSUSNDR,3)="No data to report"
F S PSUFACN=$O(^XTMP(PSUOPSUB,"DRUGSUM",PSUFACN)) Q:PSUFACN="" D PRTDRUG
PRTSUMX ; EXIT PSUOP6
W @IOF
;
Q
;
PRTALL ; Print the Drug summary of all drugs by Division/Facility
S X=PSUFACN,DIC=59,DIC(0)="XM" D ^DIC ;**1
S X=+Y S PSUDIVNM=$$VAL^PSUTL(59,X,.01)
;VMP OIFO BAY PINES;ELR;PSU*3.0*31
I '$L(PSUDIVNM) S X=PSUFACN D DIVNM
;VMP-IOFO BAY PINES;ELR;PSU*3.0*26; REMOVE FORM FEED FIRST TIME THROUGH
I $G(PSUFIRST) W @IOF
S PSUFIRST=1
F I=1:1:3 W !
S PSUL=""
F S PSUL=$O(^XTMP(PSUOPSUB,"STATSUM",PSUFACN,PSUL)) Q:PSUL="" D
.W !,^XTMP(PSUOPSUB,"STATSUM",PSUFACN,PSUL)
.I PSUL=1 W " for ",PSUDIVNM,!,?72,"Page: 1" ; will only ever be one page
Q
;
PRTDRUG ; Print the Drug summary by Drug by Division/Facility
; Set page number to 0
S PSUPGS("PG")=0
S X=PSUFACN,DIC=59,DIC(0)="XM" D ^DIC
S X=+Y S PSUDIVNM=$$VAL^PSUTL(59,X,.01)
;VMP OIFO BAY PINES;ELR;PSU*3.0*31
I '$L(PSUDIVNM) S X=PSUFACN D DIVNM
D PGHDR ; Perform 1st page heading
S PSUL=6 ; Report body starts at line 7
F S PSUL=$O(^XTMP(PSUOPSUB,"DRUGSUM",PSUFACN,PSUL)) Q:PSUL="" D
.I $Y+4>IOSL D PGHDR
.W !,^XTMP(PSUOPSUB,"DRUGSUM",PSUFACN,PSUL)
;
Q
;
PRTAMIS ;Print Amis summary report
;
U IO W @IOF
S PSUPGS("PG")=1
D PGHDR1
S PSUL=3
F S PSUL=$O(^XTMP("PSU_"_PSUJOB,"OPAMIS",PSUL)) Q:PSUL="" D
.I LNCNT+4>IOSL D PGHDR1
.W !,^XTMP("PSU_"_PSUJOB,"OPAMIS",PSUL)
.S LNCNT=LNCNT+1
Q
;
PGHDR1 ;AMIS HEADER
U IO W @IOF
F I=1:1:3 W !
F I=1:1:2 W ^XTMP("PSU_"_PSUJOB,"OPAMIS",I)
W !!,?68,"Page: ",PSUPGS("PG")
S PSUPGS("PG")=PSUPGS("PG")+1
S LNCNT=3
Q
;
PGHDR ;Increment page number and Write Page Heading
; Writes header lines 1 & 2, then page number, then lines 3 through 6
U IO W @IOF
F I=1:1:3 W !
W !,^XTMP(PSUOPSUB,"DRUGSUM",PSUFACN,1) ;Print 1st line
W " for ",PSUDIVNM ; add division name
S PSUPGS("PG")=PSUPGS("PG")+1
W !,$P(^XTMP(PSUOPSUB,"DRUGSUM",PSUFACN,2),":",1),": ",PSUPGS("PG"),! ;Print page number
F PSUH=3:1:6 W !,$G(^XTMP(PSUOPSUB,"DRUGSUM",PSUFACN,PSUH)) ;Print next 5 lines
Q
;
DIVNM ;S PSUDIVNM FROM FILE 40.8 IF NOT IN FILE 59
S DIC=40.8,DIC(0)="X",D="C" D IX^DIC
S X=+Y S PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSUOP6 4232 printed Oct 16, 2024@18:28:55 Page 2
PSUOP6 ;BIR/REG - PSU PBM Outpatient Pharmacy Printer Output ;10 JUL 1999
+1 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
+2 ;
+3 ;DBIA(s)
+4 ; Reference to file #59 supported by DBIA 2510
+5 ;
+6 ;PRINT CYCLE CONTROLLER FOR OUTPATIENT PHARMACY SUMMARY REPORT
+7 ;
EP ;
+1 NEW PSUI,PSUH,PSUL,PSUM,PSUPGS
+2 DO DT^DILF("E",PSUSDT,.EXTD)
+3 SET PSURP("START")=EXTD(0)
+4 DO DT^DILF("E",PSUEDT,.EXTD)
+5 SET PSURP("END")=EXTD(0)
+6 USE IO
+7 ;
PRTSUMS ;
+1 ; Find first Division/Facility in the summary by division
+2 ; then DO the PRTALL routine
+3 SET PSUOPSUB="PSUOP_"_PSUJOB
+4 IF '$DATA(^XTMP(PSUOPSUB,"STATSUM"))
Begin DoDot:1
+5 SET ^XTMP("PSU_"_PSUJOB,"PSUNONE2")=""
+6 SET ^XTMP(PSUOPSUB,"STATSUM",PSUSNDR,1)="Outpatient Statistical Data Summary for "_PSURP("START")_" through "_PSURP("END")
+7 SET ^XTMP(PSUOPSUB,"STATSUM",PSUSNDR,2)=" "
+8 SET ^XTMP(PSUOPSUB,"STATSUM",PSUSNDR,3)="No data to report"
End DoDot:1
+9 ;
+10 SET PSUFACN=""
+11 ;VMP-IOFO BAY PINES;ELR;PSU*3.0*26
+12 NEW PSUFIRST
+13 FOR
SET PSUFACN=$ORDER(^XTMP(PSUOPSUB,"STATSUM",PSUFACN))
if PSUFACN=""
QUIT
DO PRTALL
+14 ;
+15 ;Print OPAMIS SUMMARY
IF '$DATA(^XTMP("PSU_"_PSUJOB,"CBAMIS"))
DO PRTAMIS
+16 ;
+17 DO PULL^PSUCP
+18 FOR I=1:1:$LENGTH(PSUOPTS,",")
SET PSUMOD($PIECE(PSUOPTS,",",I))=""
+19 ;
+20 ;Call Pt. Demographics summary report/No data when user selects
+21 ;(1)IV and (2)UD and (4)Rx
+22 ;(1)IV and (4)Rx
+23 ;(2)UD and (4)Rx
+24 IF $DATA(PSUMOD(1))!$DATA(PSUMOD(2))
DO IVSUM^PSUDEM0
+25 ;
+26 ;Call Pt. Demographics summary report/No data when user selects
+27 ;(4)IV alone.
+28 IF '$DATA(PSUMOD(1))&'$DATA(PSUMOD(2))
DO IVSUM^PSUDEM0
+29 ;
+30 ; Find the first Division/Facility in the summary by drug by division
+31 ; then DO the PRTDRUG routine
+32 ; 'summary only' was selected don't print 'by drug'
if PSUSMRY
QUIT
+33 SET PSUFACN=""
+34 IF '$DATA(^XTMP(PSUOPSUB,"DRUGSUM"))
Begin DoDot:1
+35 SET ^XTMP(PSUOPSUB,"DRUGSUM",PSUSNDR,1)="Outpatient Statistical Data for "_PSURP("START")_" through "_PSURP("END")
+36 SET ^XTMP(PSUOPSUB,"DRUGSUM",PSUSNDR,2)=" Page"
+37 SET ^XTMP(PSUOPSUB,"DRUGSUM",PSUSNDR,3)="No data to report"
End DoDot:1
+38 FOR
SET PSUFACN=$ORDER(^XTMP(PSUOPSUB,"DRUGSUM",PSUFACN))
if PSUFACN=""
QUIT
DO PRTDRUG
PRTSUMX ; EXIT PSUOP6
+1 WRITE @IOF
+2 ;
+3 QUIT
+4 ;
PRTALL ; Print the Drug summary of all drugs by Division/Facility
+1 ;**1
SET X=PSUFACN
SET DIC=59
SET DIC(0)="XM"
DO ^DIC
+2 SET X=+Y
SET PSUDIVNM=$$VAL^PSUTL(59,X,.01)
+3 ;VMP OIFO BAY PINES;ELR;PSU*3.0*31
+4 IF '$LENGTH(PSUDIVNM)
SET X=PSUFACN
DO DIVNM
+5 ;VMP-IOFO BAY PINES;ELR;PSU*3.0*26; REMOVE FORM FEED FIRST TIME THROUGH
+6 IF $GET(PSUFIRST)
WRITE @IOF
+7 SET PSUFIRST=1
+8 FOR I=1:1:3
WRITE !
+9 SET PSUL=""
+10 FOR
SET PSUL=$ORDER(^XTMP(PSUOPSUB,"STATSUM",PSUFACN,PSUL))
if PSUL=""
QUIT
Begin DoDot:1
+11 WRITE !,^XTMP(PSUOPSUB,"STATSUM",PSUFACN,PSUL)
+12 ; will only ever be one page
IF PSUL=1
WRITE " for ",PSUDIVNM,!,?72,"Page: 1"
End DoDot:1
+13 QUIT
+14 ;
PRTDRUG ; Print the Drug summary by Drug by Division/Facility
+1 ; Set page number to 0
+2 SET PSUPGS("PG")=0
+3 SET X=PSUFACN
SET DIC=59
SET DIC(0)="XM"
DO ^DIC
+4 SET X=+Y
SET PSUDIVNM=$$VAL^PSUTL(59,X,.01)
+5 ;VMP OIFO BAY PINES;ELR;PSU*3.0*31
+6 IF '$LENGTH(PSUDIVNM)
SET X=PSUFACN
DO DIVNM
+7 ; Perform 1st page heading
DO PGHDR
+8 ; Report body starts at line 7
SET PSUL=6
+9 FOR
SET PSUL=$ORDER(^XTMP(PSUOPSUB,"DRUGSUM",PSUFACN,PSUL))
if PSUL=""
QUIT
Begin DoDot:1
+10 IF $Y+4>IOSL
DO PGHDR
+11 WRITE !,^XTMP(PSUOPSUB,"DRUGSUM",PSUFACN,PSUL)
End DoDot:1
+12 ;
+13 QUIT
+14 ;
PRTAMIS ;Print Amis summary report
+1 ;
+2 USE IO
WRITE @IOF
+3 SET PSUPGS("PG")=1
+4 DO PGHDR1
+5 SET PSUL=3
+6 FOR
SET PSUL=$ORDER(^XTMP("PSU_"_PSUJOB,"OPAMIS",PSUL))
if PSUL=""
QUIT
Begin DoDot:1
+7 IF LNCNT+4>IOSL
DO PGHDR1
+8 WRITE !,^XTMP("PSU_"_PSUJOB,"OPAMIS",PSUL)
+9 SET LNCNT=LNCNT+1
End DoDot:1
+10 QUIT
+11 ;
PGHDR1 ;AMIS HEADER
+1 USE IO
WRITE @IOF
+2 FOR I=1:1:3
WRITE !
+3 FOR I=1:1:2
WRITE ^XTMP("PSU_"_PSUJOB,"OPAMIS",I)
+4 WRITE !!,?68,"Page: ",PSUPGS("PG")
+5 SET PSUPGS("PG")=PSUPGS("PG")+1
+6 SET LNCNT=3
+7 QUIT
+8 ;
PGHDR ;Increment page number and Write Page Heading
+1 ; Writes header lines 1 & 2, then page number, then lines 3 through 6
+2 USE IO
WRITE @IOF
+3 FOR I=1:1:3
WRITE !
+4 ;Print 1st line
WRITE !,^XTMP(PSUOPSUB,"DRUGSUM",PSUFACN,1)
+5 ; add division name
WRITE " for ",PSUDIVNM
+6 SET PSUPGS("PG")=PSUPGS("PG")+1
+7 ;Print page number
WRITE !,$PIECE(^XTMP(PSUOPSUB,"DRUGSUM",PSUFACN,2),":",1),": ",PSUPGS("PG"),!
+8 ;Print next 5 lines
FOR PSUH=3:1:6
WRITE !,$GET(^XTMP(PSUOPSUB,"DRUGSUM",PSUFACN,PSUH))
+9 QUIT
+10 ;
DIVNM ;S PSUDIVNM FROM FILE 40.8 IF NOT IN FILE 59
+1 SET DIC=40.8
SET DIC(0)="X"
SET D="C"
DO IX^DIC
+2 SET X=+Y
SET PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
+3 QUIT
