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