PSUSUM4 ;BIR/DAM - Patient Demographics Summary for IV 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 2440
;
EN ;EN CALLED FROM PSUIV0
;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,"PSUFLAG2"))!$D(^XTMP("PSU_"_PSUJOB,"PSUFLAG3")) K ^XTMP("PSU_"_PSUJOB,"PSUSUMA")
I $D(^XTMP("PSU_"_PSUJOB,"PSUNONE","IV")) D Q ;Summary report if there is no data
.I '$D(PSUMOD(2))&$D(PSUMOD(1)) D
..I '$D(PSUMOD(4)) D
...D NODATA
...I $D(^XTMP("PSU_"_PSUJOB,"PSUFLAG1"))!$D(^XTMP("PSU_"_PSUJOB,"PSUFLAG2")) K ^XTMP("PSU_"_PSUJOB,"PSUNONE")
D EN1
Q
;
EN1 ;Entry point to collect data
;
D DATE
M ^XTMP("PSU_"_PSUJOB,"PSUIV")=^XTMP(PSUIVSUB)
S I=7 ;Line counter for message
D UNIQUE
N PSUTB2,PSUTB3,PSUTB4,PSUTB5
D TAB
D TOTUN
S I=10 ;Reset line counter for message
D PATNUM
D TAB1
;
I $D(PSUMOD(2))&$D(PSUMOD(1)) D
.I $D(PSUMOD(4)) D
..M ^XTMP("PSU_"_PSUJOB,"PSUIVINDIV")=^XTMP("PSU_"_PSUJOB,"PSUCT")
..M ^XTMP("PSU_"_PSUJOB,"PSUIVIN")=^XTMP("PSU_"_PSUJOB,"PSUINP")
..M ^XTMP("PSU_"_PSUJOB,"PSUIVOUT")=^XTMP("PSU_"_PSUJOB,"PSUOUTP")
..M ^XTMP("PSU_"_PSUJOB,"PSUIVSSN")=^XTMP("PSU_"_PSUJOB,"PSUIV","PAT")
..M ^XTMP("PSU_"_PSUJOB,"PSUDIV1")=^XTMP("PSU_"_PSUJOB,"PSUDIV")
;
I '$D(PSUMOD(2))&$D(PSUMOD(1)) D
.I $D(PSUMOD(4)) D
..M ^XTMP("PSU_"_PSUJOB,"PSUIVINDIV")=^XTMP("PSU_"_PSUJOB,"PSUCT")
..M ^XTMP("PSU_"_PSUJOB,"PSUIVIN")=^XTMP("PSU_"_PSUJOB,"PSUINP")
..M ^XTMP("PSU_"_PSUJOB,"PSUIVOUT")=^XTMP("PSU_"_PSUJOB,"PSUOUTP")
..M ^XTMP("PSU_"_PSUJOB,"PSUIVSSN")=^XTMP("PSU_"_PSUJOB,"PSUIV","PAT")
..M ^XTMP("PSU_"_PSUJOB,"PSUIN1")=^XTMP("PSU_"_PSUJOB,"PSUIN")
..M ^XTMP("PSU_"_PSUJOB,"PSUDIV1")=^XTMP("PSU_"_PSUJOB,"PSUDIV")
;
I $D(PSUMOD(2))&$D(PSUMOD(1)) D
.I '$D(PSUMOD(4)) D
..M ^XTMP("PSU_"_PSUJOB,"PSUIVINDIV")=^XTMP("PSU_"_PSUJOB,"PSUCT")
..M ^XTMP("PSU_"_PSUJOB,"PSUIVIN")=^XTMP("PSU_"_PSUJOB,"PSUINP")
..M ^XTMP("PSU_"_PSUJOB,"PSUIVOUT")=^XTMP("PSU_"_PSUJOB,"PSUOUTP")
..M ^XTMP("PSU_"_PSUJOB,"PSUDIV1")=^XTMP("PSU_"_PSUJOB,"PSUDIV")
;
I '$D(PSUMOD(2))&'$D(PSUMOD(4)) D
.I '$G(^XTMP("PSU_"_PSUJOB,"PSUFLAG1")) D
..D PDSUM^PSUDEM5 ;Mail message
..K ^XTMP("PSU_"_PSUJOB,"PSUIVOUT")
..K ^XTMP("PSU_"_PSUJOB,"PSUIVINDIV")
K ^XTMP("PSU_"_PSUJOB,"PSUIV")
;K ^XTMP("PSU_"_PSUJOB,"PSUIVSSN")
K ^XTMP("PSU_"_PSUJOB,"PSUINP")
;K ^XTMP("PSU_"_PSUJOB,"PSUIN")
;K ^XTMP("PSU_"_PSUJOB,"PSUOUT")
I $D(^XTMP("PSU_"_PSUJOB,"PSUFLAG1")) K ^XTMP("PSU_"_PSUJOB,"PSUSUMA")
I $D(^XTMP("PSU_"_PSUJOB,"PSUMFLAG"))
K ^XTMP("PSU_"_PSUJOB,"PSUFLAG1")
K ^XTMP("PSU_"_PSUJOB,"PSUOUTP")
K ^XTMP("PSU_"_PSUJOB,"PSUINP")
;K ^XTMP("PSU_"_PSUJOB,"PSUDIV")
K ^XTMP("PSU_"_PSUJOB,"PSUCT")
;K ^XTMP("PSU_"_PSUJOB,"PSUTOTAL")
K ^XTMP("PSU_"_PSUJOB,"PSURXCTA")
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
D DD^%DT
N PSUS S PSUS=Y
;
S Y=PSUEDT
D DD^%DT
N PSUE S PSUE=Y
;
D IVSUM
Q
;
IVSUM ;Summary report header to be run if IV extract is run
;
;Report header
S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",1)="PHARMACY INPATIENT (IV) 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
;
N PSUSIT
S PSUSIT=PSUSNDR
;
N PSUWD,PSUSN
S PSUOPCT=1
S PSUIPCT=1
S PSUNUM=0,PSUSIT1=0
F S PSUSIT1=$O(^XTMP("PSU_"_PSUJOB,"PSUIV","RECORDS",PSUSIT1)) Q:PSUSIT1="" D
.F S PSUNUM=$O(^XTMP("PSU_"_PSUJOB,"PSUIV","RECORDS",PSUSIT1,PSUNUM)) Q:PSUNUM="" D
..S PSUWD=$P($G(^XTMP("PSU_"_PSUJOB,"PSUIV","RECORDS",PSUSIT1,PSUNUM)),U,7)
..S PSUSN=$P($G(^XTMP("PSU_"_PSUJOB,"PSUIV","RECORDS",PSUSIT1,PSUNUM)),U,8)
..I PSUWD'="" D
...I PSUWD="Y" S ^XTMP("PSU_"_PSUJOB,"PSUOUT",PSUSN)=""
...I PSUWD="N" S ^XTMP("PSU_"_PSUJOB,"PSUIN",PSUSN)=""
D WARD
Q
;
WARD ;Find unique number of patients that are OP and IP
;
;Find unique number of outpatients
S PSUD1A=0
F S PSUD1A=$O(^XTMP("PSU_"_PSUJOB,"PSUOUT",PSUD1A)) Q:PSUD1A="" D
.S ^XTMP("PSU_"_PSUJOB,"PSUOUTP")=PSUOPCT S PSUOPCT=PSUOPCT+1
;
;Find unique number in inpatients
S PSUD1B=0
F S PSUD1B=$O(^XTMP("PSU_"_PSUJOB,"PSUIN",PSUD1B)) Q:PSUD1B="" D
.S ^XTMP("PSU_"_PSUJOB,"PSUINP")=PSUIPCT S PSUIPCT=PSUIPCT+1
Q
;
TAB ;Calculate tab spacing
;
I '$D(^XTMP("PSU_"_PSUJOB,"PSUINP")) S ^XTMP("PSU_"_PSUJOB,"PSUINP")=0
I '$D(^XTMP("PSU_"_PSUJOB,"PSUOUTP")) S ^XTMP("PSU_"_PSUJOB,"PSUOUTP")=0
;
S PSUTB1=" "
S PSUTB2="Total unique Inpatients across all divisions:"
S PSUTB3=(64-$L(^XTMP("PSU_"_PSUJOB,"PSUINP")))-$L(PSUTB2)
F S2=1:1:(PSUTB3-1) S PSUTB(S2)=" " D
.S PSUTB1=PSUTB1_PSUTB(S2)
;
S PSUTB6=" "
S PSUTB4="Total unique Outpatients across all divisions:"
S PSUTB5=(64-$L(^XTMP("PSU_"_PSUJOB,"PSUOUTP")))-$L(PSUTB4)
F S3=1:1:(PSUTB5-1) S PSUTB(S3)=" " D
.S PSUTB6=PSUTB6_PSUTB(S3)
Q
;
TOTUN ;Set total number of unique in-patients and out-patients into
;summary message
;
S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=PSUTB2_PSUTB1_^XTMP("PSU_"_PSUJOB,"PSUINP") S I=I+1
S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=PSUTB4_PSUTB6_^XTMP("PSU_"_PSUJOB,"PSUOUTP") S I=I+1
S $P(^XTMP("PSU_"_PSUJOB,"PSUSUMA",I),"-",70)=""
Q
;
PATNUM ;Place division names and patient totals into summary message
;
N PSUTB1,PSUTB2
N PSUCT3
S PSUTOTAL=0
S PSUDIVNM=0
F S PSUDIVNM=$O(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUDIVNM)) Q:PSUDIVNM="" D
.S PSUCT3=$P($G(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUDIVNM)),U,1)
.S PSUTOTAL=PSUTOTAL+PSUCT3
.D SPACE
.S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=" "_PSUDIVNM_" Division:"_PSUTB1_PSUCT3
.S I=I+1
S ^XTMP("PSU_"_PSUJOB,"PSUTOTAL")=PSUTOTAL ;Total of all divisions
Q
;
SPACE ;S ^XTMP("PSU_"_PSUJOB,"PSUTOTAL")=PSUTOTAL ;Total of all divisions
;
S PSUTB1=" "
S PSUTB2=(59-$L(PSUCT3))-$L(PSUDIVNM)-10
F S2=1:1:(PSUTB2-1) S PSUTB(S2)=" " D
.S PSUTB1=PSUTB1_PSUTB(S2) ;Tab position
Q
;
TAB1 ;EN Calculate tab spacing for 'Total of all Divisions' line,
;and set the last lines of message into the summary global.
;
N PSUTB3,PSUTB4,PSUTB5
;
S PSUTB3=" "
S PSUTB4=" Total of all Divisions: "
S PSUTB5=(64-$L(PSUTB4))-$L($P(^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(^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)="* This report includes Outpatients receiving IV orders." 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 (IV) 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[HPSUSUM4 7987 printed Sep 23, 2025@20:04:09 Page 2
PSUSUM4 ;BIR/DAM - Patient Demographics Summary for IV 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 2440
+6 ;
EN ;EN CALLED FROM PSUIV0
+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 IF $DATA(^XTMP("PSU_"_PSUJOB,"PSUFLAG2"))!$DATA(^XTMP("PSU_"_PSUJOB,"PSUFLAG3"))
KILL ^XTMP("PSU_"_PSUJOB,"PSUSUMA")
+7 ;Summary report if there is no data
IF $DATA(^XTMP("PSU_"_PSUJOB,"PSUNONE","IV"))
Begin DoDot:1
+8 IF '$DATA(PSUMOD(2))&$DATA(PSUMOD(1))
Begin DoDot:2
+9 IF '$DATA(PSUMOD(4))
Begin DoDot:3
+10 DO NODATA
+11 IF $DATA(^XTMP("PSU_"_PSUJOB,"PSUFLAG1"))!$DATA(^XTMP("PSU_"_PSUJOB,"PSUFLAG2"))
KILL ^XTMP("PSU_"_PSUJOB,"PSUNONE")
End DoDot:3
End DoDot:2
End DoDot:1
QUIT
+12 DO EN1
+13 QUIT
+14 ;
EN1 ;Entry point to collect data
+1 ;
+2 DO DATE
+3 MERGE ^XTMP("PSU_"_PSUJOB,"PSUIV")=^XTMP(PSUIVSUB)
+4 ;Line counter for message
SET I=7
+5 DO UNIQUE
+6 NEW PSUTB2,PSUTB3,PSUTB4,PSUTB5
+7 DO TAB
+8 DO TOTUN
+9 ;Reset line counter for message
SET I=10
+10 DO PATNUM
+11 DO TAB1
+12 ;
+13 IF $DATA(PSUMOD(2))&$DATA(PSUMOD(1))
Begin DoDot:1
+14 IF $DATA(PSUMOD(4))
Begin DoDot:2
+15 MERGE ^XTMP("PSU_"_PSUJOB,"PSUIVINDIV")=^XTMP("PSU_"_PSUJOB,"PSUCT")
+16 MERGE ^XTMP("PSU_"_PSUJOB,"PSUIVIN")=^XTMP("PSU_"_PSUJOB,"PSUINP")
+17 MERGE ^XTMP("PSU_"_PSUJOB,"PSUIVOUT")=^XTMP("PSU_"_PSUJOB,"PSUOUTP")
+18 MERGE ^XTMP("PSU_"_PSUJOB,"PSUIVSSN")=^XTMP("PSU_"_PSUJOB,"PSUIV","PAT")
+19 MERGE ^XTMP("PSU_"_PSUJOB,"PSUDIV1")=^XTMP("PSU_"_PSUJOB,"PSUDIV")
End DoDot:2
End DoDot:1
+20 ;
+21 IF '$DATA(PSUMOD(2))&$DATA(PSUMOD(1))
Begin DoDot:1
+22 IF $DATA(PSUMOD(4))
Begin DoDot:2
+23 MERGE ^XTMP("PSU_"_PSUJOB,"PSUIVINDIV")=^XTMP("PSU_"_PSUJOB,"PSUCT")
+24 MERGE ^XTMP("PSU_"_PSUJOB,"PSUIVIN")=^XTMP("PSU_"_PSUJOB,"PSUINP")
+25 MERGE ^XTMP("PSU_"_PSUJOB,"PSUIVOUT")=^XTMP("PSU_"_PSUJOB,"PSUOUTP")
+26 MERGE ^XTMP("PSU_"_PSUJOB,"PSUIVSSN")=^XTMP("PSU_"_PSUJOB,"PSUIV","PAT")
+27 MERGE ^XTMP("PSU_"_PSUJOB,"PSUIN1")=^XTMP("PSU_"_PSUJOB,"PSUIN")
+28 MERGE ^XTMP("PSU_"_PSUJOB,"PSUDIV1")=^XTMP("PSU_"_PSUJOB,"PSUDIV")
End DoDot:2
End DoDot:1
+29 ;
+30 IF $DATA(PSUMOD(2))&$DATA(PSUMOD(1))
Begin DoDot:1
+31 IF '$DATA(PSUMOD(4))
Begin DoDot:2
+32 MERGE ^XTMP("PSU_"_PSUJOB,"PSUIVINDIV")=^XTMP("PSU_"_PSUJOB,"PSUCT")
+33 MERGE ^XTMP("PSU_"_PSUJOB,"PSUIVIN")=^XTMP("PSU_"_PSUJOB,"PSUINP")
+34 MERGE ^XTMP("PSU_"_PSUJOB,"PSUIVOUT")=^XTMP("PSU_"_PSUJOB,"PSUOUTP")
+35 MERGE ^XTMP("PSU_"_PSUJOB,"PSUDIV1")=^XTMP("PSU_"_PSUJOB,"PSUDIV")
End DoDot:2
End DoDot:1
+36 ;
+37 IF '$DATA(PSUMOD(2))&'$DATA(PSUMOD(4))
Begin DoDot:1
+38 IF '$GET(^XTMP("PSU_"_PSUJOB,"PSUFLAG1"))
Begin DoDot:2
+39 ;Mail message
DO PDSUM^PSUDEM5
+40 KILL ^XTMP("PSU_"_PSUJOB,"PSUIVOUT")
+41 KILL ^XTMP("PSU_"_PSUJOB,"PSUIVINDIV")
End DoDot:2
End DoDot:1
+42 KILL ^XTMP("PSU_"_PSUJOB,"PSUIV")
+43 ;K ^XTMP("PSU_"_PSUJOB,"PSUIVSSN")
+44 KILL ^XTMP("PSU_"_PSUJOB,"PSUINP")
+45 ;K ^XTMP("PSU_"_PSUJOB,"PSUIN")
+46 ;K ^XTMP("PSU_"_PSUJOB,"PSUOUT")
+47 IF $DATA(^XTMP("PSU_"_PSUJOB,"PSUFLAG1"))
KILL ^XTMP("PSU_"_PSUJOB,"PSUSUMA")
+48 IF $DATA(^XTMP("PSU_"_PSUJOB,"PSUMFLAG"))
+49 KILL ^XTMP("PSU_"_PSUJOB,"PSUFLAG1")
+50 KILL ^XTMP("PSU_"_PSUJOB,"PSUOUTP")
+51 KILL ^XTMP("PSU_"_PSUJOB,"PSUINP")
+52 ;K ^XTMP("PSU_"_PSUJOB,"PSUDIV")
+53 KILL ^XTMP("PSU_"_PSUJOB,"PSUCT")
+54 ;K ^XTMP("PSU_"_PSUJOB,"PSUTOTAL")
+55 KILL ^XTMP("PSU_"_PSUJOB,"PSURXCTA")
+56 QUIT
+57 ;
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 SET Y=PSUSDT
+7 DO DD^%DT
+8 NEW PSUS
SET PSUS=Y
+9 ;
+10 SET Y=PSUEDT
+11 DO DD^%DT
+12 NEW PSUE
SET PSUE=Y
+13 ;
+14 DO IVSUM
+15 QUIT
+16 ;
IVSUM ;Summary report header to be run if IV extract is run
+1 ;
+2 ;Report header
+3 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",1)="PHARMACY INPATIENT (IV) 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 NEW PSUSIT
+3 SET PSUSIT=PSUSNDR
+4 ;
+5 NEW PSUWD,PSUSN
+6 SET PSUOPCT=1
+7 SET PSUIPCT=1
+8 SET PSUNUM=0
SET PSUSIT1=0
+9 FOR
SET PSUSIT1=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUIV","RECORDS",PSUSIT1))
if PSUSIT1=""
QUIT
Begin DoDot:1
+10 FOR
SET PSUNUM=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUIV","RECORDS",PSUSIT1,PSUNUM))
if PSUNUM=""
QUIT
Begin DoDot:2
+11 SET PSUWD=$PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSUIV","RECORDS",PSUSIT1,PSUNUM)),U,7)
+12 SET PSUSN=$PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSUIV","RECORDS",PSUSIT1,PSUNUM)),U,8)
+13 IF PSUWD'=""
Begin DoDot:3
+14 IF PSUWD="Y"
SET ^XTMP("PSU_"_PSUJOB,"PSUOUT",PSUSN)=""
+15 IF PSUWD="N"
SET ^XTMP("PSU_"_PSUJOB,"PSUIN",PSUSN)=""
End DoDot:3
End DoDot:2
End DoDot:1
+16 DO WARD
+17 QUIT
+18 ;
WARD ;Find unique number of patients that are OP and IP
+1 ;
+2 ;Find unique number of outpatients
+3 SET PSUD1A=0
+4 FOR
SET PSUD1A=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUOUT",PSUD1A))
if PSUD1A=""
QUIT
Begin DoDot:1
+5 SET ^XTMP("PSU_"_PSUJOB,"PSUOUTP")=PSUOPCT
SET PSUOPCT=PSUOPCT+1
End DoDot:1
+6 ;
+7 ;Find unique number in inpatients
+8 SET PSUD1B=0
+9 FOR
SET PSUD1B=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUIN",PSUD1B))
if PSUD1B=""
QUIT
Begin DoDot:1
+10 SET ^XTMP("PSU_"_PSUJOB,"PSUINP")=PSUIPCT
SET PSUIPCT=PSUIPCT+1
End DoDot:1
+11 QUIT
+12 ;
TAB ;Calculate tab spacing
+1 ;
+2 IF '$DATA(^XTMP("PSU_"_PSUJOB,"PSUINP"))
SET ^XTMP("PSU_"_PSUJOB,"PSUINP")=0
+3 IF '$DATA(^XTMP("PSU_"_PSUJOB,"PSUOUTP"))
SET ^XTMP("PSU_"_PSUJOB,"PSUOUTP")=0
+4 ;
+5 SET PSUTB1=" "
+6 SET PSUTB2="Total unique Inpatients across all divisions:"
+7 SET PSUTB3=(64-$LENGTH(^XTMP("PSU_"_PSUJOB,"PSUINP")))-$LENGTH(PSUTB2)
+8 FOR S2=1:1:(PSUTB3-1)
SET PSUTB(S2)=" "
Begin DoDot:1
+9 SET PSUTB1=PSUTB1_PSUTB(S2)
End DoDot:1
+10 ;
+11 SET PSUTB6=" "
+12 SET PSUTB4="Total unique Outpatients across all divisions:"
+13 SET PSUTB5=(64-$LENGTH(^XTMP("PSU_"_PSUJOB,"PSUOUTP")))-$LENGTH(PSUTB4)
+14 FOR S3=1:1:(PSUTB5-1)
SET PSUTB(S3)=" "
Begin DoDot:1
+15 SET PSUTB6=PSUTB6_PSUTB(S3)
End DoDot:1
+16 QUIT
+17 ;
TOTUN ;Set total number of unique in-patients and out-patients into
+1 ;summary message
+2 ;
+3 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=PSUTB2_PSUTB1_^XTMP("PSU_"_PSUJOB,"PSUINP")
SET I=I+1
+4 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=PSUTB4_PSUTB6_^XTMP("PSU_"_PSUJOB,"PSUOUTP")
SET I=I+1
+5 SET $PIECE(^XTMP("PSU_"_PSUJOB,"PSUSUMA",I),"-",70)=""
+6 QUIT
+7 ;
PATNUM ;Place division names and patient totals into summary message
+1 ;
+2 NEW PSUTB1,PSUTB2
+3 NEW PSUCT3
+4 SET PSUTOTAL=0
+5 SET PSUDIVNM=0
+6 FOR
SET PSUDIVNM=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUDIVNM))
if PSUDIVNM=""
QUIT
Begin DoDot:1
+7 SET PSUCT3=$PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUDIVNM)),U,1)
+8 SET PSUTOTAL=PSUTOTAL+PSUCT3
+9 DO SPACE
+10 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=" "_PSUDIVNM_" Division:"_PSUTB1_PSUCT3
+11 SET I=I+1
End DoDot:1
+12 ;Total of all divisions
SET ^XTMP("PSU_"_PSUJOB,"PSUTOTAL")=PSUTOTAL
+13 QUIT
+14 ;
SPACE ;S ^XTMP("PSU_"_PSUJOB,"PSUTOTAL")=PSUTOTAL ;Total of all divisions
+1 ;
+2 SET PSUTB1=" "
+3 SET PSUTB2=(59-$LENGTH(PSUCT3))-$LENGTH(PSUDIVNM)-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 ;
TAB1 ;EN Calculate tab spacing for '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 SET PSUTB3=" "
+6 SET PSUTB4=" Total of all Divisions: "
+7 SET PSUTB5=(64-$LENGTH(PSUTB4))-$LENGTH($PIECE(^XTMP("PSU_"_PSUJOB,"PSUTOTAL"),U,1))
+8 FOR S3=1:1:(PSUTB5-1)
SET PSUTB(S3)=" "
Begin DoDot:1
+9 ;Tab position
SET PSUTB3=PSUTB3_PSUTB(S3)
End DoDot:1
+10 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=" ------------"
SET I=I+1
+11 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=PSUTB4_PSUTB3_$PIECE(^XTMP("PSU_"_PSUJOB,"PSUTOTAL"),U,1)
SET I=I+1
+12 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=""
SET I=I+1
+13 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)="* This report includes Outpatients receiving IV orders."
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 (IV) 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
