PSUV5 ;BIR/PDW - Pharmacy Benefits Mgt IV Printer Output ;10 JUL 1999
 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
 ;DBIA(s)
 ; Reference to file #40.8 supported by DBIA 2438
 ;
EN ;EP entry for IV statistical output
 NEW PSUI,PSUH,PSUL,PSUM,PSUPGS,ENDIT
 D DT^DILF("E",PSUSDT,.EXTD)
 S PSURP("START")=EXTD(0)
 D DT^DILF("E",PSUEDT,.EXTD)
 S PSURP("END")=EXTD(0)
 ;I '$D(^XTMP(PSUIVSUB,"STATSUM")) D NOSUM
 S PSUFACN=""
 F  S PSUFACN=$O(^XTMP(PSUIVSUB,"STATSUM",PSUFACN)) Q:PSUFACN=""  D
 .;D PRTSUM  ;Eliminate this report with Phase II 7-19-04
 .I PSUSMRY Q  ;Quit if user requests the summary report only
 .D PRTDRUG
 ;
 I '$D(^XTMP("PSU_"_PSUJOB,"CBAMIS")) D PRTAMIS  ;Print IV AMIS summary
 ;
 D PULL^PSUCP
 F I=1:1:$L(PSUOPTS,",") S PSUMOD($P(PSUOPTS,",",I))=""
 ;
 I $D(PSUMOD(1))&'$D(PSUMOD(2)) D
 .I '$D(PSUMOD(4)) D
 ..D IVSUM^PSUDEM0
 ;
 Q
PRTSUM ;Print the statistical summary report
 U IO
 ;VMP-IOFO BAY PINES;ELR;PSU*3.0*26 REMOVED FORM FEED
 ;W @IOF
 D GETNAME
 S X=^XTMP(PSUIVSUB,"STATSUM",PSUFACN,1)
 W !,X_" for "_PSUDIVNM
 W !!,?68,"Page: 1"  ;Statistical summary will always be 1 page only
 S PSUL=1
 F  S PSUL=$O(^XTMP(PSUIVSUB,"STATSUM",PSUFACN,PSUL)) Q:PSUL=""  D
 .W !,^XTMP(PSUIVSUB,"STATSUM",PSUFACN,PSUL)
 ;
 Q
 ;
PRTAMIS ;Print the IV AMIS Summary report
 ;
 S PSUPGS("PG")=1
 D PGHDR1
 S PSUL=3
 F  S PSUL=$O(^XTMP("PSU_"_PSUJOB,"IVAMIS",PSUL)) Q:PSUL=""  D
 .I LNCNT+4>IOSL D PGHDR1
 .W !,^XTMP("PSU_"_PSUJOB,"IVAMIS",PSUL)
 .S LNCNT=LNCNT+1
 ;
 Q
 ;
PRTDRUG ;Print the Statistical Drug Report
 I '$D(^XTMP(PSUIVSUB,"DRUGSUM")) D NODRUG
 S PSUPGS("PG")=1
 D PGHDR
 S PSUL=5
 F  S PSUL=$O(^XTMP(PSUIVSUB,"DRUGSUM",PSUFACN,PSUL)) Q:PSUL=""  D
 .I LNCNT+4>IOSL D PGHDR
 .W !,^XTMP(PSUIVSUB,"DRUGSUM",PSUFACN,PSUL)
 .S LNCNT=LNCNT+1
 ;
 Q
PGHDR ;
 U IO W @IOF
 W !,^XTMP(PSUIVSUB,"DRUGSUM",PSUFACN,1)
 W " for ",PSUDIVNM
 W !!,?68,"Page: ",PSUPGS("PG")
 S PSUPGS("PG")=PSUPGS("PG")+1
 F PSUH=2:1:5 W !,$G(^XTMP(PSUIVSUB,"DRUGSUM",PSUFACN,PSUH))
 S LNCNT=5
 Q
