Routine: PSUSUM7

PSUSUM7 ;BIR/DAM - Pt. Demographics Summary for IV/RX or UD/RX ; 20 DEC 2001

 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005

EN ;EN CALLED FROM PSUOP0

 ;Q:$D(^XTMP("PSU_"_PSUJOB,"PSU_"_PSUJOB,"PSUMFLAG"))   ;Do not run if auto extract

 D PULL^PSUCP

 F I=1:1:$L(PSUOPTS,",") S PSUMOD($P(PSUOPTS,",",I))=""

 K ^XTMP("PSU_"_PSUJOB,"PSUSUMA")

 I $G(^XTMP("PSU_"_PSUJOB,"PSUFLAG2"))!$G(^XTMP("PSU_"_PSUJOB,"PSUFLAG3")) K ^XTMP("PSU_"_PSUJOB,"PSUSUMA")

 I $D(^XTMP("PSU_"_PSUJOB,"PSUNONE","RX")) D  Q

 .I $D(^XTMP("PSU_"_PSUJOB,"PSUNONE","IV"))!$D(^XTMP("PSU_"_PSUJOB,"PSUNONE","UD")) D

 ..D NODATA

 ..I $G(^XTMP("PSU_"_PSUJOB,"PSUFLAG1"))!$G(^XTMP("PSU_"_PSUJOB,"PSUFLAG2")) K ^XTMP("PSU_"_PSUJOB,"PSUNONE")

 D EN1

EN1 ;Gather summary data

 D DATE^PSUSUM6

 S I=7

 I $D(PSUMOD(1)) D UNIQUE1

 I '$D(PSUMOD(1)) D UNIQUE

 D TOP^PSUSUM6

 D OPDIV^PSUSUM6

 D DIVTOT^PSUSUM6

 D TUDIV

 I $D(PSUMOD(1)) D

 .D IPDIV2

 I $D(PSUMOD(2)) D

 .D IPDIV^PSUSUM6

 .D IPDIV1

 .D TAB4

 D PDSUM^PSUDEM5

 K ^XTMP("PSU_"_PSUJOB,"PSUTMP"),^XTMP("PSU_"_PSUJOB,"PSUTOTAL"),^XTMP("PSU_"_PSUJOB,"PSURXUNIQUE")

 K ^XTMP("PSU_"_PSUJOB,"PSURXTOTAL")

 K ^XTMP("PSU_"_PSUJOB,"PSURXCTA"),^XTMP("PSU_"_PSUJOB,"PSUIVINDIV")

 K ^XTMP("PSU_"_PSUJOB,"PSURXSSN"),^XTMP("PSU_"_PSUJOB,"PSUIVDIV"),^XTMP("PSU_"_PSUJOB,"PSUFLAG2")

 K ^XTMP("PSU_"_PSUJOB,"PSUFLAG3")

 K ^XTMP("PSU_"_PSUJOB,"PSUIVOUT"),^XTMP("PSU_"_PSUJOB,"PSUIVSSN"),^XTMP("PSU_"_PSUJOB,"PSUUDDIV")

UNIQUE ;Find total unique pharmacy patients across all divisions when

 ;UD and RX extracts are run together

 S PSURXN=0,PSUUDN1=0,PSUUDN2=0

 S N=1

 F  S PSURXN=$O(^XTMP("PSU_"_PSUJOB,"PSURXSSN",PSURXN)) Q:PSURXN=""  D

 .S ^XTMP("PSU_"_PSUJOB,"PSUTMP",PSURXN)=N S N=N+1

 .F  S PSUUDN1=$O(^XTMP("PSU_"_PSUJOB,"PSUUDSSN",PSUUDN1)) Q:PSUUDN1=""  D

 ..I '$D(^XTMP("PSU_"_PSUJOB,"PSUTMP",PSUUDN1)) S ^XTMP("PSU_"_PSUJOB,"PSUTMP",PSUUDN1)=N S N=N+1

 S ^XTMP("PSU_"_PSUJOB,"PSUTOTAL")=N-1

 D TAB2

 S $P(^XTMP("PSU_"_PSUJOB,"PSUSUMA",I),"-",70)="" S I=I+1

