- PSUSUM6 ;BIR/DAM - Patient Demographics Summary for IV/UD/RX ; 20 DEC 2001
- ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
- ;
- EN ;EN CALLED FROM PSUOP0
- ;
- K ^XTMP("PSU_"_PSUJOB,"PSUSUMA") ;DAM Trying to make auto run
- I $D(^XTMP("PSU_"_PSUJOB,"PSUFLAG2"))!$D(^XTMP("PSU_"_PSUJOB,"PSUFLAG3")) D
- .K ^XTMP("PSU_"_PSUJOB,"PSUSUMA")
- ;
- N PSURX,PSUIV,PSUUD
- S PSURX=$G(^XTMP("PSU_"_PSUJOB,"PSUNONE","RX"))
- S PSUIV=$G(^XTMP("PSU_"_PSUJOB,"PSUNONE","IV"))
- S PSUUD=$G(^XTMP("PSU_"_PSUJOB,"PSUNONE","UD"))
- I $G(PSURX)&$G(PSUIV)&$G(PSUUD) D Q
- .D NODATA D
- ..I $D(^XTMP("PSU_"_PSUJOB,"PSUFLAG1"))!$D(^XTMP("PSU_"_PSUJOB,"PSUFLAG2")) K ^XTMP("PSU_"_PSUJOB,"PSUNONE")
- D EN1
- Q
- ;
- EN1 ;Gather summary data for UD/IV/RX report
- D PULL^PSUCP
- D DATE
- S I=7
- D UNIQUE
- D TOP
- D OPDIV
- D DIVTOT
- D TUDIV
- D IPDIV
- D IPDIV1
- D TAB3
- D TAB4
- D PDSUM^PSUDEM5 ;Mail message
- K ^XTMP("PSU_"_PSUJOB,"PSUTMP")
- K ^XTMP("PSU_"_PSUJOB,"PSUTOTAL")
- K ^XTMP("PSU_"_PSUJOB,"PSURXUNIQUE")
- K ^XTMP("PSU_"_PSUJOB,"PSURXTOTAL")
- K ^XTMP("PSU_"_PSUJOB,"PSURXCTA")
- K ^XTMP("PSU_"_PSUJOB,"PSURXSSN")
- K ^XTMP("PSU_"_PSUJOB,"PSUCOMBO")
- K ^XTMP("PSU_"_PSUJOB,"PSUIVSSN")
- K ^XTMP("PSU_"_PSUJOB,"PSUUDSSN")
- K ^XTMP("PSU_"_PSUJOB,"PSUIVDIV")
- K ^XTMP("PSU_"_PSUJOB,"PSUIVOUT")
- K ^XTMP("PSU_"_PSUJOB,"PSUUDDIV")
- Q
- ;
- DATE ;EN Convert date range of extract to external format
- ;
- S %H=$E($H,1,5) ;today's date
- D YX^%DTC
- N PSUD S PSUD=Y
- ;
- S Y=PSUSDT
- D DD^%DT
- N PSUS S PSUS=Y
- ;
- S Y=PSUEDT
- D DD^%DT
- N PSUE S PSUE=Y
- ;
- D COMSUM
- Q
- ;
- COMSUM ;Summary report header to be run for combination Rx/IV/UD report
- ;
- ;Report header
- S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",1)="PHARMACY UNIQUE PATIENTS REPORT "_PSUD
- S $P(^XTMP("PSU_"_PSUJOB,"PSUSUMA",2),"-",80)="" ;Separator bar
- S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",3)=" "_PSUS_" through "_PSUE
- S $P(^XTMP("PSU_"_PSUJOB,"PSUSUMA",4),"=",80)=""
- S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",5)=" UNIQUE"
- S $P(^XTMP("PSU_"_PSUJOB,"PSUSUMA",6),"-",70)=""
- Q
- ;
- UNIQUE ;Find total unique pharmacy patients across all divisions
- ;
- S PSURXN=0,PSUIVN=0,PSUUDN1=0
- ;
- M ^XTMP("PSU_"_PSUJOB,"PSUTMP")=^XTMP("PSU_"_PSUJOB,"PSURXSSN")
- M ^XTMP("PSU_"_PSUJOB,"PSUTMP")=^XTMP("PSU_"_PSUJOB,"PSUIVSSN")
- M ^XTMP("PSU_"_PSUJOB,"PSUTMP")=^XTMP("PSU_"_PSUJOB,"PSUUDSSN")
- ;
- ;
- S N=1
- S PSUTTL=0
- F S PSUTTL=$O(^XTMP("PSU_"_PSUJOB,"PSUTMP",PSUTTL)) Q:PSUTTL="" D
- .S ^XTMP("PSU_"_PSUJOB,"PSUTOTAL")=N S N=N+1
- D TAB2
- S $P(^XTMP("PSU_"_PSUJOB,"PSUSUMA",I),"-",70)="" S I=I+1
- Q
- ;
- TAB2 ;Tab spacing for line 7. Set line into global
- ;
- N PSUTB3,PSUTB4,PSUTB5
- ;
- S PSUTB3=" "
- S PSUTB4="TOTAL Pharmacy patients across all divisions:"
- S PSUTB5=(64-$L(PSUTB4))-$L($P($G(^XTMP("PSU_"_PSUJOB,"PSUTOTAL")),U,1))
- F S3=1:1:(PSUTB5-1) S PSUTB(S3)=" " D
- .S PSUTB3=PSUTB3_PSUTB(S3)
- I '$G(^XTMP("PSU_"_PSUJOB,"PSUTOTAL")) D
- .S ^XTMP("PSU_"_PSUJOB,"PSUTOTAL")=0
- S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=PSUTB4_PSUTB3_$P($G(^XTMP("PSU_"_PSUJOB,"PSUTOTAL")),U,1)
- S I=I+1
- Q
- ;
- TOP ;EN Find Total Outpatients
- N PSUTB1,PSUTB2
- ;
- N PSUTOP,PSULBL
- S PSUTOP=$G(^XTMP("PSU_"_PSUJOB,"PSURXUNIQUE"))
- I '$G(PSUTOP) S PSUTOP=0,PSUTOPF=1
- S PSULBL=" Total OUTPATIENT:"
- D TAB
- S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=PSULBL_PSUTB1_PSUTOP S I=I+1
- S $P(^XTMP("PSU_"_PSUJOB,"PSUSUMA",I),"-",70)="" S I=I+1
- Q
- ;
- TAB ;Calculate tab spacing
- ;
- S PSUTB1=" "
- S PSUTB2=(64-$L(PSUTOP))-$L(PSULBL)
- F S2=1:1:(PSUTB2-1) S PSUTB(S2)=" " D
- .S PSUTB1=PSUTB1_PSUTB(S2)
- Q
- ;
- OPDIV ;EN Find outpatients per division
- ;
- Q:$G(PSUTOPF)
- N PSUTB1,PSUTB2
- ;
- N PSUTTL
- S PSULBL=0
- I $D(^XTMP("PSU_"_PSUJOB,"PSURXCTA")) D
- .F S PSULBL=$O(^XTMP("PSU_"_PSUJOB,"PSURXCTA",PSULBL)) Q:PSULBL="" D
- ..Q:PSULBL=0
- ..S PSUTTL=$P($G(^XTMP("PSU_"_PSUJOB,"PSURXCTA",PSULBL)),U,1)
- ..D TAB1
- ..S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=" "_PSULBL_" Division:"_PSUTB1_PSUTTL
- ..S I=I+1
- I '$D(^XTMP("PSU_"_PSUJOB,"PSURXCTA")) D
- .S PSUTTL=0
- .D TAB1
- .S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=" "_PSULBL_" Division:"_PSUTB1_PSUTTL
- .S I=I+1
- S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=" ----------" S I=I+1
- Q
- ;
- TAB1 ;EN Calculate division tab spacing
- ;
- S PSUTB1=" "
- S PSUTB2=(59-$L(PSUTTL))-$L(PSULBL)-10
- F S2=1:1:(PSUTB2-1) S PSUTB(S2)=" " D
- .S PSUTB1=PSUTB1_PSUTB(S2)
- Q
- ;
- DIVTOT ;EN Calculate tab spacing for 'Outpatient total of all divisions'
- ;line and set line into message global
- ;
- N PSUTB3,PSUTB4,PSUTB5
- ;
- I '$G(^XTMP("PSU_"_PSUJOB,"PSURXTOTAL")) D
- .S ^XTMP("PSU_"_PSUJOB,"PSURXTOTAL")=0
- S PSUTB3=" "
- S PSUTB4=" Outpatient Total of all Divisions:"
- S PSUTB5=(64-$L(PSUTB4))-$L($P($G(^XTMP("PSU_"_PSUJOB,"PSURXTOTAL")),U,1))
- F S3=1:1:(PSUTB5-1) S PSUTB3(S3)=" " D
- .S PSUTB3=PSUTB3_PSUTB(S3)
- S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=PSUTB4_PSUTB3_$P($G(^XTMP("PSU_"_PSUJOB,"PSURXTOTAL")),U,1) S I=I+1
- S $P(^XTMP("PSU_"_PSUJOB,"PSUSUMA",I),"-",70)="" S I=I+1
- Q
- ;
- TUDIV ;Calculate tab spacing for 'Total INPATIENT' line and
- ;set line into message global
- ;
- N PSUTB3,PSUTB4,PSUTB5
- ;
- ;Create global with total number of unique UD + IV inpatients
- ;using patient SSN to ID unique patient
- M ^XTMP("PSU_"_PSUJOB,"PSUUDIVT")=^XTMP("PSU_"_PSUJOB,"PSUDIV1")
- M ^XTMP("PSU_"_PSUJOB,"PSUUDIVT")=^XTMP("PSU_"_PSUJOB,"PSUDIVUD")
- ;
- ;Loop through division global and create global with unique SSN
- S G=1
- S PSUD2=0
- F S PSUD2=$O(^XTMP("PSU_"_PSUJOB,"PSUUDIVT",PSUD2)) Q:PSUD2="" D
- .S PSUD8=0
- .F S PSUD8=$O(^XTMP("PSU_"_PSUJOB,"PSUUDIVT",PSUD2,PSUD8)) Q:PSUD8="" D
- ..S ^XTMP("PSU_"_PSUJOB,"PSUUDIVT1",PSUD8)="" ;Unique SSN's
- ;
- ;Find number of unique SSN's. This is number of unique patients
- S PSUD9=0
- F S PSUD9=$O(^XTMP("PSU_"_PSUJOB,"PSUUDIVT1",PSUD9)) Q:PSUD9="" D
- .S ^XTMP("PSU_"_PSUJOB,"PSUUDIVTOT")=G,G=G+1
- ;
- ;Calculate tab spacing
- S PSUTB3=" "
- S PSUTB4=" Total INPATIENT:"
- S PSUTB5=(64-$L(PSUTB4))-$L($P($G(^XTMP("PSU_"_PSUJOB,"PSUUDIVTOT")),U,1))
- F S3=1:1:(PSUTB5-1) S PSUTB(S3)=" " D
- .S PSUTB3=PSUTB3_PSUTB(S3) ;Tab position
- ;
- ;Set line into message global
- S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=PSUTB4_PSUTB3_$P($G(^XTMP("PSU_"_PSUJOB,"PSUUDIVTOT")),U,1) S I=I+1
- S $P(^XTMP("PSU_"_PSUJOB,"PSUSUMA",I),"-",70)="" S I=I+1
- Q
- ;
- IPDIV ;EN Find inpatients by division (includes UD patients and IV
- ;patients with ward location NOT set to 0.5
- ;
- ;If no Unit Dose data exists, do the following to get IV data:
- I $D(^XTMP("PSU_"_PSUJOB,"PSUNONE","UD")) D Q
- .M ^XTMP("PSU_"_PSUJOB,"PSUINPT")=^XTMP("PSU_"_PSUJOB,"PSUDIV1")
- ;
- ;If no IV data exists, do the following to get UD data:
- I $D(^XTMP("PSU_"_PSUJOB,"PSUNONE","IV")) D Q
- .M ^XTMP("PSU_"_PSUJOB,"PSUINPT")=^XTMP("PSU_"_PSUJOB,"PSUDIVUD")
- ;
- ;Construct a storage global containing unique inpatients
- ;per division when there is both UD and IV data
- S PSUDV1=0
- F S PSUDV1=$O(^XTMP("PSU_"_PSUJOB,"PSUDIV1",PSUDV1)) Q:PSUDV1="" D
- .S PSUDVUD=0
- .F S PSUDVUD=$O(^XTMP("PSU_"_PSUJOB,"PSUDIVUD",PSUDVUD)) Q:PSUDVUD="" D
- ..I PSUDVUD=PSUDV1 D
- ...S PSUPT=0
- ...F S PSUPT=$O(^XTMP("PSU_"_PSUJOB,"PSUDIV1",PSUDV1,PSUPT)) Q:PSUPT="" D
- ....S ^XTMP("PSU_"_PSUJOB,"PSUINPT",PSUDV1,PSUPT)=""
- ....S PSUPT1=0
- ....F S PSUPT1=$O(^XTMP("PSU_"_PSUJOB,"PSUDIVUD",PSUDVUD,PSUPT1)) Q:PSUPT1="" D
- .....S ^XTMP("PSU_"_PSUJOB,"PSUINPT",PSUDVUD,PSUPT1)=""
- ..I PSUDVUD'=PSUDV1 D
- ...M ^XTMP("PSU_"_PSUJOB,"PSUINPT")=^XTMP("PSU_"_PSUJOB,"PSUDIVUD")
- Q
- ;
- IPDIV1 ;Calculate inpatient totals
- ;
- S PSUSIT=0,PSUSIT1=0,T=1
- ;
- F S PSUSIT=$O(^XTMP("PSU_"_PSUJOB,"PSUINPT",PSUSIT)) Q:PSUSIT="" D
- .F S PSUSIT1=$O(^XTMP("PSU_"_PSUJOB,"PSUINPT",PSUSIT,PSUSIT1)) Q:PSUSIT1="" D
- ..I $D(^XTMP("PSU_"_PSUJOB,"PSUCOMBO",PSUSIT)) D
- ...S C=C+1
- ...S ^XTMP("PSU_"_PSUJOB,"PSUCOMBO",PSUSIT)=C
- ..I '$D(^XTMP("PSU_"_PSUJOB,"PSUCOMBO",PSUSIT)) D
- ...S C=1
- ...S ^XTMP("PSU_"_PSUJOB,"PSUCOMBO",PSUSIT)=C
- Q
- ;
- TAB3 ;Place inpatient division totals into summary message
- ;
- N PSUTB1,PSUTB2
- ;
- N PSUTTL
- S PSULBL=0
- F S PSULBL=$O(^XTMP("PSU_"_PSUJOB,"PSUCOMBO",PSULBL)) Q:PSULBL="" D
- .S PSUTTL=$P($G(^XTMP("PSU_"_PSUJOB,"PSUCOMBO",PSULBL)),U,1)
- .I '$G(PSUTTL) S PSUTTL=0
- .D TAB1
- .S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=" "_PSULBL_" Division:"_PSUTB1_PSUTTL
- .S I=I+1
- Q
- ;
- TAB4 ;Calculate inpatient totals of all divisions and place in summary
- ;message
- ;
- S N=0,PSUMKER=0
- F S PSUMKER=$O(^XTMP("PSU_"_PSUJOB,"PSUCOMBO",PSUMKER)) Q:PSUMKER="" D
- .S N=$P(^XTMP("PSU_"_PSUJOB,"PSUCOMBO",PSUMKER),U)+N
- S ^XTMP("PSU_"_PSUJOB,"PSUTOTAL")=N ;Sum of all inpatients
- ;
- D TAB1^PSUSUM3
- Q
- ;
- NODATA ;Summary report line to be sent if there is no data
- ;
- S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",1)="PHARMACY UNIQUE PATIENTS REPORT"
- S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",2)=" "
- S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",3)="No data to report"
- D PDSUM^PSUDEM5
- Q
- PSUSUM6 ;BIR/DAM - Patient Demographics Summary for IV/UD/RX ; 20 DEC 2001
- +1 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
- +2 ;
- EN ;EN CALLED FROM PSUOP0
- +1 ;
- +2 ;DAM Trying to make auto run
- KILL ^XTMP("PSU_"_PSUJOB,"PSUSUMA")
- +3 IF $DATA(^XTMP("PSU_"_PSUJOB,"PSUFLAG2"))!$DATA(^XTMP("PSU_"_PSUJOB,"PSUFLAG3"))
- Begin DoDot:1
- +4 KILL ^XTMP("PSU_"_PSUJOB,"PSUSUMA")
- End DoDot:1
- +5 ;
- +6 NEW PSURX,PSUIV,PSUUD
- +7 SET PSURX=$GET(^XTMP("PSU_"_PSUJOB,"PSUNONE","RX"))
- +8 SET PSUIV=$GET(^XTMP("PSU_"_PSUJOB,"PSUNONE","IV"))
- +9 SET PSUUD=$GET(^XTMP("PSU_"_PSUJOB,"PSUNONE","UD"))
- +10 IF $GET(PSURX)&$GET(PSUIV)&$GET(PSUUD)
- Begin DoDot:1
- +11 DO NODATA
- Begin DoDot:2
- +12 IF $DATA(^XTMP("PSU_"_PSUJOB,"PSUFLAG1"))!$DATA(^XTMP("PSU_"_PSUJOB,"PSUFLAG2"))
- KILL ^XTMP("PSU_"_PSUJOB,"PSUNONE")
- End DoDot:2
- End DoDot:1
- QUIT
- +13 DO EN1
- +14 QUIT
- +15 ;
- EN1 ;Gather summary data for UD/IV/RX report
- +1 DO PULL^PSUCP
- +2 DO DATE
- +3 SET I=7
- +4 DO UNIQUE
- +5 DO TOP
- +6 DO OPDIV
- +7 DO DIVTOT
- +8 DO TUDIV
- +9 DO IPDIV
- +10 DO IPDIV1
- +11 DO TAB3
- +12 DO TAB4
- +13 ;Mail message
- DO PDSUM^PSUDEM5
- +14 KILL ^XTMP("PSU_"_PSUJOB,"PSUTMP")
- +15 KILL ^XTMP("PSU_"_PSUJOB,"PSUTOTAL")
- +16 KILL ^XTMP("PSU_"_PSUJOB,"PSURXUNIQUE")
- +17 KILL ^XTMP("PSU_"_PSUJOB,"PSURXTOTAL")
- +18 KILL ^XTMP("PSU_"_PSUJOB,"PSURXCTA")
- +19 KILL ^XTMP("PSU_"_PSUJOB,"PSURXSSN")
- +20 KILL ^XTMP("PSU_"_PSUJOB,"PSUCOMBO")
- +21 KILL ^XTMP("PSU_"_PSUJOB,"PSUIVSSN")
- +22 KILL ^XTMP("PSU_"_PSUJOB,"PSUUDSSN")
- +23 KILL ^XTMP("PSU_"_PSUJOB,"PSUIVDIV")
- +24 KILL ^XTMP("PSU_"_PSUJOB,"PSUIVOUT")
- +25 KILL ^XTMP("PSU_"_PSUJOB,"PSUUDDIV")
- +26 QUIT
- +27 ;
- DATE ;EN Convert date range of extract to external format
- +1 ;
- +2 ;today's date
- SET %H=$EXTRACT($HOROLOG,1,5)
- +3 DO YX^%DTC
- +4 NEW PSUD
- SET PSUD=Y
- +5 ;
- +6 SET Y=PSUSDT
- +7 DO DD^%DT
- +8 NEW PSUS
- SET PSUS=Y
- +9 ;
- +10 SET Y=PSUEDT
- +11 DO DD^%DT
- +12 NEW PSUE
- SET PSUE=Y
- +13 ;
- +14 DO COMSUM
- +15 QUIT
- +16 ;
- COMSUM ;Summary report header to be run for combination Rx/IV/UD report
- +1 ;
- +2 ;Report header
- +3 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",1)="PHARMACY UNIQUE PATIENTS REPORT "_PSUD
- +4 ;Separator bar
- SET $PIECE(^XTMP("PSU_"_PSUJOB,"PSUSUMA",2),"-",80)=""
- +5 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",3)=" "_PSUS_" through "_PSUE
- +6 SET $PIECE(^XTMP("PSU_"_PSUJOB,"PSUSUMA",4),"=",80)=""
- +7 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",5)=" UNIQUE"
- +8 SET $PIECE(^XTMP("PSU_"_PSUJOB,"PSUSUMA",6),"-",70)=""
- +9 QUIT
- +10 ;
- UNIQUE ;Find total unique pharmacy patients across all divisions
- +1 ;
- +2 SET PSURXN=0
- SET PSUIVN=0
- SET PSUUDN1=0
- +3 ;
- +4 MERGE ^XTMP("PSU_"_PSUJOB,"PSUTMP")=^XTMP("PSU_"_PSUJOB,"PSURXSSN")
- +5 MERGE ^XTMP("PSU_"_PSUJOB,"PSUTMP")=^XTMP("PSU_"_PSUJOB,"PSUIVSSN")
- +6 MERGE ^XTMP("PSU_"_PSUJOB,"PSUTMP")=^XTMP("PSU_"_PSUJOB,"PSUUDSSN")
- +7 ;
- +8 ;
- +9 SET N=1
- +10 SET PSUTTL=0
- +11 FOR
- SET PSUTTL=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUTMP",PSUTTL))
- IF PSUTTL=""
- QUIT
- Begin DoDot:1
- +12 SET ^XTMP("PSU_"_PSUJOB,"PSUTOTAL")=N
- SET N=N+1
- End DoDot:1
- +13 DO TAB2
- +14 SET $PIECE(^XTMP("PSU_"_PSUJOB,"PSUSUMA",I),"-",70)=""
- SET I=I+1
- +15 QUIT
- +16 ;
- TAB2 ;Tab spacing for line 7. Set line into global
- +1 ;
- +2 NEW PSUTB3,PSUTB4,PSUTB5
- +3 ;
- +4 SET PSUTB3=" "
- +5 SET PSUTB4="TOTAL Pharmacy patients across all divisions:"
- +6 SET PSUTB5=(64-$LENGTH(PSUTB4))-$LENGTH($PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSUTOTAL")),U,1))
- +7 FOR S3=1:1:(PSUTB5-1)
- SET PSUTB(S3)=" "
- Begin DoDot:1
- +8 SET PSUTB3=PSUTB3_PSUTB(S3)
- End DoDot:1
- +9 IF '$GET(^XTMP("PSU_"_PSUJOB,"PSUTOTAL"))
- Begin DoDot:1
- +10 SET ^XTMP("PSU_"_PSUJOB,"PSUTOTAL")=0
- End DoDot:1
- +11 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=PSUTB4_PSUTB3_$PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSUTOTAL")),U,1)
- +12 SET I=I+1
- +13 QUIT
- +14 ;
- TOP ;EN Find Total Outpatients
- +1 NEW PSUTB1,PSUTB2
- +2 ;
- +3 NEW PSUTOP,PSULBL
- +4 SET PSUTOP=$GET(^XTMP("PSU_"_PSUJOB,"PSURXUNIQUE"))
- +5 IF '$GET(PSUTOP)
- SET PSUTOP=0
- SET PSUTOPF=1
- +6 SET PSULBL=" Total OUTPATIENT:"
- +7 DO TAB
- +8 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=PSULBL_PSUTB1_PSUTOP
- SET I=I+1
- +9 SET $PIECE(^XTMP("PSU_"_PSUJOB,"PSUSUMA",I),"-",70)=""
- SET I=I+1
- +10 QUIT
- +11 ;
- TAB ;Calculate tab spacing
- +1 ;
- +2 SET PSUTB1=" "
- +3 SET PSUTB2=(64-$LENGTH(PSUTOP))-$LENGTH(PSULBL)
- +4 FOR S2=1:1:(PSUTB2-1)
- SET PSUTB(S2)=" "
- Begin DoDot:1
- +5 SET PSUTB1=PSUTB1_PSUTB(S2)
- End DoDot:1
- +6 QUIT
- +7 ;
- OPDIV ;EN Find outpatients per division
- +1 ;
- +2 IF $GET(PSUTOPF)
- QUIT
- +3 NEW PSUTB1,PSUTB2
- +4 ;
- +5 NEW PSUTTL
- +6 SET PSULBL=0
- +7 IF $DATA(^XTMP("PSU_"_PSUJOB,"PSURXCTA"))
- Begin DoDot:1
- +8 FOR
- SET PSULBL=$ORDER(^XTMP("PSU_"_PSUJOB,"PSURXCTA",PSULBL))
- IF PSULBL=""
- QUIT
- Begin DoDot:2
- +9 IF PSULBL=0
- QUIT
- +10 SET PSUTTL=$PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSURXCTA",PSULBL)),U,1)
- +11 DO TAB1
- +12 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=" "_PSULBL_" Division:"_PSUTB1_PSUTTL
- +13 SET I=I+1
- End DoDot:2
- End DoDot:1
- +14 IF '$DATA(^XTMP("PSU_"_PSUJOB,"PSURXCTA"))
- Begin DoDot:1
- +15 SET PSUTTL=0
- +16 DO TAB1
- +17 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=" "_PSULBL_" Division:"_PSUTB1_PSUTTL
- +18 SET I=I+1
- End DoDot:1
- +19 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=" ----------"
- SET I=I+1
- +20 QUIT
- +21 ;
- TAB1 ;EN Calculate division tab spacing
- +1 ;
- +2 SET PSUTB1=" "
- +3 SET PSUTB2=(59-$LENGTH(PSUTTL))-$LENGTH(PSULBL)-10
- +4 FOR S2=1:1:(PSUTB2-1)
- SET PSUTB(S2)=" "
- Begin DoDot:1
- +5 SET PSUTB1=PSUTB1_PSUTB(S2)
- End DoDot:1
- +6 QUIT
- +7 ;
- DIVTOT ;EN Calculate tab spacing for 'Outpatient total of all divisions'
- +1 ;line and set line into message global
- +2 ;
- +3 NEW PSUTB3,PSUTB4,PSUTB5
- +4 ;
- +5 IF '$GET(^XTMP("PSU_"_PSUJOB,"PSURXTOTAL"))
- Begin DoDot:1
- +6 SET ^XTMP("PSU_"_PSUJOB,"PSURXTOTAL")=0
- End DoDot:1
- +7 SET PSUTB3=" "
- +8 SET PSUTB4=" Outpatient Total of all Divisions:"
- +9 SET PSUTB5=(64-$LENGTH(PSUTB4))-$LENGTH($PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSURXTOTAL")),U,1))
- +10 FOR S3=1:1:(PSUTB5-1)
- SET PSUTB3(S3)=" "
- Begin DoDot:1
- +11 SET PSUTB3=PSUTB3_PSUTB(S3)
- End DoDot:1
- +12 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=PSUTB4_PSUTB3_$PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSURXTOTAL")),U,1)
- SET I=I+1
- +13 SET $PIECE(^XTMP("PSU_"_PSUJOB,"PSUSUMA",I),"-",70)=""
- SET I=I+1
- +14 QUIT
- +15 ;
- TUDIV ;Calculate tab spacing for 'Total INPATIENT' line and
- +1 ;set line into message global
- +2 ;
- +3 NEW PSUTB3,PSUTB4,PSUTB5
- +4 ;
- +5 ;Create global with total number of unique UD + IV inpatients
- +6 ;using patient SSN to ID unique patient
- +7 MERGE ^XTMP("PSU_"_PSUJOB,"PSUUDIVT")=^XTMP("PSU_"_PSUJOB,"PSUDIV1")
- +8 MERGE ^XTMP("PSU_"_PSUJOB,"PSUUDIVT")=^XTMP("PSU_"_PSUJOB,"PSUDIVUD")
- +9 ;
- +10 ;Loop through division global and create global with unique SSN
- +11 SET G=1
- +12 SET PSUD2=0
- +13 FOR
- SET PSUD2=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUUDIVT",PSUD2))
- IF PSUD2=""
- QUIT
- Begin DoDot:1
- +14 SET PSUD8=0
- +15 FOR
- SET PSUD8=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUUDIVT",PSUD2,PSUD8))
- IF PSUD8=""
- QUIT
- Begin DoDot:2
- +16 ;Unique SSN's
- SET ^XTMP("PSU_"_PSUJOB,"PSUUDIVT1",PSUD8)=""
- End DoDot:2
- End DoDot:1
- +17 ;
- +18 ;Find number of unique SSN's. This is number of unique patients
- +19 SET PSUD9=0
- +20 FOR
- SET PSUD9=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUUDIVT1",PSUD9))
- IF PSUD9=""
- QUIT
- Begin DoDot:1
- +21 SET ^XTMP("PSU_"_PSUJOB,"PSUUDIVTOT")=G
- SET G=G+1
- End DoDot:1
- +22 ;
- +23 ;Calculate tab spacing
- +24 SET PSUTB3=" "
- +25 SET PSUTB4=" Total INPATIENT:"
- +26 SET PSUTB5=(64-$LENGTH(PSUTB4))-$LENGTH($PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSUUDIVTOT")),U,1))
- +27 FOR S3=1:1:(PSUTB5-1)
- SET PSUTB(S3)=" "
- Begin DoDot:1
- +28 ;Tab position
- SET PSUTB3=PSUTB3_PSUTB(S3)
- End DoDot:1
- +29 ;
- +30 ;Set line into message global
- +31 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=PSUTB4_PSUTB3_$PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSUUDIVTOT")),U,1)
- SET I=I+1
- +32 SET $PIECE(^XTMP("PSU_"_PSUJOB,"PSUSUMA",I),"-",70)=""
- SET I=I+1
- +33 QUIT
- +34 ;
- IPDIV ;EN Find inpatients by division (includes UD patients and IV
- +1 ;patients with ward location NOT set to 0.5
- +2 ;
- +3 ;If no Unit Dose data exists, do the following to get IV data:
- +4 IF $DATA(^XTMP("PSU_"_PSUJOB,"PSUNONE","UD"))
- Begin DoDot:1
- +5 MERGE ^XTMP("PSU_"_PSUJOB,"PSUINPT")=^XTMP("PSU_"_PSUJOB,"PSUDIV1")
- End DoDot:1
- QUIT
- +6 ;
- +7 ;If no IV data exists, do the following to get UD data:
- +8 IF $DATA(^XTMP("PSU_"_PSUJOB,"PSUNONE","IV"))
- Begin DoDot:1
- +9 MERGE ^XTMP("PSU_"_PSUJOB,"PSUINPT")=^XTMP("PSU_"_PSUJOB,"PSUDIVUD")
- End DoDot:1
- QUIT
- +10 ;
- +11 ;Construct a storage global containing unique inpatients
- +12 ;per division when there is both UD and IV data
- +13 SET PSUDV1=0
- +14 FOR
- SET PSUDV1=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUDIV1",PSUDV1))
- IF PSUDV1=""
- QUIT
- Begin DoDot:1
- +15 SET PSUDVUD=0
- +16 FOR
- SET PSUDVUD=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUDIVUD",PSUDVUD))
- IF PSUDVUD=""
- QUIT
- Begin DoDot:2
- +17 IF PSUDVUD=PSUDV1
- Begin DoDot:3
- +18 SET PSUPT=0
- +19 FOR
- SET PSUPT=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUDIV1",PSUDV1,PSUPT))
- IF PSUPT=""
- QUIT
- Begin DoDot:4
- +20 SET ^XTMP("PSU_"_PSUJOB,"PSUINPT",PSUDV1,PSUPT)=""
- +21 SET PSUPT1=0
- +22 FOR
- SET PSUPT1=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUDIVUD",PSUDVUD,PSUPT1))
- IF PSUPT1=""
- QUIT
- Begin DoDot:5
- +23 SET ^XTMP("PSU_"_PSUJOB,"PSUINPT",PSUDVUD,PSUPT1)=""
- End DoDot:5
- End DoDot:4
- End DoDot:3
- +24 IF PSUDVUD'=PSUDV1
- Begin DoDot:3
- +25 MERGE ^XTMP("PSU_"_PSUJOB,"PSUINPT")=^XTMP("PSU_"_PSUJOB,"PSUDIVUD")
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +26 QUIT
- +27 ;
- IPDIV1 ;Calculate inpatient totals
- +1 ;
- +2 SET PSUSIT=0
- SET PSUSIT1=0
- SET T=1
- +3 ;
- +4 FOR
- SET PSUSIT=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUINPT",PSUSIT))
- IF PSUSIT=""
- QUIT
- Begin DoDot:1
- +5 FOR
- SET PSUSIT1=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUINPT",PSUSIT,PSUSIT1))
- IF PSUSIT1=""
- QUIT
- Begin DoDot:2
- +6 IF $DATA(^XTMP("PSU_"_PSUJOB,"PSUCOMBO",PSUSIT))
- Begin DoDot:3
- +7 SET C=C+1
- +8 SET ^XTMP("PSU_"_PSUJOB,"PSUCOMBO",PSUSIT)=C
- End DoDot:3
- +9 IF '$DATA(^XTMP("PSU_"_PSUJOB,"PSUCOMBO",PSUSIT))
- Begin DoDot:3
- +10 SET C=1
- +11 SET ^XTMP("PSU_"_PSUJOB,"PSUCOMBO",PSUSIT)=C
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +12 QUIT
- +13 ;
- TAB3 ;Place inpatient division totals into summary message
- +1 ;
- +2 NEW PSUTB1,PSUTB2
- +3 ;
- +4 NEW PSUTTL
- +5 SET PSULBL=0
- +6 FOR
- SET PSULBL=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUCOMBO",PSULBL))
- IF PSULBL=""
- QUIT
- Begin DoDot:1
- +7 SET PSUTTL=$PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSUCOMBO",PSULBL)),U,1)
- +8 IF '$GET(PSUTTL)
- SET PSUTTL=0
- +9 DO TAB1
- +10 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=" "_PSULBL_" Division:"_PSUTB1_PSUTTL
- +11 SET I=I+1
- End DoDot:1
- +12 QUIT
- +13 ;
- TAB4 ;Calculate inpatient totals of all divisions and place in summary
- +1 ;message
- +2 ;
- +3 SET N=0
- SET PSUMKER=0
- +4 FOR
- SET PSUMKER=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUCOMBO",PSUMKER))
- IF PSUMKER=""
- QUIT
- Begin DoDot:1
- +5 SET N=$PIECE(^XTMP("PSU_"_PSUJOB,"PSUCOMBO",PSUMKER),U)+N
- End DoDot:1
- +6 ;Sum of all inpatients
- SET ^XTMP("PSU_"_PSUJOB,"PSUTOTAL")=N
- +7 ;
- +8 DO TAB1^PSUSUM3
- +9 QUIT
- +10 ;
- NODATA ;Summary report line to be sent if there is no data
- +1 ;
- +2 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",1)="PHARMACY UNIQUE PATIENTS REPORT"
- +3 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",2)=" "
- +4 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",3)="No data to report"
- +5 DO PDSUM^PSUDEM5
- +6 QUIT