PGHDR1 ;Print headings for statistical report
 U IO
 W @IOF
 W !,^XTMP("PSU_"_PSUJOB,"IVAMIS",1)
 W !!,?68,"Page: ",PSUPGS("PG")
 S PSUPGS("PG")=PSUPGS("PG")+1
 W !,$G(^XTMP("PSU_"_PSUJOB,"IVAMIS",2))
 S LNCNT=3
 Q
NOSUM ;Set up no data to report global if there is no statistical data
 S ^XTMP(PSUIVSUB,"STATSUM",PSUSNDR,1)="IV Statistical Data Summary for "_PSURP("START")_" through "_PSURP("END")
 S ^XTMP(PSUIVSUB,"STATSUM",PSUSNDR,2)=""
 S ^XTMP(PSUIVSUB,"STATSUM",PSUSNDR,3)="No data to report"
 S PSUFACN=PSUSNDR
 Q
NODRUG ;Set up the no data to report temp global if there is no drug data
 S ^XTMP(PSUIVSUB,"DRUGSUM",PSUSNDR,1)="IV Statistical Data for "_PSURP("START")_" through "_PSURP("END")
 S ^XTMP(PSUIVSUB,"DRUGSUM",PSUSNDR,2)=""
 S ^XTMP(PSUIVSUB,"DRUGSUM",PSUSNDR,3)="No data to report"
 S PSUFACN=PSUSNDR
GETNAME ;Get the facility name
 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)
 Q
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSUV5   3040     printed  Sep 23, 2025@20:04:30                                                                                                                                                                                                       Page 2
PSUV5     ;BIR/PDW - Pharmacy Benefits Mgt IV Printer Output ;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       ;
EN        ;EP entry for IV statistical output
 +1        NEW PSUI,PSUH,PSUL,PSUM,PSUPGS,ENDIT
 +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       ;I '$D(^XTMP(PSUIVSUB,"STATSUM")) D NOSUM
 +7        SET PSUFACN=""
 +8        FOR 
               SET PSUFACN=$ORDER(^XTMP(PSUIVSUB,"STATSUM",PSUFACN))
               if PSUFACN=""
                   QUIT 
               Begin DoDot:1
 +9       ;D PRTSUM  ;Eliminate this report with Phase II 7-19-04
 +10      ;Quit if user requests the summary report only
                   IF PSUSMRY
                       QUIT 
 +11               DO PRTDRUG
               End DoDot:1
 +12      ;
 +13      ;Print IV AMIS summary
           IF '$DATA(^XTMP("PSU_"_PSUJOB,"CBAMIS"))
               DO PRTAMIS
 +14      ;
 +15       DO PULL^PSUCP
 +16       FOR I=1:1:$LENGTH(PSUOPTS,",")
               SET PSUMOD($PIECE(PSUOPTS,",",I))=""
 +17      ;
 +18       IF $DATA(PSUMOD(1))&'$DATA(PSUMOD(2))
               Begin DoDot:1
 +19               IF '$DATA(PSUMOD(4))
                       Begin DoDot:2
 +20                       DO IVSUM^PSUDEM0
                       End DoDot:2
               End DoDot:1
 +21      ;
 +22       QUIT 
PRTSUM    ;Print the statistical summary report
 +1        USE IO
 +2       ;VMP-IOFO BAY PINES;ELR;PSU*3.0*26 REMOVED FORM FEED
 +3       ;W @IOF
 +4        DO GETNAME
 +5        SET X=^XTMP(PSUIVSUB,"STATSUM",PSUFACN,1)
 +6        WRITE !,X_" for "_PSUDIVNM
 +7       ;Statistical summary will always be 1 page only
           WRITE !!,?68,"Page: 1"
 +8        SET PSUL=1
 +9        FOR 
               SET PSUL=$ORDER(^XTMP(PSUIVSUB,"STATSUM",PSUFACN,PSUL))
               if PSUL=""
                   QUIT 
               Begin DoDot:1
 +10               WRITE !,^XTMP(PSUIVSUB,"STATSUM",PSUFACN,PSUL)
               End DoDot:1
 +11      ;
 +12       QUIT 
 +13      ;
