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 Dec 13, 2024@02:28:40 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
