Routine: PSUV5

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

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)

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

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

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

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

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

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)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSUV5   3040     printed  Mar 13, 2025@21:33:19                                                                                                                                                                                                       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

PSUV5.m