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

PSUSUM7.m

Go to the documentation of this file.
  1. PSUSUM7 ;BIR/DAM - Pt. Demographics Summary for IV/RX or UD/RX ; 20 DEC 2001
  1. ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
  1. ;
  1. EN ;EN CALLED FROM PSUOP0
  1. ;Q:$D(^XTMP("PSU_"_PSUJOB,"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. K ^XTMP("PSU_"_PSUJOB,"PSUSUMA")
  1. I $G(^XTMP("PSU_"_PSUJOB,"PSUFLAG2"))!$G(^XTMP("PSU_"_PSUJOB,"PSUFLAG3")) K ^XTMP("PSU_"_PSUJOB,"PSUSUMA")
  1. I $D(^XTMP("PSU_"_PSUJOB,"PSUNONE","RX")) D Q
  1. .I $D(^XTMP("PSU_"_PSUJOB,"PSUNONE","IV"))!$D(^XTMP("PSU_"_PSUJOB,"PSUNONE","UD")) D
  1. ..D NODATA
  1. ..I $G(^XTMP("PSU_"_PSUJOB,"PSUFLAG1"))!$G(^XTMP("PSU_"_PSUJOB,"PSUFLAG2")) K ^XTMP("PSU_"_PSUJOB,"PSUNONE")
  1. ;
  1. D EN1
  1. Q
  1. ;
  1. EN1 ;Gather summary data
  1. D DATE^PSUSUM6
  1. S I=7
  1. I $D(PSUMOD(1)) D UNIQUE1
  1. I '$D(PSUMOD(1)) D UNIQUE
  1. D TOP^PSUSUM6
  1. D OPDIV^PSUSUM6
  1. D DIVTOT^PSUSUM6
  1. D TUDIV
  1. I $D(PSUMOD(1)) D
  1. .D IPDIV2
  1. I $D(PSUMOD(2)) D
  1. .D IPDIV^PSUSUM6
  1. .D IPDIV1
  1. .D TAB4
  1. D PDSUM^PSUDEM5
  1. K ^XTMP("PSU_"_PSUJOB,"PSUTMP"),^XTMP("PSU_"_PSUJOB,"PSUTOTAL"),^XTMP("PSU_"_PSUJOB,"PSURXUNIQUE")
  1. K ^XTMP("PSU_"_PSUJOB,"PSURXTOTAL")
  1. K ^XTMP("PSU_"_PSUJOB,"PSURXCTA"),^XTMP("PSU_"_PSUJOB,"PSUIVINDIV")
  1. K ^XTMP("PSU_"_PSUJOB,"PSURXSSN"),^XTMP("PSU_"_PSUJOB,"PSUIVDIV"),^XTMP("PSU_"_PSUJOB,"PSUFLAG2")
  1. K ^XTMP("PSU_"_PSUJOB,"PSUFLAG3")
  1. K ^XTMP("PSU_"_PSUJOB,"PSUIVOUT"),^XTMP("PSU_"_PSUJOB,"PSUIVSSN"),^XTMP("PSU_"_PSUJOB,"PSUUDDIV")
  1. Q
  1. ;
  1. UNIQUE ;Find total unique pharmacy patients across all divisions when
  1. ;UD and RX extracts are run together
  1. ;
  1. S PSURXN=0,PSUUDN1=0,PSUUDN2=0
  1. ;
  1. S N=1
  1. F S PSURXN=$O(^XTMP("PSU_"_PSUJOB,"PSURXSSN",PSURXN)) Q:PSURXN="" D
  1. .S ^XTMP("PSU_"_PSUJOB,"PSUTMP",PSURXN)=N S N=N+1
  1. .F S PSUUDN1=$O(^XTMP("PSU_"_PSUJOB,"PSUUDSSN",PSUUDN1)) Q:PSUUDN1="" D
  1. ..I '$D(^XTMP("PSU_"_PSUJOB,"PSUTMP",PSUUDN1)) S ^XTMP("PSU_"_PSUJOB,"PSUTMP",PSUUDN1)=N S N=N+1
  1. ;
  1. S ^XTMP("PSU_"_PSUJOB,"PSUTOTAL")=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. 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. 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. UNIQUE1 ;Find total unique pharmacy patients across all divisions when
  1. ;IV and RX extracts are run together
  1. ;
  1. S PSURXN=0,PSUIVN=0
  1. ;
  1. S N=1
  1. ;
  1. F S PSURXN=$O(^XTMP("PSU_"_PSUJOB,"PSURXSSN",PSURXN)) Q:PSURXN="" D
  1. .S ^XTMP("PSU_"_PSUJOB,"PSUTMP",PSURXN)=N S N=N+1
  1. .F S PSUIVN=$O(^XTMP("PSU_"_PSUJOB,"PSUIVSSN",PSUIVN)) Q:PSUIVN="" D
  1. ..I '$D(^XTMP("PSU_"_PSUJOB,"PSUTMP",PSUIVN)) S ^XTMP("PSU_"_PSUJOB,"PSUTMP",PSUIVN)=N S N=N+1
  1. ;
  1. S ^XTMP("PSU_"_PSUJOB,"PSUTOTAL")=N-1
  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
  1. S $P(^XTMP("PSU_"_PSUJOB,"PSUSUMA",I),"-",70)="" S I=I+1
  1. Q
  1. ;
  1. TUDIV ;Calculate total inpatient count and tab spacing for 'Total
  1. ;INPATIENT (UD or IV)' line and set into message global
  1. ;
  1. N PSUTB3,PSUTB4,PSUTB5,PSUDT
  1. ;
  1. I '$D(PSUMOD(1)) D
  1. .S PSUDT=$P($G(^XTMP("PSU_"_PSUJOB,"PSUUDSSN")),U) D
  1. ..S ^XTMP("PSU_"_PSUJOB,"PSUUDIVTOT")=PSUDT ;Total UD inpatient count
  1. ;
  1. I '$D(PSUMOD(2)) D
  1. .S ^XTMP("PSU_"_PSUJOB,"PSUUDIVTOT")=$P($G(^XTMP("PSU_"_PSUJOB,"PSUIVIN")),U,1)-1 ;Total IV inpatient count
  1. ;
  1. I '$G(^XTMP("PSU_"_PSUJOB,"PSUUDIVTOT")) S ^XTMP("PSU_"_PSUJOB,"PSUUDIVTOT")=0
  1. S PSUTB3=" "
  1. S PSUTB4=" Total INPATIENT (UD or IV):"
  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. 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. IPDIV1 ;Find UD inpatient division totals
  1. ;
  1. S PSULBL=0
  1. N PSUTTL
  1. ;
  1. I $D(PSUMOD(2)) D ;UD inpatients
  1. .F S PSULBL=$O(^XTMP("PSU_"_PSUJOB,"PSUUDDIV",PSULBL)) Q:PSULBL="" D
  1. ..S PSUTTL=$P($G(^XTMP("PSU_"_PSUJOB,"PSUUDDIV",PSULBL)),U,1)
  1. ..D TAB1^PSUSUM6
  1. ..D IPMSG
  1. Q
  1. ;
  1. IPMSG ;Set UD inpatient division totals into message global
  1. ;
  1. S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=" "_PSULBL_" Division:"_PSUTB1_PSUTTL
  1. S I=I+1
  1. Q
  1. ;
  1. IPDIV2 ;Calculate inpatient totals for IV divisions
  1. ;
  1. ;
  1. ;Construct a storage global containing unique IV inpatients
  1. ;per division
  1. S PSUDV=0
  1. F S PSUDV=$O(^XTMP("PSU_"_PSUJOB,"PSUDIV1",PSUDV)) Q:PSUDV="" D
  1. .S PSUPT=0
  1. .F S PSUPT=$O(^XTMP("PSU_"_PSUJOB,"PSUDIV1",PSUDV,PSUPT)) Q:PSUPT="" D
  1. ..S PSUPT1=0
  1. ..F S PSUPT1=$O(^XTMP("PSU_"_PSUJOB,"PSUIN1",PSUPT1)) Q:PSUPT1="" D
  1. ...I PSUPT1=PSUPT S ^XTMP("PSU_"_PSUJOB,"PSUDIV",PSUDV,PSUPT1)=""
  1. D IPDIV3
  1. Q
  1. ;
  1. IPDIV3 ;Find unique inpatient count for each division
  1. S PSUCT1=0,PSUCT2=0,T=1
  1. ;
  1. F S PSUCT1=$O(^XTMP("PSU_"_PSUJOB,"PSUDIV",PSUCT1)) Q:PSUCT1="" D
  1. .F S PSUCT2=$O(^XTMP("PSU_"_PSUJOB,"PSUDIV",PSUCT1,PSUCT2)) Q:PSUCT2="" D
  1. ..S ^XTMP("PSU_"_PSUJOB,"PSUTOTAL1")=T S T=T+1 ;Total count
  1. ..I $D(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUCT1)) D
  1. ...S C=C+1
  1. ...S ^XTMP("PSU_"_PSUJOB,"PSUCT",PSUCT1)=C
  1. ..I '$D(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUCT1)) D
  1. ...S C=1
  1. ...S ^XTMP("PSU_"_PSUJOB,"PSUCT",PSUCT1)=C
  1. D DIVNUM
  1. D MSG
  1. Q
  1. ;
  1. DIVNUM ;Set number of inpatients per division into summary message
  1. ;
  1. N PSUTB1,PSUTB2
  1. S N=1
  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($G(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUDIVA1)),U,1)
  1. .D TAB5
  1. .S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=" "_PSUDIVA1_" Division:"_PSUTB1_PSUCT2
  1. .S I=I+1
  1. Q
  1. ;
  1. TAB5 ;Calculate tab spacing
  1. ;
  1. S PSUTB1=" "
  1. S PSUTB2=(59-$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. TAB4 ;Calculate UD totals of all divisions and place in summary
  1. ;message
  1. ;
  1. S N=0,PSUMKER=0,R=1
  1. ;
  1. I $D(PSUMOD(2)) D
  1. .F S PSUMKER=$O(^XTMP("PSU_"_PSUJOB,"PSUUDDIV",PSUMKER)) Q:PSUMKER="" D
  1. ..S N=$P(^XTMP("PSU_"_PSUJOB,"PSUUDDIV",PSUMKER),U)+N
  1. ..S ^XTMP("PSU_"_PSUJOB,"PSUTOTAL1")=N ;Sum of all UD inpatients
  1. ;
  1. D MSG
  1. Q
  1. ;
  1. MSG ;Final lines of message
  1. ;
  1. I '$D(^XTMP("PSU_"_PSUJOB,"PSUTOTAL1")) S ^XTMP("PSU_"_PSUJOB,"PSUTOTAL1")=0
  1. ;
  1. N PSUTB3,PSUTB4,PSUTB5
  1. ;
  1. S PSUTB3=" "
  1. S PSUTB4=" Inpatient Total of all Divisions:"
  1. S PSUTB5=(64-$L(PSUTB4))-$L($P($G(^XTMP("PSU_"_PSUJOB,"PSUTOTAL1")),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,"PSUTOTAL1")),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 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