TAB2 ;Tab spacing for line 7.  Set line into global

 S PSUTB3=" "

 S PSUTB4="TOTAL Pharmacy patients across all divisions:"

 S PSUTB5=(64-$L(PSUTB4))-$L($P($G(^XTMP("PSU_"_PSUJOB,"PSUTOTAL")),U,1))

 F S3=1:1:(PSUTB5-1) S PSUTB(S3)=" " D

 .S PSUTB3=PSUTB3_PSUTB(S3)

 S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=PSUTB4_PSUTB3_$P($G(^XTMP("PSU_"_PSUJOB,"PSUTOTAL")),U,1)

 S I=I+1

UNIQUE1 ;Find total unique pharmacy patients across all divisions when

 ;IV and RX extracts are run together

 S PSURXN=0,PSUIVN=0

 S N=1

 F  S PSURXN=$O(^XTMP("PSU_"_PSUJOB,"PSURXSSN",PSURXN)) Q:PSURXN=""  D

 .S ^XTMP("PSU_"_PSUJOB,"PSUTMP",PSURXN)=N S N=N+1

 .F  S PSUIVN=$O(^XTMP("PSU_"_PSUJOB,"PSUIVSSN",PSUIVN)) Q:PSUIVN=""  D

 ..I '$D(^XTMP("PSU_"_PSUJOB,"PSUTMP",PSUIVN)) S ^XTMP("PSU_"_PSUJOB,"PSUTMP",PSUIVN)=N S N=N+1

 S ^XTMP("PSU_"_PSUJOB,"PSUTOTAL")=N-1

 S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)="TOTAL Pharmacy patients across all divisions:               "_$P($G(^XTMP("PSU_"_PSUJOB,"PSUTOTAL")),U,1) S I=I+1

 S $P(^XTMP("PSU_"_PSUJOB,"PSUSUMA",I),"-",70)="" S I=I+1

TUDIV ;Calculate total inpatient count and tab spacing for 'Total

 ;INPATIENT (UD or IV)' line and set into message global

 N PSUTB3,PSUTB4,PSUTB5,PSUDT

 I '$D(PSUMOD(1)) D

 .S PSUDT=$P($G(^XTMP("PSU_"_PSUJOB,"PSUUDSSN")),U) D

 ..S ^XTMP("PSU_"_PSUJOB,"PSUUDIVTOT")=PSUDT                 ;Total UD inpatient count

 I '$D(PSUMOD(2)) D

 .S ^XTMP("PSU_"_PSUJOB,"PSUUDIVTOT")=$P($G(^XTMP("PSU_"_PSUJOB,"PSUIVIN")),U,1)-1   ;Total IV inpatient count

 I '$G(^XTMP("PSU_"_PSUJOB,"PSUUDIVTOT")) S ^XTMP("PSU_"_PSUJOB,"PSUUDIVTOT")=0

 S PSUTB3=" "

 S PSUTB4="   Total INPATIENT (UD or IV):"

 S PSUTB5=(64-$L(PSUTB4))-$L($P($G(^XTMP("PSU_"_PSUJOB,"PSUUDIVTOT")),U,1))

 F S3=1:1:(PSUTB5-1) S PSUTB(S3)=" " D

 .S PSUTB3=PSUTB3_PSUTB(S3)                ;Tab position

 S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=PSUTB4_PSUTB3_$P($G(^XTMP("PSU_"_PSUJOB,"PSUUDIVTOT")),U,1) S I=I+1

 S $P(^XTMP("PSU_"_PSUJOB,"PSUSUMA",I),"-",70)="" S I=I+1

IPDIV1 ;Find UD inpatient division totals

 S PSULBL=0

 N PSUTTL

 I $D(PSUMOD(2)) D           ;UD inpatients

 .F  S PSULBL=$O(^XTMP("PSU_"_PSUJOB,"PSUUDDIV",PSULBL)) Q:PSULBL=""  D

 ..S PSUTTL=$P($G(^XTMP("PSU_"_PSUJOB,"PSUUDDIV",PSULBL)),U,1)

 ..D TAB1^PSUSUM6

 ..D IPMSG

IPMSG ;Set UD inpatient division totals into message global

 S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)="     "_PSULBL_" Division:"_PSUTB1_PSUTTL

 S I=I+1

