PSUSUM6 ;BIR/DAM - Patient Demographics Summary for IV/UD/RX ; 20 DEC 2001
;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
;
EN ;EN CALLED FROM PSUOP0
;
K ^XTMP("PSU_"_PSUJOB,"PSUSUMA") ;DAM Trying to make auto run
I $D(^XTMP("PSU_"_PSUJOB,"PSUFLAG2"))!$D(^XTMP("PSU_"_PSUJOB,"PSUFLAG3")) D
.K ^XTMP("PSU_"_PSUJOB,"PSUSUMA")
;
N PSURX,PSUIV,PSUUD
S PSURX=$G(^XTMP("PSU_"_PSUJOB,"PSUNONE","RX"))
S PSUIV=$G(^XTMP("PSU_"_PSUJOB,"PSUNONE","IV"))
S PSUUD=$G(^XTMP("PSU_"_PSUJOB,"PSUNONE","UD"))
I $G(PSURX)&$G(PSUIV)&$G(PSUUD) D Q
.D NODATA D
..I $D(^XTMP("PSU_"_PSUJOB,"PSUFLAG1"))!$D(^XTMP("PSU_"_PSUJOB,"PSUFLAG2")) K ^XTMP("PSU_"_PSUJOB,"PSUNONE")
D EN1
Q
;
EN1 ;Gather summary data for UD/IV/RX report
D PULL^PSUCP
D DATE
S I=7
D UNIQUE
D TOP
D OPDIV
D DIVTOT
D TUDIV
D IPDIV
D IPDIV1
D TAB3
D TAB4
D PDSUM^PSUDEM5 ;Mail message
K ^XTMP("PSU_"_PSUJOB,"PSUTMP")
K ^XTMP("PSU_"_PSUJOB,"PSUTOTAL")
K ^XTMP("PSU_"_PSUJOB,"PSURXUNIQUE")
K ^XTMP("PSU_"_PSUJOB,"PSURXTOTAL")
K ^XTMP("PSU_"_PSUJOB,"PSURXCTA")
K ^XTMP("PSU_"_PSUJOB,"PSURXSSN")
K ^XTMP("PSU_"_PSUJOB,"PSUCOMBO")
K ^XTMP("PSU_"_PSUJOB,"PSUIVSSN")
K ^XTMP("PSU_"_PSUJOB,"PSUUDSSN")
K ^XTMP("PSU_"_PSUJOB,"PSUIVDIV")
K ^XTMP("PSU_"_PSUJOB,"PSUIVOUT")
K ^XTMP("PSU_"_PSUJOB,"PSUUDDIV")
Q
;
DATE ;EN 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 COMSUM
Q
;
COMSUM ;Summary report header to be run for combination Rx/IV/UD report
;
;Report header
S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",1)="PHARMACY 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 total unique pharmacy patients across all divisions
;
S PSURXN=0,PSUIVN=0,PSUUDN1=0
;
M ^XTMP("PSU_"_PSUJOB,"PSUTMP")=^XTMP("PSU_"_PSUJOB,"PSURXSSN")
M ^XTMP("PSU_"_PSUJOB,"PSUTMP")=^XTMP("PSU_"_PSUJOB,"PSUIVSSN")
M ^XTMP("PSU_"_PSUJOB,"PSUTMP")=^XTMP("PSU_"_PSUJOB,"PSUUDSSN")
;
;
S N=1
S PSUTTL=0
F S PSUTTL=$O(^XTMP("PSU_"_PSUJOB,"PSUTMP",PSUTTL)) Q:PSUTTL="" D
.S ^XTMP("PSU_"_PSUJOB,"PSUTOTAL")=N S N=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
;
N PSUTB3,PSUTB4,PSUTB5
;
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)
I '$G(^XTMP("PSU_"_PSUJOB,"PSUTOTAL")) D
.S ^XTMP("PSU_"_PSUJOB,"PSUTOTAL")=0
S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=PSUTB4_PSUTB3_$P($G(^XTMP("PSU_"_PSUJOB,"PSUTOTAL")),U,1)
S I=I+1
Q
;
TOP ;EN Find Total Outpatients
N PSUTB1,PSUTB2
;
N PSUTOP,PSULBL
S PSUTOP=$G(^XTMP("PSU_"_PSUJOB,"PSURXUNIQUE"))
I '$G(PSUTOP) S PSUTOP=0,PSUTOPF=1
S PSULBL=" Total OUTPATIENT:"
D TAB
S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=PSULBL_PSUTB1_PSUTOP S I=I+1
S $P(^XTMP("PSU_"_PSUJOB,"PSUSUMA",I),"-",70)="" S I=I+1
Q
;
TAB ;Calculate tab spacing
;
S PSUTB1=" "
S PSUTB2=(64-$L(PSUTOP))-$L(PSULBL)
F S2=1:1:(PSUTB2-1) S PSUTB(S2)=" " D
.S PSUTB1=PSUTB1_PSUTB(S2)
Q
;
OPDIV ;EN Find outpatients per division
;
Q:$G(PSUTOPF)
N PSUTB1,PSUTB2
;
N PSUTTL
S PSULBL=0
I $D(^XTMP("PSU_"_PSUJOB,"PSURXCTA")) D
.F S PSULBL=$O(^XTMP("PSU_"_PSUJOB,"PSURXCTA",PSULBL)) Q:PSULBL="" D
..Q:PSULBL=0
..S PSUTTL=$P($G(^XTMP("PSU_"_PSUJOB,"PSURXCTA",PSULBL)),U,1)
..D TAB1
..S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=" "_PSULBL_" Division:"_PSUTB1_PSUTTL
..S I=I+1
I '$D(^XTMP("PSU_"_PSUJOB,"PSURXCTA")) D
.S PSUTTL=0
.D TAB1
.S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=" "_PSULBL_" Division:"_PSUTB1_PSUTTL
.S I=I+1
S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=" ----------" S I=I+1
Q
;
TAB1 ;EN Calculate division tab spacing
;
S PSUTB1=" "
S PSUTB2=(59-$L(PSUTTL))-$L(PSULBL)-10
F S2=1:1:(PSUTB2-1) S PSUTB(S2)=" " D
.S PSUTB1=PSUTB1_PSUTB(S2)
Q
;
DIVTOT ;EN Calculate tab spacing for 'Outpatient total of all divisions'
;line and set line into message global
;
N PSUTB3,PSUTB4,PSUTB5
;
I '$G(^XTMP("PSU_"_PSUJOB,"PSURXTOTAL")) D
.S ^XTMP("PSU_"_PSUJOB,"PSURXTOTAL")=0
S PSUTB3=" "
S PSUTB4=" Outpatient Total of all Divisions:"
S PSUTB5=(64-$L(PSUTB4))-$L($P($G(^XTMP("PSU_"_PSUJOB,"PSURXTOTAL")),U,1))
F S3=1:1:(PSUTB5-1) S PSUTB3(S3)=" " D
.S PSUTB3=PSUTB3_PSUTB(S3)
S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=PSUTB4_PSUTB3_$P($G(^XTMP("PSU_"_PSUJOB,"PSURXTOTAL")),U,1) S I=I+1
S $P(^XTMP("PSU_"_PSUJOB,"PSUSUMA",I),"-",70)="" S I=I+1
Q
;
TUDIV ;Calculate tab spacing for 'Total INPATIENT' line and
;set line into message global
;
N PSUTB3,PSUTB4,PSUTB5
;
;Create global with total number of unique UD + IV inpatients
;using patient SSN to ID unique patient
M ^XTMP("PSU_"_PSUJOB,"PSUUDIVT")=^XTMP("PSU_"_PSUJOB,"PSUDIV1")
M ^XTMP("PSU_"_PSUJOB,"PSUUDIVT")=^XTMP("PSU_"_PSUJOB,"PSUDIVUD")
;
;Loop through division global and create global with unique SSN
S G=1
S PSUD2=0
F S PSUD2=$O(^XTMP("PSU_"_PSUJOB,"PSUUDIVT",PSUD2)) Q:PSUD2="" D
.S PSUD8=0
.F S PSUD8=$O(^XTMP("PSU_"_PSUJOB,"PSUUDIVT",PSUD2,PSUD8)) Q:PSUD8="" D
..S ^XTMP("PSU_"_PSUJOB,"PSUUDIVT1",PSUD8)="" ;Unique SSN's
;
;Find number of unique SSN's. This is number of unique patients
S PSUD9=0
F S PSUD9=$O(^XTMP("PSU_"_PSUJOB,"PSUUDIVT1",PSUD9)) Q:PSUD9="" D
.S ^XTMP("PSU_"_PSUJOB,"PSUUDIVTOT")=G,G=G+1
;
;Calculate tab spacing
S PSUTB3=" "
S PSUTB4=" Total INPATIENT:"
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
;
;Set line into message global
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
;
IPDIV ;EN Find inpatients by division (includes UD patients and IV
;patients with ward location NOT set to 0.5
;
;If no Unit Dose data exists, do the following to get IV data:
I $D(^XTMP("PSU_"_PSUJOB,"PSUNONE","UD")) D Q
.M ^XTMP("PSU_"_PSUJOB,"PSUINPT")=^XTMP("PSU_"_PSUJOB,"PSUDIV1")
;
;If no IV data exists, do the following to get UD data:
I $D(^XTMP("PSU_"_PSUJOB,"PSUNONE","IV")) D Q
.M ^XTMP("PSU_"_PSUJOB,"PSUINPT")=^XTMP("PSU_"_PSUJOB,"PSUDIVUD")
;
;Construct a storage global containing unique inpatients
;per division when there is both UD and IV data
S PSUDV1=0
F S PSUDV1=$O(^XTMP("PSU_"_PSUJOB,"PSUDIV1",PSUDV1)) Q:PSUDV1="" D
.S PSUDVUD=0
.F S PSUDVUD=$O(^XTMP("PSU_"_PSUJOB,"PSUDIVUD",PSUDVUD)) Q:PSUDVUD="" D
..I PSUDVUD=PSUDV1 D
...S PSUPT=0
...F S PSUPT=$O(^XTMP("PSU_"_PSUJOB,"PSUDIV1",PSUDV1,PSUPT)) Q:PSUPT="" D
....S ^XTMP("PSU_"_PSUJOB,"PSUINPT",PSUDV1,PSUPT)=""
....S PSUPT1=0
....F S PSUPT1=$O(^XTMP("PSU_"_PSUJOB,"PSUDIVUD",PSUDVUD,PSUPT1)) Q:PSUPT1="" D
.....S ^XTMP("PSU_"_PSUJOB,"PSUINPT",PSUDVUD,PSUPT1)=""
..I PSUDVUD'=PSUDV1 D
...M ^XTMP("PSU_"_PSUJOB,"PSUINPT")=^XTMP("PSU_"_PSUJOB,"PSUDIVUD")
Q
;
IPDIV1 ;Calculate inpatient totals
;
S PSUSIT=0,PSUSIT1=0,T=1
;
F S PSUSIT=$O(^XTMP("PSU_"_PSUJOB,"PSUINPT",PSUSIT)) Q:PSUSIT="" D
.F S PSUSIT1=$O(^XTMP("PSU_"_PSUJOB,"PSUINPT",PSUSIT,PSUSIT1)) Q:PSUSIT1="" D
..I $D(^XTMP("PSU_"_PSUJOB,"PSUCOMBO",PSUSIT)) D
...S C=C+1
...S ^XTMP("PSU_"_PSUJOB,"PSUCOMBO",PSUSIT)=C
..I '$D(^XTMP("PSU_"_PSUJOB,"PSUCOMBO",PSUSIT)) D
...S C=1
...S ^XTMP("PSU_"_PSUJOB,"PSUCOMBO",PSUSIT)=C
Q
;
TAB3 ;Place inpatient division totals into summary message
;
N PSUTB1,PSUTB2
;
N PSUTTL
S PSULBL=0
F S PSULBL=$O(^XTMP("PSU_"_PSUJOB,"PSUCOMBO",PSULBL)) Q:PSULBL="" D
.S PSUTTL=$P($G(^XTMP("PSU_"_PSUJOB,"PSUCOMBO",PSULBL)),U,1)
.I '$G(PSUTTL) S PSUTTL=0
.D TAB1
.S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=" "_PSULBL_" Division:"_PSUTB1_PSUTTL
.S I=I+1
Q
;
TAB4 ;Calculate inpatient totals of all divisions and place in summary
;message
;
S N=0,PSUMKER=0
F S PSUMKER=$O(^XTMP("PSU_"_PSUJOB,"PSUCOMBO",PSUMKER)) Q:PSUMKER="" D
.S N=$P(^XTMP("PSU_"_PSUJOB,"PSUCOMBO",PSUMKER),U)+N
S ^XTMP("PSU_"_PSUJOB,"PSUTOTAL")=N ;Sum of all inpatients
;
D TAB1^PSUSUM3
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSUSUM6 9144 printed Oct 16, 2024@18:29:15 Page 2
PSUSUM6 ;BIR/DAM - Patient Demographics Summary for IV/UD/RX ; 20 DEC 2001
+1 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
+2 ;
EN ;EN CALLED FROM PSUOP0
+1 ;
+2 ;DAM Trying to make auto run
KILL ^XTMP("PSU_"_PSUJOB,"PSUSUMA")
+3 IF $DATA(^XTMP("PSU_"_PSUJOB,"PSUFLAG2"))!$DATA(^XTMP("PSU_"_PSUJOB,"PSUFLAG3"))
Begin DoDot:1
+4 KILL ^XTMP("PSU_"_PSUJOB,"PSUSUMA")
End DoDot:1
+5 ;
+6 NEW PSURX,PSUIV,PSUUD
+7 SET PSURX=$GET(^XTMP("PSU_"_PSUJOB,"PSUNONE","RX"))
+8 SET PSUIV=$GET(^XTMP("PSU_"_PSUJOB,"PSUNONE","IV"))
+9 SET PSUUD=$GET(^XTMP("PSU_"_PSUJOB,"PSUNONE","UD"))
+10 IF $GET(PSURX)&$GET(PSUIV)&$GET(PSUUD)
Begin DoDot:1
+11 DO NODATA
Begin DoDot:2
+12 IF $DATA(^XTMP("PSU_"_PSUJOB,"PSUFLAG1"))!$DATA(^XTMP("PSU_"_PSUJOB,"PSUFLAG2"))
KILL ^XTMP("PSU_"_PSUJOB,"PSUNONE")
End DoDot:2
End DoDot:1
QUIT
+13 DO EN1
+14 QUIT
+15 ;
EN1 ;Gather summary data for UD/IV/RX report
+1 DO PULL^PSUCP
+2 DO DATE
+3 SET I=7
+4 DO UNIQUE
+5 DO TOP
+6 DO OPDIV
+7 DO DIVTOT
+8 DO TUDIV
+9 DO IPDIV
+10 DO IPDIV1
+11 DO TAB3
+12 DO TAB4
+13 ;Mail message
DO PDSUM^PSUDEM5
+14 KILL ^XTMP("PSU_"_PSUJOB,"PSUTMP")
+15 KILL ^XTMP("PSU_"_PSUJOB,"PSUTOTAL")
+16 KILL ^XTMP("PSU_"_PSUJOB,"PSURXUNIQUE")
+17 KILL ^XTMP("PSU_"_PSUJOB,"PSURXTOTAL")
+18 KILL ^XTMP("PSU_"_PSUJOB,"PSURXCTA")
+19 KILL ^XTMP("PSU_"_PSUJOB,"PSURXSSN")
+20 KILL ^XTMP("PSU_"_PSUJOB,"PSUCOMBO")
+21 KILL ^XTMP("PSU_"_PSUJOB,"PSUIVSSN")
+22 KILL ^XTMP("PSU_"_PSUJOB,"PSUUDSSN")
+23 KILL ^XTMP("PSU_"_PSUJOB,"PSUIVDIV")
+24 KILL ^XTMP("PSU_"_PSUJOB,"PSUIVOUT")
+25 KILL ^XTMP("PSU_"_PSUJOB,"PSUUDDIV")
+26 QUIT
+27 ;
DATE ;EN 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 COMSUM
+15 QUIT
+16 ;
COMSUM ;Summary report header to be run for combination Rx/IV/UD report
+1 ;
+2 ;Report header
+3 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",1)="PHARMACY 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 total unique pharmacy patients across all divisions
+1 ;
+2 SET PSURXN=0
SET PSUIVN=0
SET PSUUDN1=0
+3 ;
+4 MERGE ^XTMP("PSU_"_PSUJOB,"PSUTMP")=^XTMP("PSU_"_PSUJOB,"PSURXSSN")
+5 MERGE ^XTMP("PSU_"_PSUJOB,"PSUTMP")=^XTMP("PSU_"_PSUJOB,"PSUIVSSN")
+6 MERGE ^XTMP("PSU_"_PSUJOB,"PSUTMP")=^XTMP("PSU_"_PSUJOB,"PSUUDSSN")
+7 ;
+8 ;
+9 SET N=1
+10 SET PSUTTL=0
+11 FOR
SET PSUTTL=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUTMP",PSUTTL))
if PSUTTL=""
QUIT
Begin DoDot:1
+12 SET ^XTMP("PSU_"_PSUJOB,"PSUTOTAL")=N
SET N=N+1
End DoDot:1
+13 DO TAB2
+14 SET $PIECE(^XTMP("PSU_"_PSUJOB,"PSUSUMA",I),"-",70)=""
SET I=I+1
+15 QUIT
+16 ;
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=(64-$LENGTH(PSUTB4))-$LENGTH($PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSUTOTAL")),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 IF '$GET(^XTMP("PSU_"_PSUJOB,"PSUTOTAL"))
Begin DoDot:1
+10 SET ^XTMP("PSU_"_PSUJOB,"PSUTOTAL")=0
End DoDot:1
+11 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=PSUTB4_PSUTB3_$PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSUTOTAL")),U,1)
+12 SET I=I+1
+13 QUIT
+14 ;
TOP ;EN Find Total Outpatients
+1 NEW PSUTB1,PSUTB2
+2 ;
+3 NEW PSUTOP,PSULBL
+4 SET PSUTOP=$GET(^XTMP("PSU_"_PSUJOB,"PSURXUNIQUE"))
+5 IF '$GET(PSUTOP)
SET PSUTOP=0
SET PSUTOPF=1
+6 SET PSULBL=" Total OUTPATIENT:"
+7 DO TAB
+8 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=PSULBL_PSUTB1_PSUTOP
SET I=I+1
+9 SET $PIECE(^XTMP("PSU_"_PSUJOB,"PSUSUMA",I),"-",70)=""
SET I=I+1
+10 QUIT
+11 ;
TAB ;Calculate tab spacing
+1 ;
+2 SET PSUTB1=" "
+3 SET PSUTB2=(64-$LENGTH(PSUTOP))-$LENGTH(PSULBL)
+4 FOR S2=1:1:(PSUTB2-1)
SET PSUTB(S2)=" "
Begin DoDot:1
+5 SET PSUTB1=PSUTB1_PSUTB(S2)
End DoDot:1
+6 QUIT
+7 ;
OPDIV ;EN Find outpatients per division
+1 ;
+2 if $GET(PSUTOPF)
QUIT
+3 NEW PSUTB1,PSUTB2
+4 ;
+5 NEW PSUTTL
+6 SET PSULBL=0
+7 IF $DATA(^XTMP("PSU_"_PSUJOB,"PSURXCTA"))
Begin DoDot:1
+8 FOR
SET PSULBL=$ORDER(^XTMP("PSU_"_PSUJOB,"PSURXCTA",PSULBL))
if PSULBL=""
QUIT
Begin DoDot:2
+9 if PSULBL=0
QUIT
+10 SET PSUTTL=$PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSURXCTA",PSULBL)),U,1)
+11 DO TAB1
+12 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=" "_PSULBL_" Division:"_PSUTB1_PSUTTL
+13 SET I=I+1
End DoDot:2
End DoDot:1
+14 IF '$DATA(^XTMP("PSU_"_PSUJOB,"PSURXCTA"))
Begin DoDot:1
+15 SET PSUTTL=0
+16 DO TAB1
+17 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=" "_PSULBL_" Division:"_PSUTB1_PSUTTL
+18 SET I=I+1
End DoDot:1
+19 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=" ----------"
SET I=I+1
+20 QUIT
+21 ;
TAB1 ;EN Calculate division tab spacing
+1 ;
+2 SET PSUTB1=" "
+3 SET PSUTB2=(59-$LENGTH(PSUTTL))-$LENGTH(PSULBL)-10
+4 FOR S2=1:1:(PSUTB2-1)
SET PSUTB(S2)=" "
Begin DoDot:1
+5 SET PSUTB1=PSUTB1_PSUTB(S2)
End DoDot:1
+6 QUIT
+7 ;
DIVTOT ;EN Calculate tab spacing for 'Outpatient total of all divisions'
+1 ;line and set line into message global
+2 ;
+3 NEW PSUTB3,PSUTB4,PSUTB5
+4 ;
+5 IF '$GET(^XTMP("PSU_"_PSUJOB,"PSURXTOTAL"))
Begin DoDot:1
+6 SET ^XTMP("PSU_"_PSUJOB,"PSURXTOTAL")=0
End DoDot:1
+7 SET PSUTB3=" "
+8 SET PSUTB4=" Outpatient Total of all Divisions:"
+9 SET PSUTB5=(64-$LENGTH(PSUTB4))-$LENGTH($PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSURXTOTAL")),U,1))
+10 FOR S3=1:1:(PSUTB5-1)
SET PSUTB3(S3)=" "
Begin DoDot:1
+11 SET PSUTB3=PSUTB3_PSUTB(S3)
End DoDot:1
+12 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=PSUTB4_PSUTB3_$PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSURXTOTAL")),U,1)
SET I=I+1
+13 SET $PIECE(^XTMP("PSU_"_PSUJOB,"PSUSUMA",I),"-",70)=""
SET I=I+1
+14 QUIT
+15 ;
TUDIV ;Calculate tab spacing for 'Total INPATIENT' line and
+1 ;set line into message global
+2 ;
+3 NEW PSUTB3,PSUTB4,PSUTB5
+4 ;
+5 ;Create global with total number of unique UD + IV inpatients
+6 ;using patient SSN to ID unique patient
+7 MERGE ^XTMP("PSU_"_PSUJOB,"PSUUDIVT")=^XTMP("PSU_"_PSUJOB,"PSUDIV1")
+8 MERGE ^XTMP("PSU_"_PSUJOB,"PSUUDIVT")=^XTMP("PSU_"_PSUJOB,"PSUDIVUD")
+9 ;
+10 ;Loop through division global and create global with unique SSN
+11 SET G=1
+12 SET PSUD2=0
+13 FOR
SET PSUD2=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUUDIVT",PSUD2))
if PSUD2=""
QUIT
Begin DoDot:1
+14 SET PSUD8=0
+15 FOR
SET PSUD8=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUUDIVT",PSUD2,PSUD8))
if PSUD8=""
QUIT
Begin DoDot:2
+16 ;Unique SSN's
SET ^XTMP("PSU_"_PSUJOB,"PSUUDIVT1",PSUD8)=""
End DoDot:2
End DoDot:1
+17 ;
+18 ;Find number of unique SSN's. This is number of unique patients
+19 SET PSUD9=0
+20 FOR
SET PSUD9=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUUDIVT1",PSUD9))
if PSUD9=""
QUIT
Begin DoDot:1
+21 SET ^XTMP("PSU_"_PSUJOB,"PSUUDIVTOT")=G
SET G=G+1
End DoDot:1
+22 ;
+23 ;Calculate tab spacing
+24 SET PSUTB3=" "
+25 SET PSUTB4=" Total INPATIENT:"
+26 SET PSUTB5=(64-$LENGTH(PSUTB4))-$LENGTH($PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSUUDIVTOT")),U,1))
+27 FOR S3=1:1:(PSUTB5-1)
SET PSUTB(S3)=" "
Begin DoDot:1
+28 ;Tab position
SET PSUTB3=PSUTB3_PSUTB(S3)
End DoDot:1
+29 ;
+30 ;Set line into message global
+31 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=PSUTB4_PSUTB3_$PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSUUDIVTOT")),U,1)
SET I=I+1
+32 SET $PIECE(^XTMP("PSU_"_PSUJOB,"PSUSUMA",I),"-",70)=""
SET I=I+1
+33 QUIT
+34 ;
IPDIV ;EN Find inpatients by division (includes UD patients and IV
+1 ;patients with ward location NOT set to 0.5
+2 ;
+3 ;If no Unit Dose data exists, do the following to get IV data:
+4 IF $DATA(^XTMP("PSU_"_PSUJOB,"PSUNONE","UD"))
Begin DoDot:1
+5 MERGE ^XTMP("PSU_"_PSUJOB,"PSUINPT")=^XTMP("PSU_"_PSUJOB,"PSUDIV1")
End DoDot:1
QUIT
+6 ;
+7 ;If no IV data exists, do the following to get UD data:
+8 IF $DATA(^XTMP("PSU_"_PSUJOB,"PSUNONE","IV"))
Begin DoDot:1
+9 MERGE ^XTMP("PSU_"_PSUJOB,"PSUINPT")=^XTMP("PSU_"_PSUJOB,"PSUDIVUD")
End DoDot:1
QUIT
+10 ;
+11 ;Construct a storage global containing unique inpatients
+12 ;per division when there is both UD and IV data
+13 SET PSUDV1=0
+14 FOR
SET PSUDV1=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUDIV1",PSUDV1))
if PSUDV1=""
QUIT
Begin DoDot:1
+15 SET PSUDVUD=0
+16 FOR
SET PSUDVUD=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUDIVUD",PSUDVUD))
if PSUDVUD=""
QUIT
Begin DoDot:2
+17 IF PSUDVUD=PSUDV1
Begin DoDot:3
+18 SET PSUPT=0
+19 FOR
SET PSUPT=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUDIV1",PSUDV1,PSUPT))
if PSUPT=""
QUIT
Begin DoDot:4
+20 SET ^XTMP("PSU_"_PSUJOB,"PSUINPT",PSUDV1,PSUPT)=""
+21 SET PSUPT1=0
+22 FOR
SET PSUPT1=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUDIVUD",PSUDVUD,PSUPT1))
if PSUPT1=""
QUIT
Begin DoDot:5
+23 SET ^XTMP("PSU_"_PSUJOB,"PSUINPT",PSUDVUD,PSUPT1)=""
End DoDot:5
End DoDot:4
End DoDot:3
+24 IF PSUDVUD'=PSUDV1
Begin DoDot:3
+25 MERGE ^XTMP("PSU_"_PSUJOB,"PSUINPT")=^XTMP("PSU_"_PSUJOB,"PSUDIVUD")
End DoDot:3
End DoDot:2
End DoDot:1
+26 QUIT
+27 ;
IPDIV1 ;Calculate inpatient totals
+1 ;
+2 SET PSUSIT=0
SET PSUSIT1=0
SET T=1
+3 ;
+4 FOR
SET PSUSIT=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUINPT",PSUSIT))
if PSUSIT=""
QUIT
Begin DoDot:1
+5 FOR
SET PSUSIT1=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUINPT",PSUSIT,PSUSIT1))
if PSUSIT1=""
QUIT
Begin DoDot:2
+6 IF $DATA(^XTMP("PSU_"_PSUJOB,"PSUCOMBO",PSUSIT))
Begin DoDot:3
+7 SET C=C+1
+8 SET ^XTMP("PSU_"_PSUJOB,"PSUCOMBO",PSUSIT)=C
End DoDot:3
+9 IF '$DATA(^XTMP("PSU_"_PSUJOB,"PSUCOMBO",PSUSIT))
Begin DoDot:3
+10 SET C=1
+11 SET ^XTMP("PSU_"_PSUJOB,"PSUCOMBO",PSUSIT)=C
End DoDot:3
End DoDot:2
End DoDot:1
+12 QUIT
+13 ;
TAB3 ;Place inpatient division totals into summary message
+1 ;
+2 NEW PSUTB1,PSUTB2
+3 ;
+4 NEW PSUTTL
+5 SET PSULBL=0
+6 FOR
SET PSULBL=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUCOMBO",PSULBL))
if PSULBL=""
QUIT
Begin DoDot:1
+7 SET PSUTTL=$PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSUCOMBO",PSULBL)),U,1)
+8 IF '$GET(PSUTTL)
SET PSUTTL=0
+9 DO TAB1
+10 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=" "_PSULBL_" Division:"_PSUTB1_PSUTTL
+11 SET I=I+1
End DoDot:1
+12 QUIT
+13 ;
TAB4 ;Calculate inpatient totals of all divisions and place in summary
+1 ;message
+2 ;
+3 SET N=0
SET PSUMKER=0
+4 FOR
SET PSUMKER=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUCOMBO",PSUMKER))
if PSUMKER=""
QUIT
Begin DoDot:1
+5 SET N=$PIECE(^XTMP("PSU_"_PSUJOB,"PSUCOMBO",PSUMKER),U)+N
End DoDot:1
+6 ;Sum of all inpatients
SET ^XTMP("PSU_"_PSUJOB,"PSUTOTAL")=N
+7 ;
+8 DO TAB1^PSUSUM3
+9 QUIT
+10 ;
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
