221 lines
7.4 KiB
Mathematica
221 lines
7.4 KiB
Mathematica
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
|