PSUSUM2 ;BIR/DAM - Patient Demographics Summary for OP Extract ; 20 DEC 2001
;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
;
;DBIA'S
; Reference to File #59 supported by DBIA 1876
;
EN ;EN CALLED FROM PSUOP0
;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","RX")) D Q ;Summary report if there is no data
.I '$D(PSUMOD(1))&'$D(PSUMOD(2)) D
..D NODATA
..I $D(^XTMP("PSU_"_PSUJOB,"PSUFLAG1"))!$D(^XTMP("PSU_"_PSUJOB,"PSUFLAG2")) K ^XTMP("PSU_"_PSUJOB,"PSUNONE")
;
D DATE
D DIVNUM
D TOTAL
S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=" ---------" S I=I+1
S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)="" S I=I+1
D TAB1
I $D(PSUMOD(1))!$D(PSUMOD(2)) D
.M ^XTMP("PSU_"_PSUJOB,"PSURXCTA")=^XTMP("PSU_"_PSUJOB,"PSUCT")
.M ^XTMP("PSU_"_PSUJOB,"PSURXTOTAL")=^XTMP("PSU_"_PSUJOB,"PSUTOTAL")
.S ^XTMP("PSU_"_PSUJOB,"PSURXUNIQUE")=M-1
.M ^XTMP("PSU_"_PSUJOB,"PSURXSSN")=^XTMP("PSU_"_PSUJOB,"PSUSSN")
;
I '$D(PSUMOD(1))&'$D(PSUMOD(2)) D
.D PDSUM^PSUDEM5 ;Mail message
K ^XTMP("PSU_"_PSUJOB,"PSUTOTAL")
K ^XTMP("PSU_"_PSUJOB,"PSUSSN")
K ^XTMP("PSU_"_PSUJOB,"PSUCT")
K ^XTMP("PSU_"_PSUJOB,"PSUDIV")
K ^XTMP("PSU_"_PSUJOB,"PSURX")
I $D(^XTMP("PSU_"_PSUJOB,"PSUFLAG1")) K ^XTMP("PSU_"_PSUJOB,"PSUSUMA")
K ^XTMP("PSU_"_PSUJOB,"PSUFLAG1")
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 RXSUM
Q
;
RXSUM ;Summary report to be run if Rx (Outpatient) extract is run
;
D UNIQUE
;Report header
S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",1)="PHARMACY OUTPATIENT 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)=""
D TAB2
S $P(^XTMP("PSU_"_PSUJOB,"PSUSUMA",8),"-",70)=""
S I=9
;
Q
;
TAB2 ;Tab spacing for line 7. Set line into global
;
N PSUTB3,PSUTB4,PSUTB5
;
S PSUTB3=" "
S PSUTB4="TOTAL Pharmacy patients across all divisions:"
S PSUTB5=(67-$L(PSUTB4))-$L($P(^XTMP("PSU_"_PSUJOB,"PSUUNIQUE"),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(^XTMP("PSU_"_PSUJOB,"PSUUNIQUE"),U,1)
Q
;
UNIQUE ;Find UNIQUE patients across all divisions
;
N PSUSIT,PSUTOTAL,PSUSOC1,PSUNIQUE,PSURX2,PSURX5
M ^XTMP("PSU_"_PSUJOB,"PSURX")=^XTMP(PSUOPSUB)
;
S M=0
S N=1
S PSUSIT=0
S PSURX1=0
F S PSUSIT=$O(^XTMP("PSU_"_PSUJOB,"PSURX","RECORDS",PSUSIT)) Q:'PSUSIT D
.F S PSURX1=$O(^XTMP("PSU_"_PSUJOB,"PSURX","RECORDS",PSUSIT,PSURX1)) Q:'PSURX1 D
..I $P($G(^XTMP("PSU_"_PSUJOB,"PSURX","RECORDS",PSUSIT,PSURX1)),U,7)?9.10E D
...;S PSUTOTAL=N
...S PSUSOC1=$P($G(^XTMP("PSU_"_PSUJOB,"PSURX","RECORDS",PSUSIT,PSURX1)),U,7)
...I $G(PSUSOC1) S ^XTMP("PSU_"_PSUJOB,"PSUSSN",PSUSOC1)=""
...S N=N+1
D ELIM
Q
;
ELIM ;Eliminate duplicate patient entries to get number of unique pts
;
S PSUADM=0
F S PSUADM=$O(^XTMP("PSU_"_PSUJOB,"PSUSSN",PSUADM)) Q:'PSUADM D
.S $P(^XTMP("PSU_"_PSUJOB,"PSUUNIQUE"),U,1)=M
.S M=M+1
Q
;
DIVNUM ;Set number of patients per division into summary message
;
;Find patient SSN's in the following global and place with the division
;number
N PSUPTID,PSUPL
S PSUDNUM=0
S C=1
F S PSUDNUM=$O(^XTMP("PSU_"_PSUJOB,"PSUDIVPT",PSUDNUM)) Q:PSUDNUM="" D
.S PSUPL=0
.F S PSUPL=$O(^XTMP("PSU_"_PSUJOB,"PSUDIVPT",PSUDNUM,PSUPL)) Q:PSUPL="" D
..S PSUPTID=$P(^XTMP("PSU_"_PSUJOB,"PSUDIVPT",PSUDNUM,PSUPL),U,7)
..Q:PSUPTID=""
..S ^XTMP("PSU_"_PSUJOB,"PSUCT0",PSUDNUM,PSUPTID)=""
;
;Get patient count for each division
S PSUDNUM1=0
F S PSUDNUM1=$O(^XTMP("PSU_"_PSUJOB,"PSUCT0",PSUDNUM1)) Q:PSUDNUM1="" D
.S PSUID=0
.F S PSUID=$O(^XTMP("PSU_"_PSUJOB,"PSUCT0",PSUDNUM1,PSUID)) Q:PSUID="" D
..I $D(^XTMP("PSU_"_PSUJOB,"PSUCT1",PSUDNUM1)) D
...S C=C+1
...S ^XTMP("PSU_"_PSUJOB,"PSUCT1",PSUDNUM1)=C
..I '$D(^XTMP("PSU_"_PSUJOB,"PSUCT1",PSUDNUM1)) D
...S C=1 S ^XTMP("PSU_"_PSUJOB,"PSUCT1",PSUDNUM1)=C
;
;Get division name
S PSUDIV=0
N PSUNBR
F S PSUDIV=$O(^XTMP("PSU_"_PSUJOB,"PSUCT1",PSUDIV)) Q:PSUDIV="" D
.S PSUNBR=$P(^XTMP("PSU_"_PSUJOB,"PSUCT1",PSUDIV),U,1)
.S X=PSUDIV,DIC=59,DIC(0)="XM" D ^DIC ;**1
.S X=+Y,PSUDIVNM=$$VAL^PSUTL(59,X,.01)
.I PSUDIVNM'="" S ^XTMP("PSU_"_PSUJOB,"PSUCT",PSUDIVNM)=PSUNBR
.I PSUDIVNM="" S ^XTMP("PSU_"_PSUJOB,"PSUCT",PSUDIV)=PSUNBR
;
N PSUTB1,PSUTB2
;
N PSUCT2
S PSUDIVA1=0
F S PSUDIVA1=$O(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUDIVA1)) Q:PSUDIVA1="" D
.S PSUCT2=$P(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUDIVA1),U,1)
.D TAB
.S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=" "_PSUDIVA1_" Division:"_PSUTB1_PSUCT2
.S I=I+1
Q
;
TAB ;Calculate tab spacing
;
S PSUTB1=" "
S PSUTB2=(62-$L(PSUCT2))-$L(PSUDIVA1)-10
F S2=1:1:(PSUTB2-1) S PSUTB(S2)=" " D
.S PSUTB1=PSUTB1_PSUTB(S2) ;Tab position
Q
;
TOTAL ;Calculate Outpatient Total of all Divisions
;
S PSUOPTOT=0
S PSUTOCT1=0
F S PSUOPTOT=$O(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUOPTOT)) Q:PSUOPTOT="" D
.S PSUTOCT=$P(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUOPTOT),U,1)
.S PSUTOCT1=PSUTOCT1+PSUTOCT
S $P(^XTMP("PSU_"_PSUJOB,"PSUTOTAL"),U,1)=PSUTOCT1
Q
;
TAB1 ;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
;
S PSUTB3=" "
S PSUTB4=" Outpatient Total of all Divisions:"
S PSUTB5=(67-$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)=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 OUTPATIENT 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[HPSUSUM2 6963 printed Dec 13, 2024@02:28:28 Page 2
PSUSUM2 ;BIR/DAM - Patient Demographics Summary for OP Extract ; 20 DEC 2001
+1 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
+2 ;
+3 ;DBIA'S
+4 ; Reference to File #59 supported by DBIA 1876
+5 ;
EN ;EN CALLED FROM PSUOP0
+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 ;Summary report if there is no data
IF $DATA(^XTMP("PSU_"_PSUJOB,"PSUNONE","RX"))
Begin DoDot:1
+7 IF '$DATA(PSUMOD(1))&'$DATA(PSUMOD(2))
Begin DoDot:2
+8 DO NODATA
+9 IF $DATA(^XTMP("PSU_"_PSUJOB,"PSUFLAG1"))!$DATA(^XTMP("PSU_"_PSUJOB,"PSUFLAG2"))
KILL ^XTMP("PSU_"_PSUJOB,"PSUNONE")
End DoDot:2
End DoDot:1
QUIT
+10 ;
+11 DO DATE
+12 DO DIVNUM
+13 DO TOTAL
+14 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=" ---------"
SET I=I+1
+15 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=""
SET I=I+1
+16 DO TAB1
+17 IF $DATA(PSUMOD(1))!$DATA(PSUMOD(2))
Begin DoDot:1
+18 MERGE ^XTMP("PSU_"_PSUJOB,"PSURXCTA")=^XTMP("PSU_"_PSUJOB,"PSUCT")
+19 MERGE ^XTMP("PSU_"_PSUJOB,"PSURXTOTAL")=^XTMP("PSU_"_PSUJOB,"PSUTOTAL")
+20 SET ^XTMP("PSU_"_PSUJOB,"PSURXUNIQUE")=M-1
+21 MERGE ^XTMP("PSU_"_PSUJOB,"PSURXSSN")=^XTMP("PSU_"_PSUJOB,"PSUSSN")
End DoDot:1
+22 ;
+23 IF '$DATA(PSUMOD(1))&'$DATA(PSUMOD(2))
Begin DoDot:1
+24 ;Mail message
DO PDSUM^PSUDEM5
End DoDot:1
+25 KILL ^XTMP("PSU_"_PSUJOB,"PSUTOTAL")
+26 KILL ^XTMP("PSU_"_PSUJOB,"PSUSSN")
+27 KILL ^XTMP("PSU_"_PSUJOB,"PSUCT")
+28 KILL ^XTMP("PSU_"_PSUJOB,"PSUDIV")
+29 KILL ^XTMP("PSU_"_PSUJOB,"PSURX")
+30 IF $DATA(^XTMP("PSU_"_PSUJOB,"PSUFLAG1"))
KILL ^XTMP("PSU_"_PSUJOB,"PSUSUMA")
+31 KILL ^XTMP("PSU_"_PSUJOB,"PSUFLAG1")
+32 QUIT
+33 ;
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 RXSUM
+15 QUIT
+16 ;
RXSUM ;Summary report to be run if Rx (Outpatient) extract is run
+1 ;
+2 DO UNIQUE
+3 ;Report header
+4 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",1)="PHARMACY OUTPATIENT UNIQUE PATIENTS REPORT "_PSUD
+5 ;Separator bar
SET $PIECE(^XTMP("PSU_"_PSUJOB,"PSUSUMA",2),"-",80)=""
+6 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",3)=" "_PSUS_" through "_PSUE
+7 SET $PIECE(^XTMP("PSU_"_PSUJOB,"PSUSUMA",4),"=",80)=""
+8 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",5)=" UNIQUE"
+9 SET $PIECE(^XTMP("PSU_"_PSUJOB,"PSUSUMA",6),"-",70)=""
+10 DO TAB2
+11 SET $PIECE(^XTMP("PSU_"_PSUJOB,"PSUSUMA",8),"-",70)=""
+12 SET I=9
+13 ;
+14 QUIT
+15 ;
TAB2 ;Tab spacing for line 7. Set line into global
+1 ;
+2 NEW PSUTB3,PSUTB4,PSUTB5
+3 ;
+4 SET PSUTB3=" "
+5 SET PSUTB4="TOTAL Pharmacy patients across all divisions:"
+6 SET PSUTB5=(67-$LENGTH(PSUTB4))-$LENGTH($PIECE(^XTMP("PSU_"_PSUJOB,"PSUUNIQUE"),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(^XTMP("PSU_"_PSUJOB,"PSUUNIQUE"),U,1)
+10 QUIT
+11 ;
UNIQUE ;Find UNIQUE patients across all divisions
+1 ;
+2 NEW PSUSIT,PSUTOTAL,PSUSOC1,PSUNIQUE,PSURX2,PSURX5
+3 MERGE ^XTMP("PSU_"_PSUJOB,"PSURX")=^XTMP(PSUOPSUB)
+4 ;
+5 SET M=0
+6 SET N=1
+7 SET PSUSIT=0
+8 SET PSURX1=0
+9 FOR
SET PSUSIT=$ORDER(^XTMP("PSU_"_PSUJOB,"PSURX","RECORDS",PSUSIT))
if 'PSUSIT
QUIT
Begin DoDot:1
+10 FOR
SET PSURX1=$ORDER(^XTMP("PSU_"_PSUJOB,"PSURX","RECORDS",PSUSIT,PSURX1))
if 'PSURX1
QUIT
Begin DoDot:2
+11 IF $PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSURX","RECORDS",PSUSIT,PSURX1)),U,7)?9.10E
Begin DoDot:3
+12 ;S PSUTOTAL=N
+13 SET PSUSOC1=$PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSURX","RECORDS",PSUSIT,PSURX1)),U,7)
+14 IF $GET(PSUSOC1)
SET ^XTMP("PSU_"_PSUJOB,"PSUSSN",PSUSOC1)=""
+15 SET N=N+1
End DoDot:3
End DoDot:2
End DoDot:1
+16 DO ELIM
+17 QUIT
+18 ;
ELIM ;Eliminate duplicate patient entries to get number of unique pts
+1 ;
+2 SET PSUADM=0
+3 FOR
SET PSUADM=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUSSN",PSUADM))
if 'PSUADM
QUIT
Begin DoDot:1
+4 SET $PIECE(^XTMP("PSU_"_PSUJOB,"PSUUNIQUE"),U,1)=M
+5 SET M=M+1
End DoDot:1
+6 QUIT
+7 ;
DIVNUM ;Set number of patients per division into summary message
+1 ;
+2 ;Find patient SSN's in the following global and place with the division
+3 ;number
+4 NEW PSUPTID,PSUPL
+5 SET PSUDNUM=0
+6 SET C=1
+7 FOR
SET PSUDNUM=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUDIVPT",PSUDNUM))
if PSUDNUM=""
QUIT
Begin DoDot:1
+8 SET PSUPL=0
+9 FOR
SET PSUPL=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUDIVPT",PSUDNUM,PSUPL))
if PSUPL=""
QUIT
Begin DoDot:2
+10 SET PSUPTID=$PIECE(^XTMP("PSU_"_PSUJOB,"PSUDIVPT",PSUDNUM,PSUPL),U,7)
+11 if PSUPTID=""
QUIT
+12 SET ^XTMP("PSU_"_PSUJOB,"PSUCT0",PSUDNUM,PSUPTID)=""
End DoDot:2
End DoDot:1
+13 ;
+14 ;Get patient count for each division
+15 SET PSUDNUM1=0
+16 FOR
SET PSUDNUM1=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUCT0",PSUDNUM1))
if PSUDNUM1=""
QUIT
Begin DoDot:1
+17 SET PSUID=0
+18 FOR
SET PSUID=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUCT0",PSUDNUM1,PSUID))
if PSUID=""
QUIT
Begin DoDot:2
+19 IF $DATA(^XTMP("PSU_"_PSUJOB,"PSUCT1",PSUDNUM1))
Begin DoDot:3
+20 SET C=C+1
+21 SET ^XTMP("PSU_"_PSUJOB,"PSUCT1",PSUDNUM1)=C
End DoDot:3
+22 IF '$DATA(^XTMP("PSU_"_PSUJOB,"PSUCT1",PSUDNUM1))
Begin DoDot:3
+23 SET C=1
SET ^XTMP("PSU_"_PSUJOB,"PSUCT1",PSUDNUM1)=C
End DoDot:3
End DoDot:2
End DoDot:1
+24 ;
+25 ;Get division name
+26 SET PSUDIV=0
+27 NEW PSUNBR
+28 FOR
SET PSUDIV=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUCT1",PSUDIV))
if PSUDIV=""
QUIT
Begin DoDot:1
+29 SET PSUNBR=$PIECE(^XTMP("PSU_"_PSUJOB,"PSUCT1",PSUDIV),U,1)
+30 ;**1
SET X=PSUDIV
SET DIC=59
SET DIC(0)="XM"
DO ^DIC
+31 SET X=+Y
SET PSUDIVNM=$$VAL^PSUTL(59,X,.01)
+32 IF PSUDIVNM'=""
SET ^XTMP("PSU_"_PSUJOB,"PSUCT",PSUDIVNM)=PSUNBR
+33 IF PSUDIVNM=""
SET ^XTMP("PSU_"_PSUJOB,"PSUCT",PSUDIV)=PSUNBR
End DoDot:1
+34 ;
+35 NEW PSUTB1,PSUTB2
+36 ;
+37 NEW PSUCT2
+38 SET PSUDIVA1=0
+39 FOR
SET PSUDIVA1=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUDIVA1))
if PSUDIVA1=""
QUIT
Begin DoDot:1
+40 SET PSUCT2=$PIECE(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUDIVA1),U,1)
+41 DO TAB
+42 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=" "_PSUDIVA1_" Division:"_PSUTB1_PSUCT2
+43 SET I=I+1
End DoDot:1
+44 QUIT
+45 ;
TAB ;Calculate tab spacing
+1 ;
+2 SET PSUTB1=" "
+3 SET PSUTB2=(62-$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 ;
TOTAL ;Calculate Outpatient Total of all Divisions
+1 ;
+2 SET PSUOPTOT=0
+3 SET PSUTOCT1=0
+4 FOR
SET PSUOPTOT=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUOPTOT))
if PSUOPTOT=""
QUIT
Begin DoDot:1
+5 SET PSUTOCT=$PIECE(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUOPTOT),U,1)
+6 SET PSUTOCT1=PSUTOCT1+PSUTOCT
End DoDot:1
+7 SET $PIECE(^XTMP("PSU_"_PSUJOB,"PSUTOTAL"),U,1)=PSUTOCT1
+8 QUIT
+9 ;
TAB1 ;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 SET PSUTB3=" "
+6 SET PSUTB4=" Outpatient Total of all Divisions:"
+7 SET PSUTB5=(67-$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)=PSUTB4_PSUTB3_$PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSUTOTAL")),U,1)
SET I=I+1
+11 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=""
SET I=I+1
+12 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)="**PLEASE NOTE: Final TOTAL may not match sum of all SUBTOTALS. A patient may"
SET I=I+1
+13 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)="have been provided pharmacy services at more than one outpatient and/or"
SET I=I+1
+14 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)="inpatient division."
+15 QUIT
+16 ;
NODATA ;Summary report line to be sent if there is no data
+1 ;
+2 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",1)="PHARMACY OUTPATIENT 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
