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

PSUSUM2.m

Go to the documentation of this file.
  1. PSUSUM2 ;BIR/DAM - Patient Demographics Summary for OP Extract ; 20 DEC 2001
  1. ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
  1. ;
  1. ;DBIA'S
  1. ; Reference to File #59 supported by DBIA 1876
  1. ;
  1. EN ;EN CALLED FROM PSUOP0
  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","RX")) D Q ;Summary report if there is no data
  1. .I '$D(PSUMOD(1))&'$D(PSUMOD(2)) D
  1. ..D NODATA
  1. ..I $D(^XTMP("PSU_"_PSUJOB,"PSUFLAG1"))!$D(^XTMP("PSU_"_PSUJOB,"PSUFLAG2")) K ^XTMP("PSU_"_PSUJOB,"PSUNONE")
  1. ;
  1. D DATE
  1. D DIVNUM
  1. D TOTAL
  1. S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=" ---------" S I=I+1
  1. S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)="" S I=I+1
  1. D TAB1
  1. I $D(PSUMOD(1))!$D(PSUMOD(2)) D
  1. .M ^XTMP("PSU_"_PSUJOB,"PSURXCTA")=^XTMP("PSU_"_PSUJOB,"PSUCT")
  1. .M ^XTMP("PSU_"_PSUJOB,"PSURXTOTAL")=^XTMP("PSU_"_PSUJOB,"PSUTOTAL")
  1. .S ^XTMP("PSU_"_PSUJOB,"PSURXUNIQUE")=M-1
  1. .M ^XTMP("PSU_"_PSUJOB,"PSURXSSN")=^XTMP("PSU_"_PSUJOB,"PSUSSN")
  1. ;
  1. I '$D(PSUMOD(1))&'$D(PSUMOD(2)) D
  1. .D PDSUM^PSUDEM5 ;Mail message
  1. K ^XTMP("PSU_"_PSUJOB,"PSUTOTAL")
  1. K ^XTMP("PSU_"_PSUJOB,"PSUSSN")
  1. K ^XTMP("PSU_"_PSUJOB,"PSUCT")
  1. K ^XTMP("PSU_"_PSUJOB,"PSUDIV")
  1. K ^XTMP("PSU_"_PSUJOB,"PSURX")
  1. I $D(^XTMP("PSU_"_PSUJOB,"PSUFLAG1")) K ^XTMP("PSU_"_PSUJOB,"PSUSUMA")
  1. K ^XTMP("PSU_"_PSUJOB,"PSUFLAG1")
  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 RXSUM
  1. Q
  1. ;
  1. RXSUM ;Summary report to be run if Rx (Outpatient) extract is run
  1. ;
  1. D UNIQUE
  1. ;Report header
  1. S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",1)="PHARMACY OUTPATIENT 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. D TAB2
  1. S $P(^XTMP("PSU_"_PSUJOB,"PSUSUMA",8),"-",70)=""
  1. S I=9
  1. ;
  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 Pharmacy patients across all divisions:"
  1. S PSUTB5=(67-$L(PSUTB4))-$L($P(^XTMP("PSU_"_PSUJOB,"PSUUNIQUE"),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(^XTMP("PSU_"_PSUJOB,"PSUUNIQUE"),U,1)
  1. Q
  1. ;
  1. UNIQUE ;Find UNIQUE patients across all divisions
  1. ;
  1. N PSUSIT,PSUTOTAL,PSUSOC1,PSUNIQUE,PSURX2,PSURX5
  1. M ^XTMP("PSU_"_PSUJOB,"PSURX")=^XTMP(PSUOPSUB)
  1. ;
  1. S M=0
  1. S N=1
  1. S PSUSIT=0
  1. S PSURX1=0
  1. F S PSUSIT=$O(^XTMP("PSU_"_PSUJOB,"PSURX","RECORDS",PSUSIT)) Q:'PSUSIT D
  1. .F S PSURX1=$O(^XTMP("PSU_"_PSUJOB,"PSURX","RECORDS",PSUSIT,PSURX1)) Q:'PSURX1 D
  1. ..I $P($G(^XTMP("PSU_"_PSUJOB,"PSURX","RECORDS",PSUSIT,PSURX1)),U,7)?9.10E D
  1. ...;S PSUTOTAL=N
  1. ...S PSUSOC1=$P($G(^XTMP("PSU_"_PSUJOB,"PSURX","RECORDS",PSUSIT,PSURX1)),U,7)
  1. ...I $G(PSUSOC1) S ^XTMP("PSU_"_PSUJOB,"PSUSSN",PSUSOC1)=""
  1. ...S N=N+1
  1. D ELIM
  1. Q
  1. ;
  1. ELIM ;Eliminate duplicate patient entries to get number of unique pts
  1. ;
  1. S PSUADM=0
  1. F S PSUADM=$O(^XTMP("PSU_"_PSUJOB,"PSUSSN",PSUADM)) Q:'PSUADM D
  1. .S $P(^XTMP("PSU_"_PSUJOB,"PSUUNIQUE"),U,1)=M
  1. .S M=M+1
  1. Q
  1. ;
  1. DIVNUM ;Set number of patients per division into summary message
  1. ;
  1. ;Find patient SSN's in the following global and place with the division
  1. ;number
  1. N PSUPTID,PSUPL
  1. S PSUDNUM=0
  1. S C=1
  1. F S PSUDNUM=$O(^XTMP("PSU_"_PSUJOB,"PSUDIVPT",PSUDNUM)) Q:PSUDNUM="" D
  1. .S PSUPL=0
  1. .F S PSUPL=$O(^XTMP("PSU_"_PSUJOB,"PSUDIVPT",PSUDNUM,PSUPL)) Q:PSUPL="" D
  1. ..S PSUPTID=$P(^XTMP("PSU_"_PSUJOB,"PSUDIVPT",PSUDNUM,PSUPL),U,7)
  1. ..Q:PSUPTID=""
  1. ..S ^XTMP("PSU_"_PSUJOB,"PSUCT0",PSUDNUM,PSUPTID)=""
  1. ;
  1. ;Get patient count for each division
  1. S PSUDNUM1=0
  1. F S PSUDNUM1=$O(^XTMP("PSU_"_PSUJOB,"PSUCT0",PSUDNUM1)) Q:PSUDNUM1="" D
  1. .S PSUID=0
  1. .F S PSUID=$O(^XTMP("PSU_"_PSUJOB,"PSUCT0",PSUDNUM1,PSUID)) Q:PSUID="" D
  1. ..I $D(^XTMP("PSU_"_PSUJOB,"PSUCT1",PSUDNUM1)) D
  1. ...S C=C+1
  1. ...S ^XTMP("PSU_"_PSUJOB,"PSUCT1",PSUDNUM1)=C
  1. ..I '$D(^XTMP("PSU_"_PSUJOB,"PSUCT1",PSUDNUM1)) D
  1. ...S C=1 S ^XTMP("PSU_"_PSUJOB,"PSUCT1",PSUDNUM1)=C
  1. ;
  1. ;Get division name
  1. S PSUDIV=0
  1. N PSUNBR
  1. F S PSUDIV=$O(^XTMP("PSU_"_PSUJOB,"PSUCT1",PSUDIV)) Q:PSUDIV="" D
  1. .S PSUNBR=$P(^XTMP("PSU_"_PSUJOB,"PSUCT1",PSUDIV),U,1)
  1. .S X=PSUDIV,DIC=59,DIC(0)="XM" D ^DIC ;**1
  1. .S X=+Y,PSUDIVNM=$$VAL^PSUTL(59,X,.01)
  1. .I PSUDIVNM'="" S ^XTMP("PSU_"_PSUJOB,"PSUCT",PSUDIVNM)=PSUNBR
  1. .I PSUDIVNM="" S ^XTMP("PSU_"_PSUJOB,"PSUCT",PSUDIV)=PSUNBR
  1. ;
  1. N PSUTB1,PSUTB2
  1. ;
  1. N PSUCT2
  1. S PSUDIVA1=0
  1. F S PSUDIVA1=$O(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUDIVA1)) Q:PSUDIVA1="" D
  1. .S PSUCT2=$P(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUDIVA1),U,1)
  1. .D TAB
  1. .S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=" "_PSUDIVA1_" Division:"_PSUTB1_PSUCT2
  1. .S I=I+1
  1. Q
  1. ;
  1. TAB ;Calculate tab spacing
  1. ;
  1. S PSUTB1=" "
  1. S PSUTB2=(62-$L(PSUCT2))-$L(PSUDIVA1)-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 ;Calculate Outpatient Total of all Divisions
  1. ;
  1. S PSUOPTOT=0
  1. S PSUTOCT1=0
  1. F S PSUOPTOT=$O(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUOPTOT)) Q:PSUOPTOT="" D
  1. .S PSUTOCT=$P(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUOPTOT),U,1)
  1. .S PSUTOCT1=PSUTOCT1+PSUTOCT
  1. S $P(^XTMP("PSU_"_PSUJOB,"PSUTOTAL"),U,1)=PSUTOCT1
  1. Q
  1. ;
  1. TAB1 ;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. S PSUTB3=" "
  1. S PSUTB4=" Outpatient Total of all Divisions:"
  1. S PSUTB5=(67-$L(PSUTB4))-$L($P(^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)=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 OUTPATIENT 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