IPDIV2 ;Calculate inpatient totals for IV divisions

 ;Construct a storage global containing unique IV inpatients

 ;per division

 S PSUDV=0

 F  S PSUDV=$O(^XTMP("PSU_"_PSUJOB,"PSUDIV1",PSUDV)) Q:PSUDV=""  D

 .S PSUPT=0

 .F  S PSUPT=$O(^XTMP("PSU_"_PSUJOB,"PSUDIV1",PSUDV,PSUPT)) Q:PSUPT=""  D

 ..S PSUPT1=0

 ..F  S PSUPT1=$O(^XTMP("PSU_"_PSUJOB,"PSUIN1",PSUPT1)) Q:PSUPT1=""  D

 ...I PSUPT1=PSUPT S ^XTMP("PSU_"_PSUJOB,"PSUDIV",PSUDV,PSUPT1)=""

 D IPDIV3

IPDIV3 ;Find unique inpatient count for each division

 S PSUCT1=0,PSUCT2=0,T=1

 F  S PSUCT1=$O(^XTMP("PSU_"_PSUJOB,"PSUDIV",PSUCT1)) Q:PSUCT1=""  D

 .F  S PSUCT2=$O(^XTMP("PSU_"_PSUJOB,"PSUDIV",PSUCT1,PSUCT2)) Q:PSUCT2=""  D

 ..S ^XTMP("PSU_"_PSUJOB,"PSUTOTAL1")=T S T=T+1    ;Total count

 ..I $D(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUCT1)) D

 ...S C=C+1

 ...S ^XTMP("PSU_"_PSUJOB,"PSUCT",PSUCT1)=C

 ..I '$D(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUCT1)) D

 ...S C=1

 ...S ^XTMP("PSU_"_PSUJOB,"PSUCT",PSUCT1)=C

 D DIVNUM

 D MSG

DIVNUM ;Set number of inpatients per division into summary message

 N PSUTB1,PSUTB2

 S N=1

 N PSUCT2

 S PSUDIVA1=0

 F  S PSUDIVA1=$O(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUDIVA1)) Q:PSUDIVA1=""  D

 .S PSUCT2=$P($G(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUDIVA1)),U,1)

 .D TAB5

 .S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)="     "_PSUDIVA1_" Division:"_PSUTB1_PSUCT2

 .S I=I+1

TAB5 ;Calculate tab spacing

 S PSUTB1=" "

 S PSUTB2=(59-$L(PSUCT2))-$L(PSUDIVA1)-10

 F S2=1:1:(PSUTB2-1) S PSUTB(S2)=" " D

 .S PSUTB1=PSUTB1_PSUTB(S2)                ;Tab position

TAB4 ;Calculate UD totals of all divisions and place in summary

 ;message

 S N=0,PSUMKER=0,R=1

 I $D(PSUMOD(2)) D

 .F  S PSUMKER=$O(^XTMP("PSU_"_PSUJOB,"PSUUDDIV",PSUMKER)) Q:PSUMKER=""  D

 ..S N=$P(^XTMP("PSU_"_PSUJOB,"PSUUDDIV",PSUMKER),U)+N

 ..S ^XTMP("PSU_"_PSUJOB,"PSUTOTAL1")=N                   ;Sum of all UD inpatients

 D MSG

MSG ;Final lines of message

 I '$D(^XTMP("PSU_"_PSUJOB,"PSUTOTAL1")) S ^XTMP("PSU_"_PSUJOB,"PSUTOTAL1")=0

 N PSUTB3,PSUTB4,PSUTB5

 S PSUTB3=" "

 S PSUTB4="     Inpatient Total of all Divisions:"

 S PSUTB5=(64-$L(PSUTB4))-$L($P($G(^XTMP("PSU_"_PSUJOB,"PSUTOTAL1")),U,1))

 F S3=1:1:(PSUTB5-1) S PSUTB(S3)=" " D

 .S PSUTB3=PSUTB3_PSUTB(S3)                ;Tab position

 S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)="                                                          ----------" S I=I+1

 S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=PSUTB4_PSUTB3_$P($G(^XTMP("PSU_"_PSUJOB,"PSUTOTAL1")),U,1) S I=I+1

 S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)="" S I=I+1

 S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)="**PLEASE NOTE: Final TOTAL may not match sum of all SUBTOTALS.  A patient may" S I=I+1

 S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)="have been provided pharmacy services at more than one outpatient and/or" S I=I+1

 S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)="inpatient division."

