Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSUSUM3

PSUSUM3.m

Go to the documentation of this file.
  1. PSUSUM3 ;BIR/DAM - Patient Demographics Summary for UD Extract ; 20 DEC 2001
  1. ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
  1. ;
  1. ;DBIA's
  1. ; Reference to file #55 supported by DBIA 3502
  1. ; Reference to file #42 supported by DBIA 1848
  1. ; Reference to file #40.8 supported by DBIA 1576
  1. ;
  1. EN ;EN CALLED FROM PSUUD0
  1. ;Q:$D(^XTMP("PSU_"_PSUJOB,"PSUMFLAG")) ;Do not run if auto extract
  1. ;
  1. D PULL^PSUCP
  1. F I=1:1:$L(PSUOPTS,",") S PSUMOD($P(PSUOPTS,",",I))=""
  1. ;
  1. I $D(^XTMP("PSU_"_PSUJOB,"PSUNONE","UD")) D Q ;report if there is no data
  1. .I $D(PSUMOD(2))&'$D(PSUMOD(1)) D
  1. ..I '$D(PSUMOD(4)) D
  1. ...D NODATA D
  1. ....I $D(^XTMP("PSU_"_PSUJOB,"PSUFLAG1")) K ^XTMP("PSU_"_PSUJOB,"PSUNONE")
  1. ....K ^XTMP("PSU_"_PSUJOB,"PSUSUMA")
  1. D EN1
  1. Q
  1. ;
  1. EN1 ;Entry point to collect data
  1. D DATE
  1. M ^XTMP("PSU_"_PSUJOB,"PSUUD")=^XTMP(PSUUDSUB)
  1. D RE
  1. D UNIQUE
  1. S I=9 ;Line counter for division data in summary report
  1. D DIVNUM
  1. D TOTAL
  1. D TAB1
  1. ;
  1. I $D(PSUMOD(1))&$D(PSUMOD(2)) D
  1. .I $D(PSUMOD(4)) D
  1. ..M ^XTMP("PSU_"_PSUJOB,"PSUUDDIV")=^XTMP("PSU_"_PSUJOB,"PSUCT")
  1. ..M ^XTMP("PSU_"_PSUJOB,"PSUUDSSN")=^XTMP("PSU_"_PSUJOB,"PSUIPT")
  1. ..M ^XTMP("PSU_"_PSUJOB,"PSUDIVUD")=^XTMP("PSU_"_PSUJOB,"PSUDIV")
  1. ;
  1. I '$D(PSUMOD(1))&$D(PSUMOD(2)) D
  1. .I $D(PSUMOD(4)) D
  1. ..M ^XTMP("PSU_"_PSUJOB,"PSUUDDIV")=^XTMP("PSU_"_PSUJOB,"PSUCT")
  1. ..M ^XTMP("PSU_"_PSUJOB,"PSUUDSSN")=^XTMP("PSU_"_PSUJOB,"PSUIPT")
  1. ;
  1. I $D(PSUMOD(1))&$D(PSUMOD(2)) D
  1. .I '$D(PSUMOD(4)) D
  1. ..M ^XTMP("PSU_"_PSUJOB,"PSUUDDIV")=^XTMP("PSU_"_PSUJOB,"PSUCT")
  1. ..M ^XTMP("PSU_"_PSUJOB,"PSUUDIN")=^XTMP("PSU_"_PSUJOB,"PSUIPT")
  1. ..M ^XTMP("PSU_"_PSUJOB,"PSUDIVUD")=^XTMP("PSU_"_PSUJOB,"PSUDIV")
  1. ;
  1. I '$D(PSUMOD(1))&'$D(PSUMOD(4)) D
  1. .D PDSUM^PSUDEM5 ;Mail message
  1. .K ^XTMP("PSU_"_PSUJOB,"PSUUDDIV")
  1. K ^XTMP("PSU_"_PSUJOB,"PSUUD")
  1. I $D(^XTMP("PSU_"_PSUJOB,"PSUFLAG1")) K ^XTMP("PSU_"_PSUJOB,"PSUSUMA")
  1. K ^XTMP("PSU_"_PSUJOB,"PSUFLAG1")
  1. ;K ^XTMP("PSU_"_PSUJOB,"PSUTOTAL")
  1. K ^XTMP("PSU_"_PSUJOB,"PSUCT")
  1. K ^XTMP("PSU_"_PSUJOB,"PSURXCTA")
  1. Q
  1. ;
  1. RE ;Rearrange the ^XTMP("PSU_"_PSUJOB,"PSUUD","DETAIL" global so information in PATDIV
  1. ;can be accessed quickly.
  1. ;
  1. N PSUSIT
  1. S PSUSIT=PSUSNDR
  1. ;D INST^PSUDEM1 S PSUSIT=$P(^XTMP("PSU_"_PSUJOB,"PSUSITE"),U,1)
  1. ;
  1. N PSUSSNA,PSUUDA
  1. S PSUPN1=0,PSUSIT1=0
  1. F S PSUSIT1=$O(^XTMP("PSU_"_PSUJOB,"PSUUD","DETAIL",PSUSIT1)) Q:PSUSIT1="" D
  1. .F S PSUPN1=$O(^XTMP("PSU_"_PSUJOB,"PSUUD","DETAIL",PSUSIT1,PSUPN1)) Q:PSUPN1="" D
  1. ..S PSUUDA=$P($G(^XTMP("PSU_"_PSUJOB,"PSUUD","DETAIL",PSUSIT1,PSUPN1)),U,4)
  1. ..S PSUSSNA=$P($G(^XTMP("PSU_"_PSUJOB,"PSUUD","DETAIL",PSUSIT1,PSUPN1)),U,5) D
  1. ...S PSUDFN=0
  1. ...F S PSUDFN=$O(^XTMP("PSU_"_PSUJOB,"PSUTDFN",PSUDFN)) Q:PSUDFN="" D
  1. ....S PSUSN=0
  1. ....F S PSUSN=$O(^XTMP("PSU_"_PSUJOB,"PSUTDFN",PSUDFN,PSUSN)) Q:PSUSN="" D
  1. .....I PSUSN=PSUSSNA S ^XTMP("PSU_"_PSUJOB,"PSUORSN1",PSUDFN,PSUUDA)=PSUSN
  1. .....;S ^XTMP("PSU_"_PSUJOB,"PSUORSN",PSUUDA)=PSUSSNA
  1. Q
  1. ;
  1. DATE ;Convert date range of extract to external format
  1. ;
  1. S %H=$E($H,1,5) ;today's date
  1. D YX^%DTC
  1. N PSUD S PSUD=Y
  1. ;
  1. S Y=PSUSDT ;Start date of extract
  1. D DD^%DT
  1. N PSUS S PSUS=Y
  1. ;
  1. S Y=PSUEDT ;End date of extract
  1. D DD^%DT
  1. N PSUE S PSUE=Y
  1. ;
  1. D UDSUM
  1. Q
  1. ;
  1. UDSUM ;Summary report header to be run if UD (Inpatient) extract is run
  1. ;
  1. ;Report header
  1. S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",1)="PHARMACY INPATIENT (UD) UNIQUE PATIENTS REPORT "_PSUD
  1. S $P(^XTMP("PSU_"_PSUJOB,"PSUSUMA",2),"-",80)="" ;Separator bar
  1. S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",3)=" "_PSUS_" through "_PSUE
  1. S $P(^XTMP("PSU_"_PSUJOB,"PSUSUMA",4),"=",80)=""
  1. S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",5)=" UNIQUE"
  1. S $P(^XTMP("PSU_"_PSUJOB,"PSUSUMA",6),"-",70)=""
  1. Q
  1. ;
  1. UNIQUE ;Find number of unique patients across all divisions
  1. ;
  1. S PSUUDS=0
  1. N PSUUDS3
  1. F S PSUUDS=$O(^XTMP("PSU_"_PSUJOB,"PSUORSN1",PSUUDS)) Q:PSUUDS="" D
  1. .S PSUUDS1=0
  1. .S PSUUDS1=$O(^XTMP("PSU_"_PSUJOB,"PSUORSN1",PSUUDS,PSUUDS1)) Q:PSUUDS1="" D
  1. ..S PSUUDS3=$P($G(^XTMP("PSU_"_PSUJOB,"PSUORSN1",PSUUDS,PSUUDS1)),U,1)
  1. ..S ^XTMP("PSU_"_PSUJOB,"PSUIPT",PSUUDS3)="" ;Set up global for unique SSNs
  1. .;S PSUUDS1=$P(^XTMP("PSU_"_PSUJOB,"PSUORSN",PSUUDS),U)
  1. .;S ^XTMP("PSU_"_PSUJOB,"PSUIPT",PSUUDS1)="" ;Set up global for unique SSNs
  1. ;
  1. S B=1
  1. S PSUUDS2=0
  1. F S PSUUDS2=$O(^XTMP("PSU_"_PSUJOB,"PSUIPT",PSUUDS2)) Q:PSUUDS2="" D
  1. .S ^XTMP("PSU_"_PSUJOB,"PSUIPT")=B,B=B+1 ;B=total count unique patients
  1. .D TAB2
  1. S $P(^XTMP("PSU_"_PSUJOB,"PSUSUMA",8),"-",70)=""
  1. Q
  1. ;
  1. TAB2 ;Tab spacing for line 7. Set line into global
  1. ;
  1. N PSUTB3,PSUTB4,PSUTB5
  1. ;
  1. S PSUTB3=" "
  1. S PSUTB4="TOTAL patients across all divisions:"
  1. S PSUTB5=(64-$L(PSUTB4))-$L($P($G(^XTMP("PSU_"_PSUJOB,"PSUIPT")),U,1))
  1. F S3=1:1:(PSUTB5-1) S PSUTB(S3)=" " D
  1. .S PSUTB3=PSUTB3_PSUTB(S3)
  1. S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",7)=PSUTB4_PSUTB3_$P($G(^XTMP("PSU_"_PSUJOB,"PSUIPT")),U,1)
  1. Q
  1. ;
  1. DIVNUM ;Set number of patients per division into summary message
  1. ;
  1. N PSUTB1,PSUTB2
  1. ;
  1. N PSUCT3
  1. S PSUDIVA2=0
  1. F S PSUDIVA2=$O(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUDIVA2)) Q:PSUDIVA2="" D
  1. .S PSUCT3=$P($G(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUDIVA2)),U,1)
  1. .D TAB
  1. .S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=" "_PSUDIVA2_" Division:"_PSUTB1_PSUCT3
  1. .S I=I+1
  1. Q
  1. ;
  1. TAB ;Calculate tab spacing
  1. ;
  1. S PSUTB1=" "
  1. S PSUTB2=(59-$L(PSUCT3))-$L(PSUDIVA2)-10
  1. F S2=1:1:(PSUTB2-1) S PSUTB(S2)=" " D
  1. .S PSUTB1=PSUTB1_PSUTB(S2) ;Tab position
  1. Q
  1. ;
  1. TOTAL ;EN Calculate Inpatient total of all divisions
  1. ;
  1. N PSUIPCT
  1. S PSUIPTOT=0
  1. S PSUTOCT1=0
  1. F S PSUIPTOT=$O(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUIPTOT)) Q:PSUIPTOT="" D
  1. .S PSUIPCT=$P($G(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUIPTOT)),U,1)
  1. .S PSUTOCT1=PSUTOCT1+PSUIPCT
  1. S $P(^XTMP("PSU_"_PSUJOB,"PSUTOTAL"),U,1)=PSUTOCT1
  1. Q
  1. ;
  1. TAB1 ;EN Calculate tab spacing for 'Outpatient Total of all Divisions' line.
  1. ;and set the last lines of message into the summary global.
  1. ;
  1. N PSUTB3,PSUTB4,PSUTB5
  1. ;
  1. I '$G(^XTMP("PSU_"_PSUJOB,"PSUTOTAL")) D
  1. .S ^XTMP("PSU_"_PSUJOB,"PSUTOTAL")=0
  1. S PSUTB3=" "
  1. S PSUTB4=" Inpatient Total of all Divisions:"
  1. S PSUTB5=(64-$L(PSUTB4))-$L($P($G(^XTMP("PSU_"_PSUJOB,"PSUTOTAL")),U,1))
  1. F S3=1:1:(PSUTB5-1) S PSUTB(S3)=" " D
  1. .S PSUTB3=PSUTB3_PSUTB(S3) ;Tab position
  1. S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=" ----------" S I=I+1
  1. S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=PSUTB4_PSUTB3_$P($G(^XTMP("PSU_"_PSUJOB,"PSUTOTAL")),U,1) S I=I+1
  1. S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)="" S I=I+1
  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
  1. S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)="have been provided pharmacy services at more than one outpatient and/or" S I=I+1
  1. S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)="inpatient division."
  1. Q
  1. ;
  1. NODATA ;Summary report line to be sent if there is no data
  1. ;
  1. S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",1)="PHARMACY INPATIENT (UD) UNIQUE PATIENTS REPORT"
  1. S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",2)=" "
  1. S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",3)="No data to report"
  1. D PDSUM^PSUDEM5
  1. Q