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

PSUSUM6.m

Go to the documentation of this file.
  1. PSUSUM6 ;BIR/DAM - Patient Demographics Summary for IV/UD/RX ; 20 DEC 2001
  1. ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
  1. ;
  1. EN ;EN CALLED FROM PSUOP0
  1. ;
  1. K ^XTMP("PSU_"_PSUJOB,"PSUSUMA") ;DAM Trying to make auto run
  1. I $D(^XTMP("PSU_"_PSUJOB,"PSUFLAG2"))!$D(^XTMP("PSU_"_PSUJOB,"PSUFLAG3")) D
  1. .K ^XTMP("PSU_"_PSUJOB,"PSUSUMA")
  1. ;
  1. N PSURX,PSUIV,PSUUD
  1. S PSURX=$G(^XTMP("PSU_"_PSUJOB,"PSUNONE","RX"))
  1. S PSUIV=$G(^XTMP("PSU_"_PSUJOB,"PSUNONE","IV"))
  1. S PSUUD=$G(^XTMP("PSU_"_PSUJOB,"PSUNONE","UD"))
  1. I $G(PSURX)&$G(PSUIV)&$G(PSUUD) D Q
  1. .D NODATA D
  1. ..I $D(^XTMP("PSU_"_PSUJOB,"PSUFLAG1"))!$D(^XTMP("PSU_"_PSUJOB,"PSUFLAG2")) K ^XTMP("PSU_"_PSUJOB,"PSUNONE")
  1. D EN1
  1. Q
  1. ;
  1. EN1 ;Gather summary data for UD/IV/RX report
  1. D PULL^PSUCP
  1. D DATE
  1. S I=7
  1. D UNIQUE
  1. D TOP
  1. D OPDIV
  1. D DIVTOT
  1. D TUDIV
  1. D IPDIV
  1. D IPDIV1
  1. D TAB3
  1. D TAB4
  1. D PDSUM^PSUDEM5 ;Mail message
  1. K ^XTMP("PSU_"_PSUJOB,"PSUTMP")
  1. K ^XTMP("PSU_"_PSUJOB,"PSUTOTAL")
  1. K ^XTMP("PSU_"_PSUJOB,"PSURXUNIQUE")
  1. K ^XTMP("PSU_"_PSUJOB,"PSURXTOTAL")
  1. K ^XTMP("PSU_"_PSUJOB,"PSURXCTA")
  1. K ^XTMP("PSU_"_PSUJOB,"PSURXSSN")
  1. K ^XTMP("PSU_"_PSUJOB,"PSUCOMBO")
  1. K ^XTMP("PSU_"_PSUJOB,"PSUIVSSN")
  1. K ^XTMP("PSU_"_PSUJOB,"PSUUDSSN")
  1. K ^XTMP("PSU_"_PSUJOB,"PSUIVDIV")
  1. K ^XTMP("PSU_"_PSUJOB,"PSUIVOUT")
  1. K ^XTMP("PSU_"_PSUJOB,"PSUUDDIV")
  1. Q
  1. ;
  1. DATE ;EN 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
  1. D DD^%DT
  1. N PSUS S PSUS=Y
  1. ;
  1. S Y=PSUEDT
  1. D DD^%DT
  1. N PSUE S PSUE=Y
  1. ;
  1. D COMSUM
  1. Q
  1. ;
  1. COMSUM ;Summary report header to be run for combination Rx/IV/UD report
  1. ;
  1. ;Report header
  1. S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",1)="PHARMACY 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 total unique pharmacy patients across all divisions
  1. ;
  1. S PSURXN=0,PSUIVN=0,PSUUDN1=0
  1. ;
  1. M ^XTMP("PSU_"_PSUJOB,"PSUTMP")=^XTMP("PSU_"_PSUJOB,"PSURXSSN")
  1. M ^XTMP("PSU_"_PSUJOB,"PSUTMP")=^XTMP("PSU_"_PSUJOB,"PSUIVSSN")
  1. M ^XTMP("PSU_"_PSUJOB,"PSUTMP")=^XTMP("PSU_"_PSUJOB,"PSUUDSSN")
  1. ;
  1. ;
  1. S N=1
  1. S PSUTTL=0
  1. F S PSUTTL=$O(^XTMP("PSU_"_PSUJOB,"PSUTMP",PSUTTL)) Q:PSUTTL="" D
  1. .S ^XTMP("PSU_"_PSUJOB,"PSUTOTAL")=N S N=N+1
  1. D TAB2
  1. S $P(^XTMP("PSU_"_PSUJOB,"PSUSUMA",I),"-",70)="" S I=I+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=(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)
  1. I '$G(^XTMP("PSU_"_PSUJOB,"PSUTOTAL")) D
  1. .S ^XTMP("PSU_"_PSUJOB,"PSUTOTAL")=0
  1. S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=PSUTB4_PSUTB3_$P($G(^XTMP("PSU_"_PSUJOB,"PSUTOTAL")),U,1)
  1. S I=I+1
  1. Q
  1. ;
  1. TOP ;EN Find Total Outpatients
  1. N PSUTB1,PSUTB2
  1. ;
  1. N PSUTOP,PSULBL
  1. S PSUTOP=$G(^XTMP("PSU_"_PSUJOB,"PSURXUNIQUE"))
  1. I '$G(PSUTOP) S PSUTOP=0,PSUTOPF=1
  1. S PSULBL=" Total OUTPATIENT:"
  1. D TAB
  1. S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=PSULBL_PSUTB1_PSUTOP S I=I+1
  1. S $P(^XTMP("PSU_"_PSUJOB,"PSUSUMA",I),"-",70)="" S I=I+1
  1. Q
  1. ;
  1. TAB ;Calculate tab spacing
  1. ;
  1. S PSUTB1=" "
  1. S PSUTB2=(64-$L(PSUTOP))-$L(PSULBL)
  1. F S2=1:1:(PSUTB2-1) S PSUTB(S2)=" " D
  1. .S PSUTB1=PSUTB1_PSUTB(S2)
  1. Q
  1. ;
  1. OPDIV ;EN Find outpatients per division
  1. ;
  1. Q:$G(PSUTOPF)
  1. N PSUTB1,PSUTB2
  1. ;
  1. N PSUTTL
  1. S PSULBL=0
  1. I $D(^XTMP("PSU_"_PSUJOB,"PSURXCTA")) D
  1. .F S PSULBL=$O(^XTMP("PSU_"_PSUJOB,"PSURXCTA",PSULBL)) Q:PSULBL="" D
  1. ..Q:PSULBL=0
  1. ..S PSUTTL=$P($G(^XTMP("PSU_"_PSUJOB,"PSURXCTA",PSULBL)),U,1)
  1. ..D TAB1
  1. ..S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=" "_PSULBL_" Division:"_PSUTB1_PSUTTL
  1. ..S I=I+1
  1. I '$D(^XTMP("PSU_"_PSUJOB,"PSURXCTA")) D
  1. .S PSUTTL=0
  1. .D TAB1
  1. .S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=" "_PSULBL_" Division:"_PSUTB1_PSUTTL
  1. .S I=I+1
  1. S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=" ----------" S I=I+1
  1. Q
  1. ;
  1. TAB1 ;EN Calculate division tab spacing
  1. ;
  1. S PSUTB1=" "
  1. S PSUTB2=(59-$L(PSUTTL))-$L(PSULBL)-10
  1. F S2=1:1:(PSUTB2-1) S PSUTB(S2)=" " D
  1. .S PSUTB1=PSUTB1_PSUTB(S2)
  1. Q
  1. ;
  1. DIVTOT ;EN Calculate tab spacing for 'Outpatient total of all divisions'
  1. ;line and set line into message global
  1. ;
  1. N PSUTB3,PSUTB4,PSUTB5
  1. ;
  1. I '$G(^XTMP("PSU_"_PSUJOB,"PSURXTOTAL")) D
  1. .S ^XTMP("PSU_"_PSUJOB,"PSURXTOTAL")=0
  1. S PSUTB3=" "
  1. S PSUTB4=" Outpatient Total of all Divisions:"
  1. S PSUTB5=(64-$L(PSUTB4))-$L($P($G(^XTMP("PSU_"_PSUJOB,"PSURXTOTAL")),U,1))
  1. F S3=1:1:(PSUTB5-1) S PSUTB3(S3)=" " D
  1. .S PSUTB3=PSUTB3_PSUTB(S3)
  1. S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=PSUTB4_PSUTB3_$P($G(^XTMP("PSU_"_PSUJOB,"PSURXTOTAL")),U,1) S I=I+1
  1. S $P(^XTMP("PSU_"_PSUJOB,"PSUSUMA",I),"-",70)="" S I=I+1
  1. Q
  1. ;
  1. TUDIV ;Calculate tab spacing for 'Total INPATIENT' line and
  1. ;set line into message global
  1. ;
  1. N PSUTB3,PSUTB4,PSUTB5
  1. ;
  1. ;Create global with total number of unique UD + IV inpatients
  1. ;using patient SSN to ID unique patient
  1. M ^XTMP("PSU_"_PSUJOB,"PSUUDIVT")=^XTMP("PSU_"_PSUJOB,"PSUDIV1")
  1. M ^XTMP("PSU_"_PSUJOB,"PSUUDIVT")=^XTMP("PSU_"_PSUJOB,"PSUDIVUD")
  1. ;
  1. ;Loop through division global and create global with unique SSN
  1. S G=1
  1. S PSUD2=0
  1. F S PSUD2=$O(^XTMP("PSU_"_PSUJOB,"PSUUDIVT",PSUD2)) Q:PSUD2="" D
  1. .S PSUD8=0
  1. .F S PSUD8=$O(^XTMP("PSU_"_PSUJOB,"PSUUDIVT",PSUD2,PSUD8)) Q:PSUD8="" D
  1. ..S ^XTMP("PSU_"_PSUJOB,"PSUUDIVT1",PSUD8)="" ;Unique SSN's
  1. ;
  1. ;Find number of unique SSN's. This is number of unique patients
  1. S PSUD9=0
  1. F S PSUD9=$O(^XTMP("PSU_"_PSUJOB,"PSUUDIVT1",PSUD9)) Q:PSUD9="" D
  1. .S ^XTMP("PSU_"_PSUJOB,"PSUUDIVTOT")=G,G=G+1
  1. ;
  1. ;Calculate tab spacing
  1. S PSUTB3=" "
  1. S PSUTB4=" Total INPATIENT:"
  1. S PSUTB5=(64-$L(PSUTB4))-$L($P($G(^XTMP("PSU_"_PSUJOB,"PSUUDIVTOT")),U,1))
  1. F S3=1:1:(PSUTB5-1) S PSUTB(S3)=" " D
  1. .S PSUTB3=PSUTB3_PSUTB(S3) ;Tab position
  1. ;
  1. ;Set line into message global
  1. S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=PSUTB4_PSUTB3_$P($G(^XTMP("PSU_"_PSUJOB,"PSUUDIVTOT")),U,1) S I=I+1
  1. S $P(^XTMP("PSU_"_PSUJOB,"PSUSUMA",I),"-",70)="" S I=I+1
  1. Q
  1. ;
  1. IPDIV ;EN Find inpatients by division (includes UD patients and IV
  1. ;patients with ward location NOT set to 0.5
  1. ;
  1. ;If no Unit Dose data exists, do the following to get IV data:
  1. I $D(^XTMP("PSU_"_PSUJOB,"PSUNONE","UD")) D Q
  1. .M ^XTMP("PSU_"_PSUJOB,"PSUINPT")=^XTMP("PSU_"_PSUJOB,"PSUDIV1")
  1. ;
  1. ;If no IV data exists, do the following to get UD data:
  1. I $D(^XTMP("PSU_"_PSUJOB,"PSUNONE","IV")) D Q
  1. .M ^XTMP("PSU_"_PSUJOB,"PSUINPT")=^XTMP("PSU_"_PSUJOB,"PSUDIVUD")
  1. ;
  1. ;Construct a storage global containing unique inpatients
  1. ;per division when there is both UD and IV data
  1. S PSUDV1=0
  1. F S PSUDV1=$O(^XTMP("PSU_"_PSUJOB,"PSUDIV1",PSUDV1)) Q:PSUDV1="" D
  1. .S PSUDVUD=0
  1. .F S PSUDVUD=$O(^XTMP("PSU_"_PSUJOB,"PSUDIVUD",PSUDVUD)) Q:PSUDVUD="" D
  1. ..I PSUDVUD=PSUDV1 D
  1. ...S PSUPT=0
  1. ...F S PSUPT=$O(^XTMP("PSU_"_PSUJOB,"PSUDIV1",PSUDV1,PSUPT)) Q:PSUPT="" D
  1. ....S ^XTMP("PSU_"_PSUJOB,"PSUINPT",PSUDV1,PSUPT)=""
  1. ....S PSUPT1=0
  1. ....F S PSUPT1=$O(^XTMP("PSU_"_PSUJOB,"PSUDIVUD",PSUDVUD,PSUPT1)) Q:PSUPT1="" D
  1. .....S ^XTMP("PSU_"_PSUJOB,"PSUINPT",PSUDVUD,PSUPT1)=""
  1. ..I PSUDVUD'=PSUDV1 D
  1. ...M ^XTMP("PSU_"_PSUJOB,"PSUINPT")=^XTMP("PSU_"_PSUJOB,"PSUDIVUD")
  1. Q
  1. ;
  1. IPDIV1 ;Calculate inpatient totals
  1. ;
  1. S PSUSIT=0,PSUSIT1=0,T=1
  1. ;
  1. F S PSUSIT=$O(^XTMP("PSU_"_PSUJOB,"PSUINPT",PSUSIT)) Q:PSUSIT="" D
  1. .F S PSUSIT1=$O(^XTMP("PSU_"_PSUJOB,"PSUINPT",PSUSIT,PSUSIT1)) Q:PSUSIT1="" D
  1. ..I $D(^XTMP("PSU_"_PSUJOB,"PSUCOMBO",PSUSIT)) D
  1. ...S C=C+1
  1. ...S ^XTMP("PSU_"_PSUJOB,"PSUCOMBO",PSUSIT)=C
  1. ..I '$D(^XTMP("PSU_"_PSUJOB,"PSUCOMBO",PSUSIT)) D
  1. ...S C=1
  1. ...S ^XTMP("PSU_"_PSUJOB,"PSUCOMBO",PSUSIT)=C
  1. Q
  1. ;
  1. TAB3 ;Place inpatient division totals into summary message
  1. ;
  1. N PSUTB1,PSUTB2
  1. ;
  1. N PSUTTL
  1. S PSULBL=0
  1. F S PSULBL=$O(^XTMP("PSU_"_PSUJOB,"PSUCOMBO",PSULBL)) Q:PSULBL="" D
  1. .S PSUTTL=$P($G(^XTMP("PSU_"_PSUJOB,"PSUCOMBO",PSULBL)),U,1)
  1. .I '$G(PSUTTL) S PSUTTL=0
  1. .D TAB1
  1. .S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=" "_PSULBL_" Division:"_PSUTB1_PSUTTL
  1. .S I=I+1
  1. Q
  1. ;
  1. TAB4 ;Calculate inpatient totals of all divisions and place in summary
  1. ;message
  1. ;
  1. S N=0,PSUMKER=0
  1. F S PSUMKER=$O(^XTMP("PSU_"_PSUJOB,"PSUCOMBO",PSUMKER)) Q:PSUMKER="" D
  1. .S N=$P(^XTMP("PSU_"_PSUJOB,"PSUCOMBO",PSUMKER),U)+N
  1. S ^XTMP("PSU_"_PSUJOB,"PSUTOTAL")=N ;Sum of all inpatients
  1. ;
  1. D TAB1^PSUSUM3
  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 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