NODATA ;Summary report line to be sent if there is no data

 S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",1)="PHARMACY UNIQUE PATIENTS REPORT"

 S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",2)=" "

 S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",3)="No data to report"

 D PDSUM^PSUDEM5

PSUSUM7   ;BIR/DAM - Pt. Demographics Summary for IV/RX or UD/RX ; 20 DEC 2001

 +1       ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005

 +2       ;

EN        ;EN CALLED FROM PSUOP0

 +1       ;Q:$D(^XTMP("PSU_"_PSUJOB,"PSU_"_PSUJOB,"PSUMFLAG"))   ;Do not run if auto extract

 +2       ;

 +3        DO PULL^PSUCP

 +4        FOR I=1:1:$LENGTH(PSUOPTS,",")

               SET PSUMOD($PIECE(PSUOPTS,",",I))=""

 +5       ;

 +6        KILL ^XTMP("PSU_"_PSUJOB,"PSUSUMA")

 +7        IF $GET(^XTMP("PSU_"_PSUJOB,"PSUFLAG2"))!$GET(^XTMP("PSU_"_PSUJOB,"PSUFLAG3"))

               KILL ^XTMP("PSU_"_PSUJOB,"PSUSUMA")

 +8        IF $DATA(^XTMP("PSU_"_PSUJOB,"PSUNONE","RX"))

               Begin DoDot:1

 +9                IF $DATA(^XTMP("PSU_"_PSUJOB,"PSUNONE","IV"))!$DATA(^XTMP("PSU_"_PSUJOB,"PSUNONE","UD"))

                       Begin DoDot:2

 +10                       DO NODATA

 +11                       IF $GET(^XTMP("PSU_"_PSUJOB,"PSUFLAG1"))!$GET(^XTMP("PSU_"_PSUJOB,"PSUFLAG2"))

                               KILL ^XTMP("PSU_"_PSUJOB,"PSUNONE")

                       End DoDot:2

               End DoDot:1

               QUIT

 +12      ;

 +13       DO EN1

 +14       QUIT

 +15      ;

EN1       ;Gather summary data

 +1        DO DATE^PSUSUM6

 +2        SET I=7

 +3        IF $DATA(PSUMOD(1))

               DO UNIQUE1

 +4        IF '$DATA(PSUMOD(1))

               DO UNIQUE

 +5        DO TOP^PSUSUM6

 +6        DO OPDIV^PSUSUM6

 +7        DO DIVTOT^PSUSUM6

 +8        DO TUDIV

 +9        IF $DATA(PSUMOD(1))

               Begin DoDot:1

 +10               DO IPDIV2

               End DoDot:1

 +11       IF $DATA(PSUMOD(2))

               Begin DoDot:1

 +12               DO IPDIV^PSUSUM6

 +13               DO IPDIV1

 +14               DO TAB4

               End DoDot:1

 +15       DO PDSUM^PSUDEM5

 +16       KILL ^XTMP("PSU_"_PSUJOB,"PSUTMP"),^XTMP("PSU_"_PSUJOB,"PSUTOTAL"),^XTMP("PSU_"_PSUJOB,"PSURXUNIQUE")

 +17       KILL ^XTMP("PSU_"_PSUJOB,"PSURXTOTAL")

 +18       KILL ^XTMP("PSU_"_PSUJOB,"PSURXCTA"),^XTMP("PSU_"_PSUJOB,"PSUIVINDIV")

 +19       KILL ^XTMP("PSU_"_PSUJOB,"PSURXSSN"),^XTMP("PSU_"_PSUJOB,"PSUIVDIV"),^XTMP("PSU_"_PSUJOB,"PSUFLAG2")

 +20       KILL ^XTMP("PSU_"_PSUJOB,"PSUFLAG3")

 +21       KILL ^XTMP("PSU_"_PSUJOB,"PSUIVOUT"),^XTMP("PSU_"_PSUJOB,"PSUIVSSN"),^XTMP("PSU_"_PSUJOB,"PSUUDDIV")

 +22       QUIT

 +23      ;