PRTAMIS   ;Print the IV AMIS Summary report
 +1       ;
 +2        SET PSUPGS("PG")=1
 +3        DO PGHDR1
 +4        SET PSUL=3
 +5        FOR 
               SET PSUL=$ORDER(^XTMP("PSU_"_PSUJOB,"IVAMIS",PSUL))
               if PSUL=""
                   QUIT 
               Begin DoDot:1
 +6                IF LNCNT+4>IOSL
                       DO PGHDR1
 +7                WRITE !,^XTMP("PSU_"_PSUJOB,"IVAMIS",PSUL)
 +8                SET LNCNT=LNCNT+1
               End DoDot:1
 +9       ;
 +10       QUIT 
 +11      ;
PRTDRUG   ;Print the Statistical Drug Report
 +1        IF '$DATA(^XTMP(PSUIVSUB,"DRUGSUM"))
               DO NODRUG
 +2        SET PSUPGS("PG")=1
 +3        DO PGHDR
 +4        SET PSUL=5
 +5        FOR 
               SET PSUL=$ORDER(^XTMP(PSUIVSUB,"DRUGSUM",PSUFACN,PSUL))
               if PSUL=""
                   QUIT 
               Begin DoDot:1
 +6                IF LNCNT+4>IOSL
                       DO PGHDR
 +7                WRITE !,^XTMP(PSUIVSUB,"DRUGSUM",PSUFACN,PSUL)
 +8                SET LNCNT=LNCNT+1
               End DoDot:1
 +9       ;
 +10       QUIT 
PGHDR     ;
 +1        USE IO
           WRITE @IOF
 +2        WRITE !,^XTMP(PSUIVSUB,"DRUGSUM",PSUFACN,1)
 +3        WRITE " for ",PSUDIVNM
 +4        WRITE !!,?68,"Page: ",PSUPGS("PG")
 +5        SET PSUPGS("PG")=PSUPGS("PG")+1
 +6        FOR PSUH=2:1:5
               WRITE !,$GET(^XTMP(PSUIVSUB,"DRUGSUM",PSUFACN,PSUH))
 +7        SET LNCNT=5
 +8        QUIT 
PGHDR1    ;Print headings for statistical report
 +1        USE IO
 +2        WRITE @IOF
 +3        WRITE !,^XTMP("PSU_"_PSUJOB,"IVAMIS",1)
 +4        WRITE !!,?68,"Page: ",PSUPGS("PG")
 +5        SET PSUPGS("PG")=PSUPGS("PG")+1
 +6        WRITE !,$GET(^XTMP("PSU_"_PSUJOB,"IVAMIS",2))
 +7        SET LNCNT=3
 +8        QUIT 
NOSUM     ;Set up no data to report global if there is no statistical data
 +1        SET ^XTMP(PSUIVSUB,"STATSUM",PSUSNDR,1)="IV Statistical Data Summary for "_PSURP("START")_" through "_PSURP("END")
 +2        SET ^XTMP(PSUIVSUB,"STATSUM",PSUSNDR,2)=""
 +3        SET ^XTMP(PSUIVSUB,"STATSUM",PSUSNDR,3)="No data to report"
 +4        SET PSUFACN=PSUSNDR
 +5        QUIT 
NODRUG    ;Set up the no data to report temp global if there is no drug data
 +1        SET ^XTMP(PSUIVSUB,"DRUGSUM",PSUSNDR,1)="IV Statistical Data for "_PSURP("START")_" through "_PSURP("END")
 +2        SET ^XTMP(PSUIVSUB,"DRUGSUM",PSUSNDR,2)=""
 +3        SET ^XTMP(PSUIVSUB,"DRUGSUM",PSUSNDR,3)="No data to report"
 +4        SET PSUFACN=PSUSNDR
GETNAME   ;Get the facility name
 +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        QUIT