- PSUUD5 ;BIR/REG - UNIT DOSE PRINTER MODULE ;10 JUL 1999
- ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
- ;DBIA(s)
- ; Reference to file #40.8 supported by DBIA 2438
- ;
- ;PRINT CYCLE CONTROLLER FOR UNIT DOSE SUMMARY REPORT
- ;
- EP ;Print Unit Dose Statistical Report by Drug and Summary Report
- ;Printing Device should be opened by PSUDBQUE by new & IO set
- ;The ^XTMP global contains print lines by drug by division
- ;Lines 1 through 7 are page heading lines for the summary by drug by
- ;division; The Summary Report by division only is only 6 lines
- ;Package variables are set by calling routine prior to call.
- NEW PSUI,PSUH,PSUL,PSUM,PSUPGS,PSUUDFLG
- S PSUUDFLG=1 ;Flag for summary reports
- 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 PSUUDSUB="PSUUD_"_PSUJOB
- ;
- I '$D(^XTMP("PSU_"_PSUJOB,"CBAMIS")) D PRTAMIS ;Print UD AMIS SUMMARY
- ;
- ; 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(PSUUDSUB,"DRUGSUM")) D
- .S ^XTMP("PSU_"_PSUJOB,"PSUNONE1")=""
- .S ^XTMP(PSUUDSUB,"DRUGSUM",PSUSNDR,1)="Unit Dose Statistical Data for "_PSURP("START")_" through "_PSURP("END")
- .S ^XTMP(PSUUDSUB,"DRUGSUM",PSUSNDR,2)=" "
- .S ^XTMP(PSUUDSUB,"DRUGSUM",PSUSNDR,3)="No data to report"
- F S PSUFACN=$O(^XTMP(PSUUDSUB,"DRUGSUM",PSUFACN)) Q:PSUFACN="" D PRTDRUG
- ;
- ;
- D PULL^PSUCP
- F I=1:1:$L(PSUOPTS,",") S PSUMOD($P(PSUOPTS,",",I))=""
- ;Print routine for Pt. demographics summary/No data when user selects
- ;(1)IV and (2)UD
- I $D(PSUMOD(1))&$D(PSUMOD(2)) D
- .I '$D(PSUMOD(4)) D
- ..D IVSUM^PSUDEM0
- ;
- ;Print routine for Pt. demographics summary/No data when user selects
- ;(2)UD only
- I $D(PSUMOD(2))&'$D(PSUMOD(1)) D
- .I '$D(PSUMOD(4)) D
- ..D IVSUM^PSUDEM0
- ;
- PRTSUMX ; EXIT PSUUD5
- ;W @IOF
- Q
- ;
- PRTALL ; Print the Drug summary of all drugs by Division/Facility
- S X=PSUFACN,DIC=40.8,DIC(0)="X",D="C" D IX^DIC ;**1
- S X=+Y S PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
- W @IOF
- F I=1:1:3 W !
- S PSUL=""
- F S PSUL=$O(^XTMP(PSUUDSUB,"STATSUM",PSUFACN,PSUL)) Q:PSUL="" D
- .S X=^XTMP(PSUUDSUB,"STATSUM",PSUFACN,PSUL) W !,X
- .I PSUL=1 W " for ",PSUDIVNM,!,?72,"PAGE: 1" ; will only ever be one page
- Q
- ;
- PRTAMIS ;Print UD AMIS summary
- ;
- S PSUPGS("PG")=0
- D PGHDR1
- S PSUL=3
- F S PSUL=$O(^XTMP("PSU_"_PSUJOB,"UDAMIS",PSUL)) Q:PSUL="" D
- .I LNCNT+4>IOSL D PGHDR1 ; leave a margin at the bottom
- .W !,^XTMP("PSU_"_PSUJOB,"UDAMIS",PSUL)
- .S LNCNT=LNCNT+1
- ;
- Q
- ;
- PRTDRUG ; Print the Drug summary by Drug by Division/Facility
- ; Set page number to 0
- S PSUPGS("PG")=0
- S X=PSUFACN,DIC=40.8,DIC(0)="X",D="C" D IX^DIC ;**1
- S X=+Y S PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
- D PGHDR ; Perform 1st page heading
- S PSUL=7 ; Report body starts at line 8
- F S PSUL=$O(^XTMP(PSUUDSUB,"DRUGSUM",PSUFACN,PSUL)) Q:PSUL="" D
- .I $Y+4>IOSL D PGHDR ; leave a margin at the bottom
- .W !,^XTMP(PSUUDSUB,"DRUGSUM",PSUFACN,PSUL)
- ;
- Q
- ;
- PGHDR ;Increment page number and Write Page Heading
- ; Writes header lines 1 & 2, then page number, then lines 3 through 7
- U IO W @IOF
- F I=1:1:3 W !
- W !,^XTMP(PSUUDSUB,"DRUGSUM",PSUFACN,1) ;Print 1st line
- W " for ",PSUDIVNM ; add division name
- S PSUPGS("PG")=PSUPGS("PG")+1
- W !,^XTMP(PSUUDSUB,"DRUGSUM",PSUFACN,2),?72,"PAGE: ",PSUPGS("PG")
- F PSUH=3:1:7 W !,$G(^XTMP(PSUUDSUB,"DRUGSUM",PSUFACN,PSUH)) ;Print next 5 lines
- Q
- ;
- PGHDR1 ;Page headers for AMIS summary report
- ;
- U IO
- W @IOF
- W !,^XTMP("PSU_"_PSUJOB,"UDAMIS",1)
- W !!,?68,"Page: ",PSUPGS("PG")
- S PSUPGS("PG")=PSUPGS("PG")+1
- W !,$G(^XTMP("PSU_"_PSUJOB,"UDAMIS",2))
- S LNCNT=3
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSUUD5 3886 printed Jan 18, 2025@03:29:22 Page 2
- PSUUD5 ;BIR/REG - UNIT DOSE PRINTER MODULE ;10 JUL 1999
- +1 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
- +2 ;DBIA(s)
- +3 ; Reference to file #40.8 supported by DBIA 2438
- +4 ;
- +5 ;PRINT CYCLE CONTROLLER FOR UNIT DOSE SUMMARY REPORT
- +6 ;
- EP ;Print Unit Dose Statistical Report by Drug and Summary Report
- +1 ;Printing Device should be opened by PSUDBQUE by new & IO set
- +2 ;The ^XTMP global contains print lines by drug by division
- +3 ;Lines 1 through 7 are page heading lines for the summary by drug by
- +4 ;division; The Summary Report by division only is only 6 lines
- +5 ;Package variables are set by calling routine prior to call.
- +6 NEW PSUI,PSUH,PSUL,PSUM,PSUPGS,PSUUDFLG
- +7 ;Flag for summary reports
- SET PSUUDFLG=1
- +8 DO DT^DILF("E",PSUSDT,.EXTD)
- +9 SET PSURP("START")=EXTD(0)
- +10 DO DT^DILF("E",PSUEDT,.EXTD)
- +11 SET PSURP("END")=EXTD(0)
- +12 USE IO
- +13 ;
- PRTSUMS ;
- +1 ; Find first Division/Facility in the summary by division
- +2 ; then DO the PRTALL routine
- +3 SET PSUUDSUB="PSUUD_"_PSUJOB
- +4 ;
- +5 ;Print UD AMIS SUMMARY
- IF '$DATA(^XTMP("PSU_"_PSUJOB,"CBAMIS"))
- DO PRTAMIS
- +6 ;
- +7 ; Find the first Division/Facility in the summary by drug by division
- +8 ; then DO the PRTDRUG routine
- +9 ; 'summary only' was selected don't print 'by drug'
- if PSUSMRY
- QUIT
- +10 SET PSUFACN=""
- +11 IF '$DATA(^XTMP(PSUUDSUB,"DRUGSUM"))
- Begin DoDot:1
- +12 SET ^XTMP("PSU_"_PSUJOB,"PSUNONE1")=""
- +13 SET ^XTMP(PSUUDSUB,"DRUGSUM",PSUSNDR,1)="Unit Dose Statistical Data for "_PSURP("START")_" through "_PSURP("END")
- +14 SET ^XTMP(PSUUDSUB,"DRUGSUM",PSUSNDR,2)=" "
- +15 SET ^XTMP(PSUUDSUB,"DRUGSUM",PSUSNDR,3)="No data to report"
- End DoDot:1
- +16 FOR
- SET PSUFACN=$ORDER(^XTMP(PSUUDSUB,"DRUGSUM",PSUFACN))
- if PSUFACN=""
- QUIT
- DO PRTDRUG
- +17 ;
- +18 ;
- +19 DO PULL^PSUCP
- +20 FOR I=1:1:$LENGTH(PSUOPTS,",")
- SET PSUMOD($PIECE(PSUOPTS,",",I))=""
- +21 ;Print routine for Pt. demographics summary/No data when user selects
- +22 ;(1)IV and (2)UD
- +23 IF $DATA(PSUMOD(1))&$DATA(PSUMOD(2))
- Begin DoDot:1
- +24 IF '$DATA(PSUMOD(4))
- Begin DoDot:2
- +25 DO IVSUM^PSUDEM0
- End DoDot:2
- End DoDot:1
- +26 ;
- +27 ;Print routine for Pt. demographics summary/No data when user selects
- +28 ;(2)UD only
- +29 IF $DATA(PSUMOD(2))&'$DATA(PSUMOD(1))
- Begin DoDot:1
- +30 IF '$DATA(PSUMOD(4))
- Begin DoDot:2
- +31 DO IVSUM^PSUDEM0
- End DoDot:2
- End DoDot:1
- +32 ;
- PRTSUMX ; EXIT PSUUD5
- +1 ;W @IOF
- +2 QUIT
- +3 ;
- PRTALL ; Print the Drug summary of all drugs by Division/Facility
- +1 ;**1
- SET X=PSUFACN
- 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 WRITE @IOF
- +4 FOR I=1:1:3
- WRITE !
- +5 SET PSUL=""
- +6 FOR
- SET PSUL=$ORDER(^XTMP(PSUUDSUB,"STATSUM",PSUFACN,PSUL))
- if PSUL=""
- QUIT
- Begin DoDot:1
- +7 SET X=^XTMP(PSUUDSUB,"STATSUM",PSUFACN,PSUL)
- WRITE !,X
- +8 ; will only ever be one page
- IF PSUL=1
- WRITE " for ",PSUDIVNM,!,?72,"PAGE: 1"
- End DoDot:1
- +9 QUIT
- +10 ;
- PRTAMIS ;Print UD AMIS summary
- +1 ;
- +2 SET PSUPGS("PG")=0
- +3 DO PGHDR1
- +4 SET PSUL=3
- +5 FOR
- SET PSUL=$ORDER(^XTMP("PSU_"_PSUJOB,"UDAMIS",PSUL))
- if PSUL=""
- QUIT
- Begin DoDot:1
- +6 ; leave a margin at the bottom
- IF LNCNT+4>IOSL
- DO PGHDR1
- +7 WRITE !,^XTMP("PSU_"_PSUJOB,"UDAMIS",PSUL)
- +8 SET LNCNT=LNCNT+1
- End DoDot:1
- +9 ;
- +10 QUIT
- +11 ;
- PRTDRUG ; Print the Drug summary by Drug by Division/Facility
- +1 ; Set page number to 0
- +2 SET PSUPGS("PG")=0
- +3 ;**1
- SET X=PSUFACN
- SET DIC=40.8
- SET DIC(0)="X"
- SET D="C"
- DO IX^DIC
- +4 SET X=+Y
- SET PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
- +5 ; Perform 1st page heading
- DO PGHDR
- +6 ; Report body starts at line 8
- SET PSUL=7
- +7 FOR
- SET PSUL=$ORDER(^XTMP(PSUUDSUB,"DRUGSUM",PSUFACN,PSUL))
- if PSUL=""
- QUIT
- Begin DoDot:1
- +8 ; leave a margin at the bottom
- IF $Y+4>IOSL
- DO PGHDR
- +9 WRITE !,^XTMP(PSUUDSUB,"DRUGSUM",PSUFACN,PSUL)
- End DoDot:1
- +10 ;
- +11 QUIT
- +12 ;
- PGHDR ;Increment page number and Write Page Heading
- +1 ; Writes header lines 1 & 2, then page number, then lines 3 through 7
- +2 USE IO
- WRITE @IOF
- +3 FOR I=1:1:3
- WRITE !
- +4 ;Print 1st line
- WRITE !,^XTMP(PSUUDSUB,"DRUGSUM",PSUFACN,1)
- +5 ; add division name
- WRITE " for ",PSUDIVNM
- +6 SET PSUPGS("PG")=PSUPGS("PG")+1
- +7 WRITE !,^XTMP(PSUUDSUB,"DRUGSUM",PSUFACN,2),?72,"PAGE: ",PSUPGS("PG")
- +8 ;Print next 5 lines
- FOR PSUH=3:1:7
- WRITE !,$GET(^XTMP(PSUUDSUB,"DRUGSUM",PSUFACN,PSUH))
- +9 QUIT
- +10 ;
- PGHDR1 ;Page headers for AMIS summary report
- +1 ;
- +2 USE IO
- +3 WRITE @IOF
- +4 WRITE !,^XTMP("PSU_"_PSUJOB,"UDAMIS",1)
- +5 WRITE !!,?68,"Page: ",PSUPGS("PG")
- +6 SET PSUPGS("PG")=PSUPGS("PG")+1
- +7 WRITE !,$GET(^XTMP("PSU_"_PSUJOB,"UDAMIS",2))
- +8 SET LNCNT=3
- +9 QUIT