UNIQUE    ;Find total unique pharmacy patients across all divisions when

 +1       ;UD and RX extracts are run together

 +2       ;

 +3        SET PSURXN=0

           SET PSUUDN1=0

           SET PSUUDN2=0

 +4       ;

 +5        SET N=1

 +6        FOR

               SET PSURXN=$ORDER(^XTMP("PSU_"_PSUJOB,"PSURXSSN",PSURXN))

               IF PSURXN=""

                   QUIT

               Begin DoDot:1

 +7                SET ^XTMP("PSU_"_PSUJOB,"PSUTMP",PSURXN)=N

                   SET N=N+1

 +8                FOR

                       SET PSUUDN1=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUUDSSN",PSUUDN1))

                       IF PSUUDN1=""

                           QUIT

                       Begin DoDot:2

 +9                        IF '$DATA(^XTMP("PSU_"_PSUJOB,"PSUTMP",PSUUDN1))

                               SET ^XTMP("PSU_"_PSUJOB,"PSUTMP",PSUUDN1)=N

                               SET N=N+1

                       End DoDot:2

               End DoDot:1

 +10      ;

 +11       SET ^XTMP("PSU_"_PSUJOB,"PSUTOTAL")=N-1

 +12       DO TAB2

 +13       SET $PIECE(^XTMP("PSU_"_PSUJOB,"PSUSUMA",I),"-",70)=""

           SET I=I+1

 +14       QUIT

 +15      ;

TAB2      ;Tab spacing for line 7.  Set line into global

 +1       ;

 +2        SET PSUTB3=" "

 +3        SET PSUTB4="TOTAL Pharmacy patients across all divisions:"

 +4        SET PSUTB5=(64-$LENGTH(PSUTB4))-$LENGTH($PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSUTOTAL")),U,1))

 +5        FOR S3=1:1:(PSUTB5-1)

               SET PSUTB(S3)=" "

               Begin DoDot:1

 +6                SET PSUTB3=PSUTB3_PSUTB(S3)

               End DoDot:1

 +7        SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=PSUTB4_PSUTB3_$PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSUTOTAL")),U,1)

 +8        SET I=I+1

 +9        QUIT

 +10      ;

UNIQUE1   ;Find total unique pharmacy patients across all divisions when

 +1       ;IV and RX extracts are run together

 +2       ;

 +3        SET PSURXN=0

           SET PSUIVN=0

 +4       ;

 +5        SET N=1

 +6       ;

 +7        FOR

               SET PSURXN=$ORDER(^XTMP("PSU_"_PSUJOB,"PSURXSSN",PSURXN))

               IF PSURXN=""

                   QUIT

               Begin DoDot:1

 +8                SET ^XTMP("PSU_"_PSUJOB,"PSUTMP",PSURXN)=N

                   SET N=N+1

 +9                FOR

                       SET PSUIVN=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUIVSSN",PSUIVN))

                       IF PSUIVN=""

                           QUIT

                       Begin DoDot:2

 +10                       IF '$DATA(^XTMP("PSU_"_PSUJOB,"PSUTMP",PSUIVN))

                               SET ^XTMP("PSU_"_PSUJOB,"PSUTMP",PSUIVN)=N

                               SET N=N+1

                       End DoDot:2

               End DoDot:1

 +11      ;

 +12       SET ^XTMP("PSU_"_PSUJOB,"PSUTOTAL")=N-1

 +13       SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)="TOTAL Pharmacy patients across all divisions:               "_$PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSUTOTAL")),U,1)

           SET I=I+1

 +14       SET $PIECE(^XTMP("PSU_"_PSUJOB,"PSUSUMA",I),"-",70)=""

           SET I=I+1

 +15       QUIT

 +16      ;

