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
Q
;
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")
Q
;
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
Q
;
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
Q
;
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
Q
;
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
Q
;
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
Q
;
IPMSG ;Set UD inpatient division totals into message global
;
S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=" "_PSULBL_" Division:"_PSUTB1_PSUTTL
S I=I+1
Q
;
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
Q
;
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
Q
;
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
Q
;
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
Q
;
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
Q
;
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."
Q
;
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
Q
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
