PSUSUM3 ;BIR/DAM - Patient Demographics Summary for UD Extract ; 20 DEC 2001
;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
;
;DBIA's
; Reference to file #55 supported by DBIA 3502
; Reference to file #42 supported by DBIA 1848
; Reference to file #40.8 supported by DBIA 1576
;
EN ;EN CALLED FROM PSUUD0
;Q:$D(^XTMP("PSU_"_PSUJOB,"PSUMFLAG")) ;Do not run if auto extract
;
D PULL^PSUCP
F I=1:1:$L(PSUOPTS,",") S PSUMOD($P(PSUOPTS,",",I))=""
;
I $D(^XTMP("PSU_"_PSUJOB,"PSUNONE","UD")) D Q ;report if there is no data
.I $D(PSUMOD(2))&'$D(PSUMOD(1)) D
..I '$D(PSUMOD(4)) D
...D NODATA D
....I $D(^XTMP("PSU_"_PSUJOB,"PSUFLAG1")) K ^XTMP("PSU_"_PSUJOB,"PSUNONE")
....K ^XTMP("PSU_"_PSUJOB,"PSUSUMA")
D EN1
Q
;
EN1 ;Entry point to collect data
D DATE
M ^XTMP("PSU_"_PSUJOB,"PSUUD")=^XTMP(PSUUDSUB)
D RE
D UNIQUE
S I=9 ;Line counter for division data in summary report
D DIVNUM
D TOTAL
D TAB1
;
I $D(PSUMOD(1))&$D(PSUMOD(2)) D
.I $D(PSUMOD(4)) D
..M ^XTMP("PSU_"_PSUJOB,"PSUUDDIV")=^XTMP("PSU_"_PSUJOB,"PSUCT")
..M ^XTMP("PSU_"_PSUJOB,"PSUUDSSN")=^XTMP("PSU_"_PSUJOB,"PSUIPT")
..M ^XTMP("PSU_"_PSUJOB,"PSUDIVUD")=^XTMP("PSU_"_PSUJOB,"PSUDIV")
;
I '$D(PSUMOD(1))&$D(PSUMOD(2)) D
.I $D(PSUMOD(4)) D
..M ^XTMP("PSU_"_PSUJOB,"PSUUDDIV")=^XTMP("PSU_"_PSUJOB,"PSUCT")
..M ^XTMP("PSU_"_PSUJOB,"PSUUDSSN")=^XTMP("PSU_"_PSUJOB,"PSUIPT")
;
I $D(PSUMOD(1))&$D(PSUMOD(2)) D
.I '$D(PSUMOD(4)) D
..M ^XTMP("PSU_"_PSUJOB,"PSUUDDIV")=^XTMP("PSU_"_PSUJOB,"PSUCT")
..M ^XTMP("PSU_"_PSUJOB,"PSUUDIN")=^XTMP("PSU_"_PSUJOB,"PSUIPT")
..M ^XTMP("PSU_"_PSUJOB,"PSUDIVUD")=^XTMP("PSU_"_PSUJOB,"PSUDIV")
;
I '$D(PSUMOD(1))&'$D(PSUMOD(4)) D
.D PDSUM^PSUDEM5 ;Mail message
.K ^XTMP("PSU_"_PSUJOB,"PSUUDDIV")
K ^XTMP("PSU_"_PSUJOB,"PSUUD")
I $D(^XTMP("PSU_"_PSUJOB,"PSUFLAG1")) K ^XTMP("PSU_"_PSUJOB,"PSUSUMA")
K ^XTMP("PSU_"_PSUJOB,"PSUFLAG1")
;K ^XTMP("PSU_"_PSUJOB,"PSUTOTAL")
K ^XTMP("PSU_"_PSUJOB,"PSUCT")
K ^XTMP("PSU_"_PSUJOB,"PSURXCTA")
Q
;
RE ;Rearrange the ^XTMP("PSU_"_PSUJOB,"PSUUD","DETAIL" global so information in PATDIV
;can be accessed quickly.
;
N PSUSIT
S PSUSIT=PSUSNDR
;D INST^PSUDEM1 S PSUSIT=$P(^XTMP("PSU_"_PSUJOB,"PSUSITE"),U,1)
;
N PSUSSNA,PSUUDA
S PSUPN1=0,PSUSIT1=0
F S PSUSIT1=$O(^XTMP("PSU_"_PSUJOB,"PSUUD","DETAIL",PSUSIT1)) Q:PSUSIT1="" D
.F S PSUPN1=$O(^XTMP("PSU_"_PSUJOB,"PSUUD","DETAIL",PSUSIT1,PSUPN1)) Q:PSUPN1="" D
..S PSUUDA=$P($G(^XTMP("PSU_"_PSUJOB,"PSUUD","DETAIL",PSUSIT1,PSUPN1)),U,4)
..S PSUSSNA=$P($G(^XTMP("PSU_"_PSUJOB,"PSUUD","DETAIL",PSUSIT1,PSUPN1)),U,5) D
...S PSUDFN=0
...F S PSUDFN=$O(^XTMP("PSU_"_PSUJOB,"PSUTDFN",PSUDFN)) Q:PSUDFN="" D
....S PSUSN=0
....F S PSUSN=$O(^XTMP("PSU_"_PSUJOB,"PSUTDFN",PSUDFN,PSUSN)) Q:PSUSN="" D
.....I PSUSN=PSUSSNA S ^XTMP("PSU_"_PSUJOB,"PSUORSN1",PSUDFN,PSUUDA)=PSUSN
.....;S ^XTMP("PSU_"_PSUJOB,"PSUORSN",PSUUDA)=PSUSSNA
Q
;
DATE ;Convert date range of extract to external format
;
S %H=$E($H,1,5) ;today's date
D YX^%DTC
N PSUD S PSUD=Y
;
S Y=PSUSDT ;Start date of extract
D DD^%DT
N PSUS S PSUS=Y
;
S Y=PSUEDT ;End date of extract
D DD^%DT
N PSUE S PSUE=Y
;
D UDSUM
Q
;
UDSUM ;Summary report header to be run if UD (Inpatient) extract is run
;
;Report header
S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",1)="PHARMACY INPATIENT (UD) UNIQUE PATIENTS REPORT "_PSUD
S $P(^XTMP("PSU_"_PSUJOB,"PSUSUMA",2),"-",80)="" ;Separator bar
S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",3)=" "_PSUS_" through "_PSUE
S $P(^XTMP("PSU_"_PSUJOB,"PSUSUMA",4),"=",80)=""
S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",5)=" UNIQUE"
S $P(^XTMP("PSU_"_PSUJOB,"PSUSUMA",6),"-",70)=""
Q
;
UNIQUE ;Find number of unique patients across all divisions
;
S PSUUDS=0
N PSUUDS3
F S PSUUDS=$O(^XTMP("PSU_"_PSUJOB,"PSUORSN1",PSUUDS)) Q:PSUUDS="" D
.S PSUUDS1=0
.S PSUUDS1=$O(^XTMP("PSU_"_PSUJOB,"PSUORSN1",PSUUDS,PSUUDS1)) Q:PSUUDS1="" D
..S PSUUDS3=$P($G(^XTMP("PSU_"_PSUJOB,"PSUORSN1",PSUUDS,PSUUDS1)),U,1)
..S ^XTMP("PSU_"_PSUJOB,"PSUIPT",PSUUDS3)="" ;Set up global for unique SSNs
.;S PSUUDS1=$P(^XTMP("PSU_"_PSUJOB,"PSUORSN",PSUUDS),U)
.;S ^XTMP("PSU_"_PSUJOB,"PSUIPT",PSUUDS1)="" ;Set up global for unique SSNs
;
S B=1
S PSUUDS2=0
F S PSUUDS2=$O(^XTMP("PSU_"_PSUJOB,"PSUIPT",PSUUDS2)) Q:PSUUDS2="" D
.S ^XTMP("PSU_"_PSUJOB,"PSUIPT")=B,B=B+1 ;B=total count unique patients
.D TAB2
S $P(^XTMP("PSU_"_PSUJOB,"PSUSUMA",8),"-",70)=""
Q
;
TAB2 ;Tab spacing for line 7. Set line into global
;
N PSUTB3,PSUTB4,PSUTB5
;
S PSUTB3=" "
S PSUTB4="TOTAL patients across all divisions:"
S PSUTB5=(64-$L(PSUTB4))-$L($P($G(^XTMP("PSU_"_PSUJOB,"PSUIPT")),U,1))
F S3=1:1:(PSUTB5-1) S PSUTB(S3)=" " D
.S PSUTB3=PSUTB3_PSUTB(S3)
S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",7)=PSUTB4_PSUTB3_$P($G(^XTMP("PSU_"_PSUJOB,"PSUIPT")),U,1)
Q
;
DIVNUM ;Set number of patients per division into summary message
;
N PSUTB1,PSUTB2
;
N PSUCT3
S PSUDIVA2=0
F S PSUDIVA2=$O(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUDIVA2)) Q:PSUDIVA2="" D
.S PSUCT3=$P($G(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUDIVA2)),U,1)
.D TAB
.S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=" "_PSUDIVA2_" Division:"_PSUTB1_PSUCT3
.S I=I+1
Q
;
TAB ;Calculate tab spacing
;
S PSUTB1=" "
S PSUTB2=(59-$L(PSUCT3))-$L(PSUDIVA2)-10
F S2=1:1:(PSUTB2-1) S PSUTB(S2)=" " D
.S PSUTB1=PSUTB1_PSUTB(S2) ;Tab position
Q
;
TOTAL ;EN Calculate Inpatient total of all divisions
;
N PSUIPCT
S PSUIPTOT=0
S PSUTOCT1=0
F S PSUIPTOT=$O(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUIPTOT)) Q:PSUIPTOT="" D
.S PSUIPCT=$P($G(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUIPTOT)),U,1)
.S PSUTOCT1=PSUTOCT1+PSUIPCT
S $P(^XTMP("PSU_"_PSUJOB,"PSUTOTAL"),U,1)=PSUTOCT1
Q
;
TAB1 ;EN Calculate tab spacing for 'Outpatient Total of all Divisions' line.
;and set the last lines of message into the summary global.
;
N PSUTB3,PSUTB4,PSUTB5
;
I '$G(^XTMP("PSU_"_PSUJOB,"PSUTOTAL")) D
.S ^XTMP("PSU_"_PSUJOB,"PSUTOTAL")=0
S PSUTB3=" "
S PSUTB4=" Inpatient Total of 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) ;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,"PSUTOTAL")),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 INPATIENT (UD) UNIQUE PATIENTS REPORT"
S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",2)=" "
S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",3)="No data to report"
D PDSUM^PSUDEM5
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSUSUM3 7280 printed Apr 09, 2024@21:30:18 Page 2
PSUSUM3 ;BIR/DAM - Patient Demographics Summary for UD Extract ; 20 DEC 2001
+1 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
+2 ;
+3 ;DBIA's
+4 ; Reference to file #55 supported by DBIA 3502
+5 ; Reference to file #42 supported by DBIA 1848
+6 ; Reference to file #40.8 supported by DBIA 1576
+7 ;
EN ;EN CALLED FROM PSUUD0
+1 ;Q:$D(^XTMP("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 ;report if there is no data
IF $DATA(^XTMP("PSU_"_PSUJOB,"PSUNONE","UD"))
Begin DoDot:1
+7 IF $DATA(PSUMOD(2))&'$DATA(PSUMOD(1))
Begin DoDot:2
+8 IF '$DATA(PSUMOD(4))
Begin DoDot:3
+9 DO NODATA
Begin DoDot:4
+10 IF $DATA(^XTMP("PSU_"_PSUJOB,"PSUFLAG1"))
KILL ^XTMP("PSU_"_PSUJOB,"PSUNONE")
+11 KILL ^XTMP("PSU_"_PSUJOB,"PSUSUMA")
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
QUIT
+12 DO EN1
+13 QUIT
+14 ;
EN1 ;Entry point to collect data
+1 DO DATE
+2 MERGE ^XTMP("PSU_"_PSUJOB,"PSUUD")=^XTMP(PSUUDSUB)
+3 DO RE
+4 DO UNIQUE
+5 ;Line counter for division data in summary report
SET I=9
+6 DO DIVNUM
+7 DO TOTAL
+8 DO TAB1
+9 ;
+10 IF $DATA(PSUMOD(1))&$DATA(PSUMOD(2))
Begin DoDot:1
+11 IF $DATA(PSUMOD(4))
Begin DoDot:2
+12 MERGE ^XTMP("PSU_"_PSUJOB,"PSUUDDIV")=^XTMP("PSU_"_PSUJOB,"PSUCT")
+13 MERGE ^XTMP("PSU_"_PSUJOB,"PSUUDSSN")=^XTMP("PSU_"_PSUJOB,"PSUIPT")
+14 MERGE ^XTMP("PSU_"_PSUJOB,"PSUDIVUD")=^XTMP("PSU_"_PSUJOB,"PSUDIV")
End DoDot:2
End DoDot:1
+15 ;
+16 IF '$DATA(PSUMOD(1))&$DATA(PSUMOD(2))
Begin DoDot:1
+17 IF $DATA(PSUMOD(4))
Begin DoDot:2
+18 MERGE ^XTMP("PSU_"_PSUJOB,"PSUUDDIV")=^XTMP("PSU_"_PSUJOB,"PSUCT")
+19 MERGE ^XTMP("PSU_"_PSUJOB,"PSUUDSSN")=^XTMP("PSU_"_PSUJOB,"PSUIPT")
End DoDot:2
End DoDot:1
+20 ;
+21 IF $DATA(PSUMOD(1))&$DATA(PSUMOD(2))
Begin DoDot:1
+22 IF '$DATA(PSUMOD(4))
Begin DoDot:2
+23 MERGE ^XTMP("PSU_"_PSUJOB,"PSUUDDIV")=^XTMP("PSU_"_PSUJOB,"PSUCT")
+24 MERGE ^XTMP("PSU_"_PSUJOB,"PSUUDIN")=^XTMP("PSU_"_PSUJOB,"PSUIPT")
+25 MERGE ^XTMP("PSU_"_PSUJOB,"PSUDIVUD")=^XTMP("PSU_"_PSUJOB,"PSUDIV")
End DoDot:2
End DoDot:1
+26 ;
+27 IF '$DATA(PSUMOD(1))&'$DATA(PSUMOD(4))
Begin DoDot:1
+28 ;Mail message
DO PDSUM^PSUDEM5
+29 KILL ^XTMP("PSU_"_PSUJOB,"PSUUDDIV")
End DoDot:1
+30 KILL ^XTMP("PSU_"_PSUJOB,"PSUUD")
+31 IF $DATA(^XTMP("PSU_"_PSUJOB,"PSUFLAG1"))
KILL ^XTMP("PSU_"_PSUJOB,"PSUSUMA")
+32 KILL ^XTMP("PSU_"_PSUJOB,"PSUFLAG1")
+33 ;K ^XTMP("PSU_"_PSUJOB,"PSUTOTAL")
+34 KILL ^XTMP("PSU_"_PSUJOB,"PSUCT")
+35 KILL ^XTMP("PSU_"_PSUJOB,"PSURXCTA")
+36 QUIT
+37 ;
RE ;Rearrange the ^XTMP("PSU_"_PSUJOB,"PSUUD","DETAIL" global so information in PATDIV
+1 ;can be accessed quickly.
+2 ;
+3 NEW PSUSIT
+4 SET PSUSIT=PSUSNDR
+5 ;D INST^PSUDEM1 S PSUSIT=$P(^XTMP("PSU_"_PSUJOB,"PSUSITE"),U,1)
+6 ;
+7 NEW PSUSSNA,PSUUDA
+8 SET PSUPN1=0
SET PSUSIT1=0
+9 FOR
SET PSUSIT1=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUUD","DETAIL",PSUSIT1))
if PSUSIT1=""
QUIT
Begin DoDot:1
+10 FOR
SET PSUPN1=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUUD","DETAIL",PSUSIT1,PSUPN1))
if PSUPN1=""
QUIT
Begin DoDot:2
+11 SET PSUUDA=$PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSUUD","DETAIL",PSUSIT1,PSUPN1)),U,4)
+12 SET PSUSSNA=$PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSUUD","DETAIL",PSUSIT1,PSUPN1)),U,5)
Begin DoDot:3
+13 SET PSUDFN=0
+14 FOR
SET PSUDFN=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUTDFN",PSUDFN))
if PSUDFN=""
QUIT
Begin DoDot:4
+15 SET PSUSN=0
+16 FOR
SET PSUSN=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUTDFN",PSUDFN,PSUSN))
if PSUSN=""
QUIT
Begin DoDot:5
+17 IF PSUSN=PSUSSNA
SET ^XTMP("PSU_"_PSUJOB,"PSUORSN1",PSUDFN,PSUUDA)=PSUSN
+18 ;S ^XTMP("PSU_"_PSUJOB,"PSUORSN",PSUUDA)=PSUSSNA
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+19 QUIT
+20 ;
DATE ;Convert date range of extract to external format
+1 ;
+2 ;today's date
SET %H=$EXTRACT($HOROLOG,1,5)
+3 DO YX^%DTC
+4 NEW PSUD
SET PSUD=Y
+5 ;
+6 ;Start date of extract
SET Y=PSUSDT
+7 DO DD^%DT
+8 NEW PSUS
SET PSUS=Y
+9 ;
+10 ;End date of extract
SET Y=PSUEDT
+11 DO DD^%DT
+12 NEW PSUE
SET PSUE=Y
+13 ;
+14 DO UDSUM
+15 QUIT
+16 ;
UDSUM ;Summary report header to be run if UD (Inpatient) extract is run
+1 ;
+2 ;Report header
+3 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",1)="PHARMACY INPATIENT (UD) UNIQUE PATIENTS REPORT "_PSUD
+4 ;Separator bar
SET $PIECE(^XTMP("PSU_"_PSUJOB,"PSUSUMA",2),"-",80)=""
+5 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",3)=" "_PSUS_" through "_PSUE
+6 SET $PIECE(^XTMP("PSU_"_PSUJOB,"PSUSUMA",4),"=",80)=""
+7 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",5)=" UNIQUE"
+8 SET $PIECE(^XTMP("PSU_"_PSUJOB,"PSUSUMA",6),"-",70)=""
+9 QUIT
+10 ;
UNIQUE ;Find number of unique patients across all divisions
+1 ;
+2 SET PSUUDS=0
+3 NEW PSUUDS3
+4 FOR
SET PSUUDS=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUORSN1",PSUUDS))
if PSUUDS=""
QUIT
Begin DoDot:1
+5 SET PSUUDS1=0
+6 SET PSUUDS1=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUORSN1",PSUUDS,PSUUDS1))
if PSUUDS1=""
QUIT
Begin DoDot:2
+7 SET PSUUDS3=$PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSUORSN1",PSUUDS,PSUUDS1)),U,1)
+8 ;Set up global for unique SSNs
SET ^XTMP("PSU_"_PSUJOB,"PSUIPT",PSUUDS3)=""
End DoDot:2
+9 ;S PSUUDS1=$P(^XTMP("PSU_"_PSUJOB,"PSUORSN",PSUUDS),U)
+10 ;S ^XTMP("PSU_"_PSUJOB,"PSUIPT",PSUUDS1)="" ;Set up global for unique SSNs
End DoDot:1
+11 ;
+12 SET B=1
+13 SET PSUUDS2=0
+14 FOR
SET PSUUDS2=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUIPT",PSUUDS2))
if PSUUDS2=""
QUIT
Begin DoDot:1
+15 ;B=total count unique patients
SET ^XTMP("PSU_"_PSUJOB,"PSUIPT")=B
SET B=B+1
+16 DO TAB2
End DoDot:1
+17 SET $PIECE(^XTMP("PSU_"_PSUJOB,"PSUSUMA",8),"-",70)=""
+18 QUIT
+19 ;
TAB2 ;Tab spacing for line 7. Set line into global
+1 ;
+2 NEW PSUTB3,PSUTB4,PSUTB5
+3 ;
+4 SET PSUTB3=" "
+5 SET PSUTB4="TOTAL patients across all divisions:"
+6 SET PSUTB5=(64-$LENGTH(PSUTB4))-$LENGTH($PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSUIPT")),U,1))
+7 FOR S3=1:1:(PSUTB5-1)
SET PSUTB(S3)=" "
Begin DoDot:1
+8 SET PSUTB3=PSUTB3_PSUTB(S3)
End DoDot:1
+9 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",7)=PSUTB4_PSUTB3_$PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSUIPT")),U,1)
+10 QUIT
+11 ;
DIVNUM ;Set number of patients per division into summary message
+1 ;
+2 NEW PSUTB1,PSUTB2
+3 ;
+4 NEW PSUCT3
+5 SET PSUDIVA2=0
+6 FOR
SET PSUDIVA2=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUDIVA2))
if PSUDIVA2=""
QUIT
Begin DoDot:1
+7 SET PSUCT3=$PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUDIVA2)),U,1)
+8 DO TAB
+9 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=" "_PSUDIVA2_" Division:"_PSUTB1_PSUCT3
+10 SET I=I+1
End DoDot:1
+11 QUIT
+12 ;
TAB ;Calculate tab spacing
+1 ;
+2 SET PSUTB1=" "
+3 SET PSUTB2=(59-$LENGTH(PSUCT3))-$LENGTH(PSUDIVA2)-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 ;
TOTAL ;EN Calculate Inpatient total of all divisions
+1 ;
+2 NEW PSUIPCT
+3 SET PSUIPTOT=0
+4 SET PSUTOCT1=0
+5 FOR
SET PSUIPTOT=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUIPTOT))
if PSUIPTOT=""
QUIT
Begin DoDot:1
+6 SET PSUIPCT=$PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUIPTOT)),U,1)
+7 SET PSUTOCT1=PSUTOCT1+PSUIPCT
End DoDot:1
+8 SET $PIECE(^XTMP("PSU_"_PSUJOB,"PSUTOTAL"),U,1)=PSUTOCT1
+9 QUIT
+10 ;
TAB1 ;EN Calculate tab spacing for 'Outpatient Total of all Divisions' line.
+1 ;and set the last lines of message into the summary global.
+2 ;
+3 NEW PSUTB3,PSUTB4,PSUTB5
+4 ;
+5 IF '$GET(^XTMP("PSU_"_PSUJOB,"PSUTOTAL"))
Begin DoDot:1
+6 SET ^XTMP("PSU_"_PSUJOB,"PSUTOTAL")=0
End DoDot:1
+7 SET PSUTB3=" "
+8 SET PSUTB4=" Inpatient Total of all Divisions:"
+9 SET PSUTB5=(64-$LENGTH(PSUTB4))-$LENGTH($PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSUTOTAL")),U,1))
+10 FOR S3=1:1:(PSUTB5-1)
SET PSUTB(S3)=" "
Begin DoDot:1
+11 ;Tab position
SET PSUTB3=PSUTB3_PSUTB(S3)
End DoDot:1
+12 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=" ----------"
SET I=I+1
+13 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=PSUTB4_PSUTB3_$PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSUTOTAL")),U,1)
SET I=I+1
+14 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=""
SET I=I+1
+15 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)="**PLEASE NOTE: Final TOTAL may not match sum of all SUBTOTALS. A patient may"
SET I=I+1
+16 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)="have been provided pharmacy services at more than one outpatient and/or"
SET I=I+1
+17 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)="inpatient division."
+18 QUIT
+19 ;
NODATA ;Summary report line to be sent if there is no data
+1 ;
+2 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",1)="PHARMACY INPATIENT (UD) 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
