[613] | 1 | PSUSUM5 ;BIR/DAM - Patient Demographics Summary for IV/UD ; 20 DEC 2001
|
---|
| 2 | ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
|
---|
| 3 | ;
|
---|
| 4 | EN ;EN CALLED FROM PSUUD0
|
---|
| 5 | ;
|
---|
| 6 | I $D(^XTMP("PSU_"_PSUJOB,"PSUFLAG2"))!$D(^XTMP("PSU_"_PSUJOB,"PSUFLAG3")) K ^XTMP("PSU_"_PSUJOB,"PSUSUMA")
|
---|
| 7 | I $D(^XTMP("PSU_"_PSUJOB,"PSUNONE","IV"))&$D(^XTMP("PSU_"_PSUJOB,"PSUNONE","UD")) D Q ;Summary report if there is no data
|
---|
| 8 | .D NODATA
|
---|
| 9 | .I $D(^XTMP("PSU_"_PSUJOB,"PSUFLAG1"))!$D(^XTMP("PSU_"_PSUJOB,"PSUFLAG2")) K ^XTMP("PSU_"_PSUJOB,"PSUNONE")
|
---|
| 10 | ;
|
---|
| 11 | D DATE
|
---|
| 12 | S I=7 ;Line Counter
|
---|
| 13 | D UNIQUE
|
---|
| 14 | D DIV
|
---|
| 15 | D TOTAL
|
---|
| 16 | D TAB1^PSUSUM4
|
---|
| 17 | D PDSUM^PSUDEM5 ;Mail message
|
---|
| 18 | K ^XTMP("PSU_"_PSUJOB,"PSUIVOUT")
|
---|
| 19 | K ^XTMP("PSU_"_PSUJOB,"PSUUDIN")
|
---|
| 20 | I $D(^XTMP("PSU_"_PSUJOB,"PSUFLAG2")) K ^XTMP("PSU_"_PSUJOB,"PSUSUMA")
|
---|
| 21 | K ^XTMP("PSU_"_PSUJOB,"PSUFIN")
|
---|
| 22 | K ^XTMP("PSU_"_PSUJOB,"PSUIVSSN")
|
---|
| 23 | K ^XTMP("PSU_"_PSUJOB,"PSUIVDIV")
|
---|
| 24 | K ^XTMP("PSU_"_PSUJOB,"PSUNEW")
|
---|
| 25 | K ^XTMP("PSU_"_PSUJOB,"PSUTOTAL")
|
---|
| 26 | K ^XTMP("PSU_"_PSUJOB,"PSUFLAG2")
|
---|
| 27 | K ^XTMP("PSU_"_PSUJOB,"PSUFLAG3")
|
---|
| 28 | K ^XTMP("PSU_"_PSUJOB,"PSUUDDIV")
|
---|
| 29 | ;
|
---|
| 30 | K ^XTMP("PSU_"_PSUJOB,"PSURXCTA")
|
---|
| 31 | Q
|
---|
| 32 | ;
|
---|
| 33 | DATE ;Convert date range of extract to external format
|
---|
| 34 | ;
|
---|
| 35 | D PULL^PSUCP
|
---|
| 36 | S %H=$E($H,1,5) ;today's date
|
---|
| 37 | D YX^%DTC
|
---|
| 38 | N PSUD S PSUD=Y
|
---|
| 39 | ;
|
---|
| 40 | S Y=PSUSDT
|
---|
| 41 | D DD^%DT
|
---|
| 42 | N PSUS S PSUS=Y
|
---|
| 43 | ;
|
---|
| 44 | S Y=PSUEDT
|
---|
| 45 | D DD^%DT
|
---|
| 46 | N PSUE S PSUE=Y
|
---|
| 47 | ;
|
---|
| 48 | D IVUDSUM
|
---|
| 49 | Q
|
---|
| 50 | ;
|
---|
| 51 | IVUDSUM ;Summary report header
|
---|
| 52 | ;
|
---|
| 53 | S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",1)="PHARMACY INPATIENT (UD & IV) UNIQUE PATIENTS REPORT "_PSUD
|
---|
| 54 | S $P(^XTMP("PSU_"_PSUJOB,"PSUSUMA",2),"-",80)="" ;Separator bar
|
---|
| 55 | S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",3)=" "_PSUS_" through "_PSUE
|
---|
| 56 | S $P(^XTMP("PSU_"_PSUJOB,"PSUSUMA",4),"=",80)=""
|
---|
| 57 | S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",5)=" UNIQUE"
|
---|
| 58 | S $P(^XTMP("PSU_"_PSUJOB,"PSUSUMA",6),"-",70)=""
|
---|
| 59 | Q
|
---|
| 60 | ;
|
---|
| 61 | UNIQUE ;Find Total unique patient number across all divisions
|
---|
| 62 | ;
|
---|
| 63 | N PSUSIT
|
---|
| 64 | S PSUSIT=PSUSNDR
|
---|
| 65 | ;
|
---|
| 66 | N PSUIPSUM,PSUOPSUM
|
---|
| 67 | I '$D(^XTMP("PSU_"_PSUJOB,"PSUIVIN")) S $P(^XTMP("PSU_"_PSUJOB,"PSUIVIN"),U,1)=0
|
---|
| 68 | I '$D(^XTMP("PSU_"_PSUJOB,"PSUUDIN")) S $P(^XTMP("PSU_"_PSUJOB,"PSUUDIN"),U,1)=0
|
---|
| 69 | I '$D(^XTMP("PSU_"_PSUJOB,"PSUIVOUT")) S $P(^XTMP("PSU_"_PSUJOB,"PSUIVOUT"),U,1)=0
|
---|
| 70 | ;
|
---|
| 71 | ;Create IP unique global. Screen out duplicates
|
---|
| 72 | M ^XTMP("PSU_"_PSUJOB,"PSUIPSUM")=^XTMP("PSU_"_PSUJOB,"PSUUDIN")
|
---|
| 73 | M ^XTMP("PSU_"_PSUJOB,"PSUIPSUM")=^XTMP("PSU_"_PSUJOB,"PSUIN")
|
---|
| 74 | ;
|
---|
| 75 | S N=1
|
---|
| 76 | S PSUSUM=0
|
---|
| 77 | F S PSUSUM=$O(^XTMP("PSU_"_PSUJOB,"PSUIPSUM",PSUSUM)) Q:PSUSUM="" D
|
---|
| 78 | .S PSUIPSUM=N S N=N+1
|
---|
| 79 | ;
|
---|
| 80 | S PSUOPSUM=$P($G(^XTMP("PSU_"_PSUJOB,"PSUIVOUT")),U,1)
|
---|
| 81 | D TAB
|
---|
| 82 | Q
|
---|
| 83 | ;
|
---|
| 84 | TAB ;Calculate tab spacing
|
---|
| 85 | ;
|
---|
| 86 | N PSUTB2,PSUTB3,PSUTB4,PSUTB5
|
---|
| 87 | ;
|
---|
| 88 | S PSUTB1=" "
|
---|
| 89 | S PSUTB2="Total Inpatients across all divisions:"
|
---|
| 90 | S PSUTB3=(64-$L(PSUIPSUM))-$L(PSUTB2)
|
---|
| 91 | F S2=1:1:(PSUTB3-1) S PSUTB(S2)=" " D
|
---|
| 92 | .S PSUTB1=PSUTB1_PSUTB(S2)
|
---|
| 93 | ;
|
---|
| 94 | S PSUTB6=" "
|
---|
| 95 | S PSUTB4="Total Outpatients across all divisions:"
|
---|
| 96 | S PSUTB5=(64-$L(PSUOPSUM))-$L(PSUTB4)
|
---|
| 97 | F S3=1:1:(PSUTB5-1) S PSUTB(S3)=" " D
|
---|
| 98 | .S PSUTB6=PSUTB6_PSUTB(S3)
|
---|
| 99 | D TOT
|
---|
| 100 | Q
|
---|
| 101 | ;
|
---|
| 102 | TOT ;Set total number of unique in-patients and out-patients into
|
---|
| 103 | ;summary message
|
---|
| 104 | ;
|
---|
| 105 | S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=PSUTB2_PSUTB1_(PSUIPSUM) S I=I+1
|
---|
| 106 | S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=PSUTB4_PSUTB6_(PSUOPSUM) S I=I+1
|
---|
| 107 | S $P(^XTMP("PSU_"_PSUJOB,"PSUSUMA",I),"-",70)="" S I=I+1
|
---|
| 108 | Q
|
---|
| 109 | ;
|
---|
| 110 | DIV ;Set all divisions from both IV and UD extracts into one global
|
---|
| 111 | ;
|
---|
| 112 | M ^XTMP("PSU_"_PSUJOB,"PSUFIN")=^XTMP("PSU_"_PSUJOB,"PSUDIV1") ;IP division name/SSN
|
---|
| 113 | M ^XTMP("PSU_"_PSUJOB,"PSUFIN")=^XTMP("PSU_"_PSUJOB,"PSUDIVUD") ;UD division name/SSN
|
---|
| 114 | Q
|
---|
| 115 | S E=1 ;Counter for new global
|
---|
| 116 | S PSUZ=0
|
---|
| 117 | F S PSUZ=$O(^XTMP("PSU_"_PSUJOB,"PSUIVINDIV",PSUZ)) Q:PSUZ="" D
|
---|
| 118 | .S ^XTMP("PSU_"_PSUJOB,"PSUNEW",PSUZ,E)=$P($G(^XTMP("PSU_"_PSUJOB,"PSUIVINDIV",PSUZ)),U,1) ;IV
|
---|
| 119 | .S E=E+1
|
---|
| 120 | ;
|
---|
| 121 | S PSUZ1=0
|
---|
| 122 | F S PSUZ1=$O(^XTMP("PSU_"_PSUJOB,"PSUUDDIV",PSUZ1)) Q:PSUZ1="" D
|
---|
| 123 | .S ^XTMP("PSU_"_PSUJOB,"PSUNEW",PSUZ1,E)=$P($G(^XTMP("PSU_"_PSUJOB,"PSUUDDIV",PSUZ1)),U,1)
|
---|
| 124 | .S E=E+1
|
---|
| 125 | Q
|
---|
| 126 | ;
|
---|
| 127 | ;
|
---|
| 128 | TOTAL ;Calculate sum of all divisions and set individual division lines
|
---|
| 129 | ;into summary message
|
---|
| 130 | ;
|
---|
| 131 | S T=1
|
---|
| 132 | S PSUDNAM=0
|
---|
| 133 | F S PSUDNAM=$O(^XTMP("PSU_"_PSUJOB,"PSUFIN",PSUDNAM)) Q:PSUDNAM="" D
|
---|
| 134 | .S PSUNUM1=0
|
---|
| 135 | .F S PSUNUM1=$O(^XTMP("PSU_"_PSUJOB,"PSUFIN",PSUDNAM,PSUNUM1)) Q:PSUNUM1="" D
|
---|
| 136 | ..S ^XTMP("PSU_"_PSUJOB,"PSUTOTAL")=T S T=T+1 ;Set total count
|
---|
| 137 | ..I $D(^XTMP("PSU_"_PSUJOB,"PSUTOT",PSUDNAM)) D
|
---|
| 138 | ...S C=C+1
|
---|
| 139 | ...S ^XTMP("PSU_"_PSUJOB,"PSUTOT",PSUDNAM)=C
|
---|
| 140 | ..I '$D(^XTMP("PSU_"_PSUJOB,"PSUTOT",PSUDNAM)) D
|
---|
| 141 | ...S C=1
|
---|
| 142 | ...S ^XTMP("PSU_"_PSUJOB,"PSUTOT",PSUDNAM)=C
|
---|
| 143 | ;
|
---|
| 144 | S PSUDNAM1=0
|
---|
| 145 | N PSUSNUM
|
---|
| 146 | F S PSUDNAM1=$O(^XTMP("PSU_"_PSUJOB,"PSUTOT",PSUDNAM1)) Q:PSUDNAM1="" D
|
---|
| 147 | .S PSUNUM=$P($G(^XTMP("PSU_"_PSUJOB,"PSUTOT",PSUDNAM1)),U,1)
|
---|
| 148 | .D TAB1
|
---|
| 149 | .S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=" "_PSUDNAM1_" Division:"_PSUTB6_PSUNUM
|
---|
| 150 | .S I=I+1
|
---|
| 151 | ;
|
---|
| 152 | Q
|
---|
| 153 | ;
|
---|
| 154 | TAB1 ;Calculate tab spacing
|
---|
| 155 | ;
|
---|
| 156 | S PSUTB6=" "
|
---|
| 157 | S PSUTB7=(59-$L(PSUNUM))-$L(PSUDNAM1)-10
|
---|
| 158 | F S2=1:1:(PSUTB7-1) S PSUTB(S2)=" " D
|
---|
| 159 | .S PSUTB6=PSUTB6_PSUTB(S2) ;Tab position
|
---|
| 160 | Q
|
---|
| 161 | ;
|
---|
| 162 | NODATA ;Summary report line to be sent if there is no data
|
---|
| 163 | ;
|
---|
| 164 | S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",1)="PHARMACY INPATIENT (UD & IV) UNIQUE PATIENTS REPORT"
|
---|
| 165 | S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",2)=" "
|
---|
| 166 | S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",3)="No data to report"
|
---|
| 167 | D PDSUM^PSUDEM5
|
---|
| 168 | Q
|
---|