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

PSUSUM4.m

Go to the documentation of this file. 
  1. PSUSUM4 ;BIR/DAM - Patient Demographics Summary for IV 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 2440
  1.  ;
  1. EN ;EN CALLED FROM PSUIV0
  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,"PSUFLAG2"))!$D(^XTMP("PSU_"_PSUJOB,"PSUFLAG3")) K ^XTMP("PSU_"_PSUJOB,"PSUSUMA")
  1.  I $D(^XTMP("PSU_"_PSUJOB,"PSUNONE","IV")) D  Q    ;Summary report if there is no data
  1.  .I '$D(PSUMOD(2))&$D(PSUMOD(1)) D
  1.  ..I '$D(PSUMOD(4)) D
  1.  ...D NODATA
  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 ;Entry point to collect data
  1.  ;
  1.  D DATE
  1.  M ^XTMP("PSU_"_PSUJOB,"PSUIV")=^XTMP(PSUIVSUB)
  1.  S I=7             ;Line counter for message
  1.  D UNIQUE
  1.  N PSUTB2,PSUTB3,PSUTB4,PSUTB5
  1.  D TAB
  1.  D TOTUN
  1.  S I=10            ;Reset line counter for message
  1.  D PATNUM
  1.  D TAB1
  1.  ;
  1.  I $D(PSUMOD(2))&$D(PSUMOD(1)) D
  1.  .I $D(PSUMOD(4)) D
  1.  ..M ^XTMP("PSU_"_PSUJOB,"PSUIVINDIV")=^XTMP("PSU_"_PSUJOB,"PSUCT")
  1.  ..M ^XTMP("PSU_"_PSUJOB,"PSUIVIN")=^XTMP("PSU_"_PSUJOB,"PSUINP")
  1.  ..M ^XTMP("PSU_"_PSUJOB,"PSUIVOUT")=^XTMP("PSU_"_PSUJOB,"PSUOUTP")
  1.  ..M ^XTMP("PSU_"_PSUJOB,"PSUIVSSN")=^XTMP("PSU_"_PSUJOB,"PSUIV","PAT")
  1.  ..M ^XTMP("PSU_"_PSUJOB,"PSUDIV1")=^XTMP("PSU_"_PSUJOB,"PSUDIV")
  1.  ;
  1.  I '$D(PSUMOD(2))&$D(PSUMOD(1)) D
  1.  .I $D(PSUMOD(4)) D
  1.  ..M ^XTMP("PSU_"_PSUJOB,"PSUIVINDIV")=^XTMP("PSU_"_PSUJOB,"PSUCT")
  1.  ..M ^XTMP("PSU_"_PSUJOB,"PSUIVIN")=^XTMP("PSU_"_PSUJOB,"PSUINP")
  1.  ..M ^XTMP("PSU_"_PSUJOB,"PSUIVOUT")=^XTMP("PSU_"_PSUJOB,"PSUOUTP")
  1.  ..M ^XTMP("PSU_"_PSUJOB,"PSUIVSSN")=^XTMP("PSU_"_PSUJOB,"PSUIV","PAT")
  1.  ..M ^XTMP("PSU_"_PSUJOB,"PSUIN1")=^XTMP("PSU_"_PSUJOB,"PSUIN")
  1.  ..M ^XTMP("PSU_"_PSUJOB,"PSUDIV1")=^XTMP("PSU_"_PSUJOB,"PSUDIV")
  1.  ;
  1.  I $D(PSUMOD(2))&$D(PSUMOD(1)) D
  1.  .I '$D(PSUMOD(4)) D
  1.  ..M ^XTMP("PSU_"_PSUJOB,"PSUIVINDIV")=^XTMP("PSU_"_PSUJOB,"PSUCT")
  1.  ..M ^XTMP("PSU_"_PSUJOB,"PSUIVIN")=^XTMP("PSU_"_PSUJOB,"PSUINP")
  1.  ..M ^XTMP("PSU_"_PSUJOB,"PSUIVOUT")=^XTMP("PSU_"_PSUJOB,"PSUOUTP")
  1.  ..M ^XTMP("PSU_"_PSUJOB,"PSUDIV1")=^XTMP("PSU_"_PSUJOB,"PSUDIV")
  1.  ;
  1.  I '$D(PSUMOD(2))&'$D(PSUMOD(4)) D
  1.  .I '$G(^XTMP("PSU_"_PSUJOB,"PSUFLAG1")) D
  1.  ..D PDSUM^PSUDEM5     ;Mail message
  1.  ..K ^XTMP("PSU_"_PSUJOB,"PSUIVOUT")
  1.  ..K ^XTMP("PSU_"_PSUJOB,"PSUIVINDIV")
  1.  K ^XTMP("PSU_"_PSUJOB,"PSUIV")
  1.  ;K ^XTMP("PSU_"_PSUJOB,"PSUIVSSN")
  1.  K ^XTMP("PSU_"_PSUJOB,"PSUINP")
  1.  ;K ^XTMP("PSU_"_PSUJOB,"PSUIN")
  1.  ;K ^XTMP("PSU_"_PSUJOB,"PSUOUT")
  1.  I $D(^XTMP("PSU_"_PSUJOB,"PSUFLAG1")) K ^XTMP("PSU_"_PSUJOB,"PSUSUMA")
  1.  I $D(^XTMP("PSU_"_PSUJOB,"PSUMFLAG"))
  1.  K ^XTMP("PSU_"_PSUJOB,"PSUFLAG1")
  1.  K ^XTMP("PSU_"_PSUJOB,"PSUOUTP")
  1.  K ^XTMP("PSU_"_PSUJOB,"PSUINP")
  1.  ;K ^XTMP("PSU_"_PSUJOB,"PSUDIV")
  1.  K ^XTMP("PSU_"_PSUJOB,"PSUCT")
  1.  ;K ^XTMP("PSU_"_PSUJOB,"PSUTOTAL")
  1.  K ^XTMP("PSU_"_PSUJOB,"PSURXCTA")
  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
  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 IVSUM
  1.  Q
  1.  ;
  1. IVSUM ;Summary report header to be run if IV  extract is  run
  1.  ;
  1.  ;Report header
  1.  S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",1)="PHARMACY INPATIENT (IV) 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.  N PSUSIT
  1.  S PSUSIT=PSUSNDR
  1.  ;
  1.  N PSUWD,PSUSN
  1.  S PSUOPCT=1
  1.  S PSUIPCT=1
  1.  S PSUNUM=0,PSUSIT1=0
  1.  F  S PSUSIT1=$O(^XTMP("PSU_"_PSUJOB,"PSUIV","RECORDS",PSUSIT1)) Q:PSUSIT1=""  D
  1.  .F  S PSUNUM=$O(^XTMP("PSU_"_PSUJOB,"PSUIV","RECORDS",PSUSIT1,PSUNUM)) Q:PSUNUM=""  D
  1.  ..S PSUWD=$P($G(^XTMP("PSU_"_PSUJOB,"PSUIV","RECORDS",PSUSIT1,PSUNUM)),U,7)
  1.  ..S PSUSN=$P($G(^XTMP("PSU_"_PSUJOB,"PSUIV","RECORDS",PSUSIT1,PSUNUM)),U,8)
  1.  ..I PSUWD'="" D
  1.  ...I PSUWD="Y" S ^XTMP("PSU_"_PSUJOB,"PSUOUT",PSUSN)=""
  1.  ...I PSUWD="N" S ^XTMP("PSU_"_PSUJOB,"PSUIN",PSUSN)=""
  1.  D WARD
  1.  Q
  1.  ;
  1. WARD ;Find unique number of patients that are OP and IP
  1.  ;
  1.  ;Find unique number of outpatients
  1.  S PSUD1A=0
  1.  F  S PSUD1A=$O(^XTMP("PSU_"_PSUJOB,"PSUOUT",PSUD1A)) Q:PSUD1A=""  D
  1.  .S ^XTMP("PSU_"_PSUJOB,"PSUOUTP")=PSUOPCT S PSUOPCT=PSUOPCT+1
  1.  ;
  1.  ;Find unique number in inpatients
  1.  S PSUD1B=0
  1.  F  S PSUD1B=$O(^XTMP("PSU_"_PSUJOB,"PSUIN",PSUD1B)) Q:PSUD1B=""  D
  1.  .S ^XTMP("PSU_"_PSUJOB,"PSUINP")=PSUIPCT S PSUIPCT=PSUIPCT+1
  1.  Q
  1.  ;
  1. TAB ;Calculate tab spacing
  1.  ;
  1.  I '$D(^XTMP("PSU_"_PSUJOB,"PSUINP")) S ^XTMP("PSU_"_PSUJOB,"PSUINP")=0
  1.  I '$D(^XTMP("PSU_"_PSUJOB,"PSUOUTP")) S ^XTMP("PSU_"_PSUJOB,"PSUOUTP")=0
  1.  ;
  1.  S PSUTB1=" "
  1.  S PSUTB2="Total unique Inpatients across all divisions:"
  1.  S PSUTB3=(64-$L(^XTMP("PSU_"_PSUJOB,"PSUINP")))-$L(PSUTB2)
  1.  F S2=1:1:(PSUTB3-1) S PSUTB(S2)=" " D
  1.  .S PSUTB1=PSUTB1_PSUTB(S2)
  1.  ;
  1.  S PSUTB6=" "
  1.  S PSUTB4="Total unique Outpatients across all divisions:"
  1.  S PSUTB5=(64-$L(^XTMP("PSU_"_PSUJOB,"PSUOUTP")))-$L(PSUTB4)
  1.  F S3=1:1:(PSUTB5-1) S PSUTB(S3)=" " D
  1.  .S PSUTB6=PSUTB6_PSUTB(S3)
  1.  Q
  1.  ;
  1. TOTUN ;Set total number of unique in-patients and out-patients into
  1.  ;summary message
  1.  ; 
  1.  S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=PSUTB2_PSUTB1_^XTMP("PSU_"_PSUJOB,"PSUINP") S I=I+1
  1.  S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=PSUTB4_PSUTB6_^XTMP("PSU_"_PSUJOB,"PSUOUTP") S I=I+1
  1.  S $P(^XTMP("PSU_"_PSUJOB,"PSUSUMA",I),"-",70)=""
  1.  Q
  1.  ;
  1. PATNUM ;Place division names and patient totals into summary message
  1.  ;
  1.  N PSUTB1,PSUTB2
  1.  N PSUCT3
  1.  S PSUTOTAL=0
  1.  S PSUDIVNM=0
  1.  F  S PSUDIVNM=$O(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUDIVNM)) Q:PSUDIVNM=""  D
  1.  .S PSUCT3=$P($G(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUDIVNM)),U,1)
  1.  .S PSUTOTAL=PSUTOTAL+PSUCT3
  1.  .D SPACE
  1.  .S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)="     "_PSUDIVNM_" Division:"_PSUTB1_PSUCT3
  1.  .S I=I+1
  1.  S ^XTMP("PSU_"_PSUJOB,"PSUTOTAL")=PSUTOTAL   ;Total of all divisions
  1.  Q
  1.  ;
  1. SPACE ;S ^XTMP("PSU_"_PSUJOB,"PSUTOTAL")=PSUTOTAL   ;Total of all divisions
  1.  ;
  1.  S PSUTB1=" "
  1.  S PSUTB2=(59-$L(PSUCT3))-$L(PSUDIVNM)-10
  1.  F S2=1:1:(PSUTB2-1) S PSUTB(S2)=" " D
  1.  .S PSUTB1=PSUTB1_PSUTB(S2)                  ;Tab position
  1.  Q
  1.  ;
  1. TAB1 ;EN  Calculate tab spacing for '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="     Total of all Divisions:          "
  1.  S PSUTB5=(64-$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)="                                                         ------------" S I=I+1
  1.  S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=PSUTB4_PSUTB3_$P(^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)="* This report includes Outpatients receiving IV orders." 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 (IV) 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