202 lines
6.9 KiB
Mathematica
202 lines
6.9 KiB
Mathematica
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
|