Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSUUD5

PSUUD5.m

Go to the documentation of this file.
  1. PSUUD5 ;BIR/REG - UNIT DOSE PRINTER MODULE ;10 JUL 1999
  1. ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
  1. ;DBIA(s)
  1. ; Reference to file #40.8 supported by DBIA 2438
  1. ;
  1. ;PRINT CYCLE CONTROLLER FOR UNIT DOSE SUMMARY REPORT
  1. ;
  1. EP ;Print Unit Dose Statistical Report by Drug and Summary Report
  1. ;Printing Device should be opened by PSUDBQUE by new & IO set
  1. ;The ^XTMP global contains print lines by drug by division
  1. ;Lines 1 through 7 are page heading lines for the summary by drug by
  1. ;division; The Summary Report by division only is only 6 lines
  1. ;Package variables are set by calling routine prior to call.
  1. NEW PSUI,PSUH,PSUL,PSUM,PSUPGS,PSUUDFLG
  1. S PSUUDFLG=1 ;Flag for summary reports
  1. D DT^DILF("E",PSUSDT,.EXTD)
  1. S PSURP("START")=EXTD(0)
  1. D DT^DILF("E",PSUEDT,.EXTD)
  1. S PSURP("END")=EXTD(0)
  1. U IO
  1. ;
  1. PRTSUMS ;
  1. ; Find first Division/Facility in the summary by division
  1. ; then DO the PRTALL routine
  1. S PSUUDSUB="PSUUD_"_PSUJOB
  1. ;
  1. I '$D(^XTMP("PSU_"_PSUJOB,"CBAMIS")) D PRTAMIS ;Print UD AMIS SUMMARY
  1. ;
  1. ; Find the first Division/Facility in the summary by drug by division
  1. ; then DO the PRTDRUG routine
  1. Q:PSUSMRY ; 'summary only' was selected don't print 'by drug'
  1. S PSUFACN=""
  1. I '$D(^XTMP(PSUUDSUB,"DRUGSUM")) D
  1. .S ^XTMP("PSU_"_PSUJOB,"PSUNONE1")=""
  1. .S ^XTMP(PSUUDSUB,"DRUGSUM",PSUSNDR,1)="Unit Dose Statistical Data for "_PSURP("START")_" through "_PSURP("END")
  1. .S ^XTMP(PSUUDSUB,"DRUGSUM",PSUSNDR,2)=" "
  1. .S ^XTMP(PSUUDSUB,"DRUGSUM",PSUSNDR,3)="No data to report"
  1. F S PSUFACN=$O(^XTMP(PSUUDSUB,"DRUGSUM",PSUFACN)) Q:PSUFACN="" D PRTDRUG
  1. ;
  1. ;
  1. D PULL^PSUCP
  1. F I=1:1:$L(PSUOPTS,",") S PSUMOD($P(PSUOPTS,",",I))=""
  1. ;Print routine for Pt. demographics summary/No data when user selects
  1. ;(1)IV and (2)UD
  1. I $D(PSUMOD(1))&$D(PSUMOD(2)) D
  1. .I '$D(PSUMOD(4)) D
  1. ..D IVSUM^PSUDEM0
  1. ;
  1. ;Print routine for Pt. demographics summary/No data when user selects
  1. ;(2)UD only
  1. I $D(PSUMOD(2))&'$D(PSUMOD(1)) D
  1. .I '$D(PSUMOD(4)) D
  1. ..D IVSUM^PSUDEM0
  1. ;
  1. PRTSUMX ; EXIT PSUUD5
  1. ;W @IOF
  1. Q
  1. ;
  1. PRTALL ; Print the Drug summary of all drugs by Division/Facility
  1. S X=PSUFACN,DIC=40.8,DIC(0)="X",D="C" D IX^DIC ;**1
  1. S X=+Y S PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
  1. W @IOF
  1. F I=1:1:3 W !
  1. S PSUL=""
  1. F S PSUL=$O(^XTMP(PSUUDSUB,"STATSUM",PSUFACN,PSUL)) Q:PSUL="" D
  1. .S X=^XTMP(PSUUDSUB,"STATSUM",PSUFACN,PSUL) W !,X
  1. .I PSUL=1 W " for ",PSUDIVNM,!,?72,"PAGE: 1" ; will only ever be one page
  1. Q
  1. ;
  1. PRTAMIS ;Print UD AMIS summary
  1. ;
  1. S PSUPGS("PG")=0
  1. D PGHDR1
  1. S PSUL=3
  1. F S PSUL=$O(^XTMP("PSU_"_PSUJOB,"UDAMIS",PSUL)) Q:PSUL="" D
  1. .I LNCNT+4>IOSL D PGHDR1 ; leave a margin at the bottom
  1. .W !,^XTMP("PSU_"_PSUJOB,"UDAMIS",PSUL)
  1. .S LNCNT=LNCNT+1
  1. ;
  1. Q
  1. ;
  1. PRTDRUG ; Print the Drug summary by Drug by Division/Facility
  1. ; Set page number to 0
  1. S PSUPGS("PG")=0
  1. S X=PSUFACN,DIC=40.8,DIC(0)="X",D="C" D IX^DIC ;**1
  1. S X=+Y S PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
  1. D PGHDR ; Perform 1st page heading
  1. S PSUL=7 ; Report body starts at line 8
  1. F S PSUL=$O(^XTMP(PSUUDSUB,"DRUGSUM",PSUFACN,PSUL)) Q:PSUL="" D
  1. .I $Y+4>IOSL D PGHDR ; leave a margin at the bottom
  1. .W !,^XTMP(PSUUDSUB,"DRUGSUM",PSUFACN,PSUL)
  1. ;
  1. Q
  1. ;
  1. PGHDR ;Increment page number and Write Page Heading
  1. ; Writes header lines 1 & 2, then page number, then lines 3 through 7
  1. U IO W @IOF
  1. F I=1:1:3 W !
  1. W !,^XTMP(PSUUDSUB,"DRUGSUM",PSUFACN,1) ;Print 1st line
  1. W " for ",PSUDIVNM ; add division name
  1. S PSUPGS("PG")=PSUPGS("PG")+1
  1. W !,^XTMP(PSUUDSUB,"DRUGSUM",PSUFACN,2),?72,"PAGE: ",PSUPGS("PG")
  1. F PSUH=3:1:7 W !,$G(^XTMP(PSUUDSUB,"DRUGSUM",PSUFACN,PSUH)) ;Print next 5 lines
  1. Q
  1. ;
  1. PGHDR1 ;Page headers for AMIS summary report
  1. ;
  1. U IO
  1. W @IOF
  1. W !,^XTMP("PSU_"_PSUJOB,"UDAMIS",1)
  1. W !!,?68,"Page: ",PSUPGS("PG")
  1. S PSUPGS("PG")=PSUPGS("PG")+1
  1. W !,$G(^XTMP("PSU_"_PSUJOB,"UDAMIS",2))
  1. S LNCNT=3
  1. Q