TUDIV     ;Calculate total inpatient count and tab spacing for 'Total

 +1       ;INPATIENT (UD or IV)' line and set into message global

 +2       ;

 +3        NEW PSUTB3,PSUTB4,PSUTB5,PSUDT

 +4       ;

 +5        IF '$DATA(PSUMOD(1))

               Begin DoDot:1

 +6                SET PSUDT=$PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSUUDSSN")),U)

                   Begin DoDot:2

 +7       ;Total UD inpatient count

                       SET ^XTMP("PSU_"_PSUJOB,"PSUUDIVTOT")=PSUDT

                   End DoDot:2

               End DoDot:1

 +8       ;

 +9        IF '$DATA(PSUMOD(2))

               Begin DoDot:1

 +10      ;Total IV inpatient count

                   SET ^XTMP("PSU_"_PSUJOB,"PSUUDIVTOT")=$PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSUIVIN")),U,1)-1

               End DoDot:1

 +11      ;

 +12       IF '$GET(^XTMP("PSU_"_PSUJOB,"PSUUDIVTOT"))

               SET ^XTMP("PSU_"_PSUJOB,"PSUUDIVTOT")=0

 +13       SET PSUTB3=" "

 +14       SET PSUTB4="   Total INPATIENT (UD or IV):"

 +15       SET PSUTB5=(64-$LENGTH(PSUTB4))-$LENGTH($PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSUUDIVTOT")),U,1))

 +16       FOR S3=1:1:(PSUTB5-1)

               SET PSUTB(S3)=" "

               Begin DoDot:1

 +17      ;Tab position

                   SET PSUTB3=PSUTB3_PSUTB(S3)

               End DoDot:1

 +18      ;

 +19       SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=PSUTB4_PSUTB3_$PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSUUDIVTOT")),U,1)

           SET I=I+1

 +20       SET $PIECE(^XTMP("PSU_"_PSUJOB,"PSUSUMA",I),"-",70)=""

           SET I=I+1

 +21       QUIT

 +22      ;

IPDIV1    ;Find UD inpatient division totals

 +1       ;

 +2        SET PSULBL=0

 +3        NEW PSUTTL

 +4       ;

 +5       ;UD inpatients

           IF $DATA(PSUMOD(2))

               Begin DoDot:1

 +6                FOR

                       SET PSULBL=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUUDDIV",PSULBL))

                       IF PSULBL=""

                           QUIT

                       Begin DoDot:2

 +7                        SET PSUTTL=$PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSUUDDIV",PSULBL)),U,1)

 +8                        DO TAB1^PSUSUM6

 +9                        DO IPMSG

                       End DoDot:2

               End DoDot:1

 +10       QUIT

 +11      ;

IPMSG     ;Set UD inpatient division totals into message global

 +1       ;

 +2        SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)="     "_PSULBL_" Division:"_PSUTB1_PSUTTL

 +3        SET I=I+1

 +4        QUIT

 +5       ;

IPDIV2    ;Calculate inpatient totals for IV divisions

 +1       ;

 +2       ;

 +3       ;Construct a storage global containing unique IV inpatients

 +4       ;per division

 +5        SET PSUDV=0

 +6        FOR

               SET PSUDV=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUDIV1",PSUDV))

               IF PSUDV=""

                   QUIT

               Begin DoDot:1

 +7                SET PSUPT=0

 +8                FOR

                       SET PSUPT=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUDIV1",PSUDV,PSUPT))

                       IF PSUPT=""

                           QUIT

                       Begin DoDot:2

 +9                        SET PSUPT1=0

 +10                       FOR

                               SET PSUPT1=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUIN1",PSUPT1))

                               IF PSUPT1=""

                                   QUIT

                               Begin DoDot:3

 +11                               IF PSUPT1=PSUPT

                                       SET ^XTMP("PSU_"_PSUJOB,"PSUDIV",PSUDV,PSUPT1)=""

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +12       DO IPDIV3

 +13       QUIT

 +14      ;

IPDIV3    ;Find unique inpatient count for each division

 +1        SET PSUCT1=0

           SET PSUCT2=0

           SET T=1

 +2       ;

 +3        FOR

               SET PSUCT1=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUDIV",PSUCT1))

               IF PSUCT1=""

                   QUIT

               Begin DoDot:1

 +4                FOR

                       SET PSUCT2=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUDIV",PSUCT1,PSUCT2))

                       IF PSUCT2=""

                           QUIT

                       Begin DoDot:2

 +5       ;Total count

                           SET ^XTMP("PSU_"_PSUJOB,"PSUTOTAL1")=T

                           SET T=T+1

 +6                        IF $DATA(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUCT1))

                               Begin DoDot:3

 +7                                SET C=C+1

 +8                                SET ^XTMP("PSU_"_PSUJOB,"PSUCT",PSUCT1)=C

                               End DoDot:3

 +9                        IF '$DATA(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUCT1))

                               Begin DoDot:3

 +10                               SET C=1

 +11                               SET ^XTMP("PSU_"_PSUJOB,"PSUCT",PSUCT1)=C

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +12       DO DIVNUM

 +13       DO MSG

 +14       QUIT

 +15      ;

DIVNUM    ;Set number of inpatients per division into summary message

 +1       ;

 +2        NEW PSUTB1,PSUTB2

 +3        SET N=1

 +4       ;

 +5        NEW PSUCT2

 +6        SET PSUDIVA1=0

 +7        FOR

               SET PSUDIVA1=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUDIVA1))

               IF PSUDIVA1=""

                   QUIT

               Begin DoDot:1

 +8                SET PSUCT2=$PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUDIVA1)),U,1)

 +9                DO TAB5

 +10               SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)="     "_PSUDIVA1_" Division:"_PSUTB1_PSUCT2

 +11               SET I=I+1

               End DoDot:1

 +12       QUIT

 +13      ;

TAB5      ;Calculate tab spacing

 +1       ;

 +2        SET PSUTB1=" "

 +3        SET PSUTB2=(59-$LENGTH(PSUCT2))-$LENGTH(PSUDIVA1)-10

 +4        FOR S2=1:1:(PSUTB2-1)

               SET PSUTB(S2)=" "

               Begin DoDot:1

 +5       ;Tab position

                   SET PSUTB1=PSUTB1_PSUTB(S2)

               End DoDot:1

 +6        QUIT

 +7       ;

TAB4      ;Calculate UD totals of all divisions and place in summary

 +1       ;message

 +2       ;

 +3        SET N=0

           SET PSUMKER=0

           SET R=1

 +4       ;

 +5        IF $DATA(PSUMOD(2))

               Begin DoDot:1

 +6                FOR

                       SET PSUMKER=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUUDDIV",PSUMKER))

                       IF PSUMKER=""

                           QUIT

                       Begin DoDot:2

 +7                        SET N=$PIECE(^XTMP("PSU_"_PSUJOB,"PSUUDDIV",PSUMKER),U)+N

 +8       ;Sum of all UD inpatients

                           SET ^XTMP("PSU_"_PSUJOB,"PSUTOTAL1")=N

                       End DoDot:2

               End DoDot:1

 +9       ;

 +10       DO MSG

 +11       QUIT

 +12      ;

MSG       ;Final lines of message

 +1       ;

 +2        IF '$DATA(^XTMP("PSU_"_PSUJOB,"PSUTOTAL1"))

               SET ^XTMP("PSU_"_PSUJOB,"PSUTOTAL1")=0

 +3       ;

 +4        NEW PSUTB3,PSUTB4,PSUTB5

 +5       ;

 +6        SET PSUTB3=" "

 +7        SET PSUTB4="     Inpatient Total of all Divisions:"

 +8        SET PSUTB5=(64-$LENGTH(PSUTB4))-$LENGTH($PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSUTOTAL1")),U,1))

 +9        FOR S3=1:1:(PSUTB5-1)

               SET PSUTB(S3)=" "

               Begin DoDot:1

 +10      ;Tab position

                   SET PSUTB3=PSUTB3_PSUTB(S3)

               End DoDot:1

 +11       SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)="                                                          ----------"

           SET I=I+1

 +12       SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=PSUTB4_PSUTB3_$PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSUTOTAL1")),U,1)

           SET I=I+1

 +13       SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=""

           SET I=I+1

 +14       SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)="**PLEASE NOTE: Final TOTAL may not match sum of all SUBTOTALS.  A patient may"

           SET I=I+1

 +15       SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)="have been provided pharmacy services at more than one outpatient and/or"

           SET I=I+1

 +16       SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)="inpatient division."

 +17       QUIT

 +18      ;

NODATA    ;Summary report line to be sent if there is no data

 +1       ;

 +2        SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",1)="PHARMACY UNIQUE PATIENTS REPORT"

 +3        SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",2)=" "

 +4        SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",3)="No data to report"

 +5        DO PDSUM^PSUDEM5

 +6        QUIT

PSUSUM7.m