- PSUSUM7 ;BIR/DAM - Pt. Demographics Summary for IV/RX or UD/RX ; 20 DEC 2001
- ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
- ;
- EN ;EN CALLED FROM PSUOP0
- ;Q:$D(^XTMP("PSU_"_PSUJOB,"PSU_"_PSUJOB,"PSUMFLAG")) ;Do not run if auto extract
- ;
- D PULL^PSUCP
- F I=1:1:$L(PSUOPTS,",") S PSUMOD($P(PSUOPTS,",",I))=""
- ;
- K ^XTMP("PSU_"_PSUJOB,"PSUSUMA")
- I $G(^XTMP("PSU_"_PSUJOB,"PSUFLAG2"))!$G(^XTMP("PSU_"_PSUJOB,"PSUFLAG3")) K ^XTMP("PSU_"_PSUJOB,"PSUSUMA")
- I $D(^XTMP("PSU_"_PSUJOB,"PSUNONE","RX")) D Q
- .I $D(^XTMP("PSU_"_PSUJOB,"PSUNONE","IV"))!$D(^XTMP("PSU_"_PSUJOB,"PSUNONE","UD")) D
- ..D NODATA
- ..I $G(^XTMP("PSU_"_PSUJOB,"PSUFLAG1"))!$G(^XTMP("PSU_"_PSUJOB,"PSUFLAG2")) K ^XTMP("PSU_"_PSUJOB,"PSUNONE")
- ;
- D EN1
- Q
- ;
- EN1 ;Gather summary data
- D DATE^PSUSUM6
- S I=7
- I $D(PSUMOD(1)) D UNIQUE1
- I '$D(PSUMOD(1)) D UNIQUE
- D TOP^PSUSUM6
- D OPDIV^PSUSUM6
- D DIVTOT^PSUSUM6
- D TUDIV
- I $D(PSUMOD(1)) D
- .D IPDIV2
- I $D(PSUMOD(2)) D
- .D IPDIV^PSUSUM6
- .D IPDIV1
- .D TAB4
- D PDSUM^PSUDEM5
- K ^XTMP("PSU_"_PSUJOB,"PSUTMP"),^XTMP("PSU_"_PSUJOB,"PSUTOTAL"),^XTMP("PSU_"_PSUJOB,"PSURXUNIQUE")
- K ^XTMP("PSU_"_PSUJOB,"PSURXTOTAL")
- K ^XTMP("PSU_"_PSUJOB,"PSURXCTA"),^XTMP("PSU_"_PSUJOB,"PSUIVINDIV")
- K ^XTMP("PSU_"_PSUJOB,"PSURXSSN"),^XTMP("PSU_"_PSUJOB,"PSUIVDIV"),^XTMP("PSU_"_PSUJOB,"PSUFLAG2")
- K ^XTMP("PSU_"_PSUJOB,"PSUFLAG3")
- K ^XTMP("PSU_"_PSUJOB,"PSUIVOUT"),^XTMP("PSU_"_PSUJOB,"PSUIVSSN"),^XTMP("PSU_"_PSUJOB,"PSUUDDIV")
- Q
- ;
- UNIQUE ;Find total unique pharmacy patients across all divisions when
- ;UD and RX extracts are run together
- ;
- S PSURXN=0,PSUUDN1=0,PSUUDN2=0
- ;
- S N=1
- F S PSURXN=$O(^XTMP("PSU_"_PSUJOB,"PSURXSSN",PSURXN)) Q:PSURXN="" D
- .S ^XTMP("PSU_"_PSUJOB,"PSUTMP",PSURXN)=N S N=N+1
- .F S PSUUDN1=$O(^XTMP("PSU_"_PSUJOB,"PSUUDSSN",PSUUDN1)) Q:PSUUDN1="" D
- ..I '$D(^XTMP("PSU_"_PSUJOB,"PSUTMP",PSUUDN1)) S ^XTMP("PSU_"_PSUJOB,"PSUTMP",PSUUDN1)=N S N=N+1
- ;
- S ^XTMP("PSU_"_PSUJOB,"PSUTOTAL")=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
- ;
- 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)
- S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=PSUTB4_PSUTB3_$P($G(^XTMP("PSU_"_PSUJOB,"PSUTOTAL")),U,1)
- S I=I+1
- Q
- ;
- UNIQUE1 ;Find total unique pharmacy patients across all divisions when
- ;IV and RX extracts are run together
- ;
- S PSURXN=0,PSUIVN=0
- ;
- S N=1
- ;
- F S PSURXN=$O(^XTMP("PSU_"_PSUJOB,"PSURXSSN",PSURXN)) Q:PSURXN="" D
- .S ^XTMP("PSU_"_PSUJOB,"PSUTMP",PSURXN)=N S N=N+1
- .F S PSUIVN=$O(^XTMP("PSU_"_PSUJOB,"PSUIVSSN",PSUIVN)) Q:PSUIVN="" D
- ..I '$D(^XTMP("PSU_"_PSUJOB,"PSUTMP",PSUIVN)) S ^XTMP("PSU_"_PSUJOB,"PSUTMP",PSUIVN)=N S N=N+1
- ;
- S ^XTMP("PSU_"_PSUJOB,"PSUTOTAL")=N-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
- S $P(^XTMP("PSU_"_PSUJOB,"PSUSUMA",I),"-",70)="" S I=I+1
- Q
- ;
- TUDIV ;Calculate total inpatient count and tab spacing for 'Total
- ;INPATIENT (UD or IV)' line and set into message global
- ;
- N PSUTB3,PSUTB4,PSUTB5,PSUDT
- ;
- I '$D(PSUMOD(1)) D
- .S PSUDT=$P($G(^XTMP("PSU_"_PSUJOB,"PSUUDSSN")),U) D
- ..S ^XTMP("PSU_"_PSUJOB,"PSUUDIVTOT")=PSUDT ;Total UD inpatient count
- ;
- I '$D(PSUMOD(2)) D
- .S ^XTMP("PSU_"_PSUJOB,"PSUUDIVTOT")=$P($G(^XTMP("PSU_"_PSUJOB,"PSUIVIN")),U,1)-1 ;Total IV inpatient count
- ;
- I '$G(^XTMP("PSU_"_PSUJOB,"PSUUDIVTOT")) S ^XTMP("PSU_"_PSUJOB,"PSUUDIVTOT")=0
- S PSUTB3=" "
- S PSUTB4=" Total INPATIENT (UD or IV):"
- 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
- ;
- 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
- ;
- IPDIV1 ;Find UD inpatient division totals
- ;
- S PSULBL=0
- N PSUTTL
- ;
- I $D(PSUMOD(2)) D ;UD inpatients
- .F S PSULBL=$O(^XTMP("PSU_"_PSUJOB,"PSUUDDIV",PSULBL)) Q:PSULBL="" D
- ..S PSUTTL=$P($G(^XTMP("PSU_"_PSUJOB,"PSUUDDIV",PSULBL)),U,1)
- ..D TAB1^PSUSUM6
- ..D IPMSG
- Q
- ;
- IPMSG ;Set UD inpatient division totals into message global
- ;
- S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=" "_PSULBL_" Division:"_PSUTB1_PSUTTL
- S I=I+1
- Q
- ;
- IPDIV2 ;Calculate inpatient totals for IV divisions
- ;
- ;
- ;Construct a storage global containing unique IV inpatients
- ;per division
- S PSUDV=0
- F S PSUDV=$O(^XTMP("PSU_"_PSUJOB,"PSUDIV1",PSUDV)) Q:PSUDV="" D
- .S PSUPT=0
- .F S PSUPT=$O(^XTMP("PSU_"_PSUJOB,"PSUDIV1",PSUDV,PSUPT)) Q:PSUPT="" D
- ..S PSUPT1=0
- ..F S PSUPT1=$O(^XTMP("PSU_"_PSUJOB,"PSUIN1",PSUPT1)) Q:PSUPT1="" D
- ...I PSUPT1=PSUPT S ^XTMP("PSU_"_PSUJOB,"PSUDIV",PSUDV,PSUPT1)=""
- D IPDIV3
- Q
- ;
- IPDIV3 ;Find unique inpatient count for each division
- S PSUCT1=0,PSUCT2=0,T=1
- ;
- F S PSUCT1=$O(^XTMP("PSU_"_PSUJOB,"PSUDIV",PSUCT1)) Q:PSUCT1="" D
- .F S PSUCT2=$O(^XTMP("PSU_"_PSUJOB,"PSUDIV",PSUCT1,PSUCT2)) Q:PSUCT2="" D
- ..S ^XTMP("PSU_"_PSUJOB,"PSUTOTAL1")=T S T=T+1 ;Total count
- ..I $D(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUCT1)) D
- ...S C=C+1
- ...S ^XTMP("PSU_"_PSUJOB,"PSUCT",PSUCT1)=C
- ..I '$D(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUCT1)) D
- ...S C=1
- ...S ^XTMP("PSU_"_PSUJOB,"PSUCT",PSUCT1)=C
- D DIVNUM
- D MSG
- Q
- ;
- DIVNUM ;Set number of inpatients per division into summary message
- ;
- N PSUTB1,PSUTB2
- S N=1
- ;
- N PSUCT2
- S PSUDIVA1=0
- F S PSUDIVA1=$O(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUDIVA1)) Q:PSUDIVA1="" D
- .S PSUCT2=$P($G(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUDIVA1)),U,1)
- .D TAB5
- .S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=" "_PSUDIVA1_" Division:"_PSUTB1_PSUCT2
- .S I=I+1
- Q
- ;
- TAB5 ;Calculate tab spacing
- ;
- S PSUTB1=" "
- S PSUTB2=(59-$L(PSUCT2))-$L(PSUDIVA1)-10
- F S2=1:1:(PSUTB2-1) S PSUTB(S2)=" " D
- .S PSUTB1=PSUTB1_PSUTB(S2) ;Tab position
- Q
- ;
- TAB4 ;Calculate UD totals of all divisions and place in summary
- ;message
- ;
- S N=0,PSUMKER=0,R=1
- ;
- I $D(PSUMOD(2)) D
- .F S PSUMKER=$O(^XTMP("PSU_"_PSUJOB,"PSUUDDIV",PSUMKER)) Q:PSUMKER="" D
- ..S N=$P(^XTMP("PSU_"_PSUJOB,"PSUUDDIV",PSUMKER),U)+N
- ..S ^XTMP("PSU_"_PSUJOB,"PSUTOTAL1")=N ;Sum of all UD inpatients
- ;
- D MSG
- Q
- ;
- MSG ;Final lines of message
- ;
- I '$D(^XTMP("PSU_"_PSUJOB,"PSUTOTAL1")) S ^XTMP("PSU_"_PSUJOB,"PSUTOTAL1")=0
- ;
- N PSUTB3,PSUTB4,PSUTB5
- ;
- S PSUTB3=" "
- S PSUTB4=" Inpatient Total of all Divisions:"
- S PSUTB5=(64-$L(PSUTB4))-$L($P($G(^XTMP("PSU_"_PSUJOB,"PSUTOTAL1")),U,1))
- F S3=1:1:(PSUTB5-1) S PSUTB(S3)=" " D
- .S PSUTB3=PSUTB3_PSUTB(S3) ;Tab position
- S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=" ----------" S I=I+1
- S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=PSUTB4_PSUTB3_$P($G(^XTMP("PSU_"_PSUJOB,"PSUTOTAL1")),U,1) S I=I+1
- S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)="" S I=I+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
- S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)="have been provided pharmacy services at more than one outpatient and/or" S I=I+1
- S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)="inpatient division."
- 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
- PSUSUM7 ;BIR/DAM - Pt. Demographics Summary for IV/RX or UD/RX ; 20 DEC 2001
- +1 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
- +2 ;
- EN ;EN CALLED FROM PSUOP0
- +1 ;Q:$D(^XTMP("PSU_"_PSUJOB,"PSU_"_PSUJOB,"PSUMFLAG")) ;Do not run if auto extract
- +2 ;
- +3 DO PULL^PSUCP
- +4 FOR I=1:1:$LENGTH(PSUOPTS,",")
- SET PSUMOD($PIECE(PSUOPTS,",",I))=""
- +5 ;
- +6 KILL ^XTMP("PSU_"_PSUJOB,"PSUSUMA")
- +7 IF $GET(^XTMP("PSU_"_PSUJOB,"PSUFLAG2"))!$GET(^XTMP("PSU_"_PSUJOB,"PSUFLAG3"))
- KILL ^XTMP("PSU_"_PSUJOB,"PSUSUMA")
- +8 IF $DATA(^XTMP("PSU_"_PSUJOB,"PSUNONE","RX"))
- Begin DoDot:1
- +9 IF $DATA(^XTMP("PSU_"_PSUJOB,"PSUNONE","IV"))!$DATA(^XTMP("PSU_"_PSUJOB,"PSUNONE","UD"))
- Begin DoDot:2
- +10 DO NODATA
- +11 IF $GET(^XTMP("PSU_"_PSUJOB,"PSUFLAG1"))!$GET(^XTMP("PSU_"_PSUJOB,"PSUFLAG2"))
- KILL ^XTMP("PSU_"_PSUJOB,"PSUNONE")
- End DoDot:2
- End DoDot:1
- QUIT
- +12 ;
- +13 DO EN1
- +14 QUIT
- +15 ;
- EN1 ;Gather summary data
- +1 DO DATE^PSUSUM6
- +2 SET I=7
- +3 IF $DATA(PSUMOD(1))
- DO UNIQUE1
- +4 IF '$DATA(PSUMOD(1))
- DO UNIQUE
- +5 DO TOP^PSUSUM6
- +6 DO OPDIV^PSUSUM6
- +7 DO DIVTOT^PSUSUM6
- +8 DO TUDIV
- +9 IF $DATA(PSUMOD(1))
- Begin DoDot:1
- +10 DO IPDIV2
- End DoDot:1
- +11 IF $DATA(PSUMOD(2))
- Begin DoDot:1
- +12 DO IPDIV^PSUSUM6
- +13 DO IPDIV1
- +14 DO TAB4
- End DoDot:1
- +15 DO PDSUM^PSUDEM5
- +16 KILL ^XTMP("PSU_"_PSUJOB,"PSUTMP"),^XTMP("PSU_"_PSUJOB,"PSUTOTAL"),^XTMP("PSU_"_PSUJOB,"PSURXUNIQUE")
- +17 KILL ^XTMP("PSU_"_PSUJOB,"PSURXTOTAL")
- +18 KILL ^XTMP("PSU_"_PSUJOB,"PSURXCTA"),^XTMP("PSU_"_PSUJOB,"PSUIVINDIV")
- +19 KILL ^XTMP("PSU_"_PSUJOB,"PSURXSSN"),^XTMP("PSU_"_PSUJOB,"PSUIVDIV"),^XTMP("PSU_"_PSUJOB,"PSUFLAG2")
- +20 KILL ^XTMP("PSU_"_PSUJOB,"PSUFLAG3")
- +21 KILL ^XTMP("PSU_"_PSUJOB,"PSUIVOUT"),^XTMP("PSU_"_PSUJOB,"PSUIVSSN"),^XTMP("PSU_"_PSUJOB,"PSUUDDIV")
- +22 QUIT
- +23 ;
- UNIQUE ;Find total unique pharmacy patients across all divisions when
- +1 ;UD and RX extracts are run together
- +2 ;
- +3 SET PSURXN=0
- SET PSUUDN1=0
- SET PSUUDN2=0
- +4 ;
- +5 SET N=1
- +6 FOR
- SET PSURXN=$ORDER(^XTMP("PSU_"_PSUJOB,"PSURXSSN",PSURXN))
- IF PSURXN=""
- QUIT
- Begin DoDot:1
- +7 SET ^XTMP("PSU_"_PSUJOB,"PSUTMP",PSURXN)=N
- SET N=N+1
- +8 FOR
- SET PSUUDN1=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUUDSSN",PSUUDN1))
- IF PSUUDN1=""
- QUIT
- Begin DoDot:2
- +9 IF '$DATA(^XTMP("PSU_"_PSUJOB,"PSUTMP",PSUUDN1))
- SET ^XTMP("PSU_"_PSUJOB,"PSUTMP",PSUUDN1)=N
- SET N=N+1
- End DoDot:2
- End DoDot:1
- +10 ;
- +11 SET ^XTMP("PSU_"_PSUJOB,"PSUTOTAL")=N-1
- +12 DO TAB2
- +13 SET $PIECE(^XTMP("PSU_"_PSUJOB,"PSUSUMA",I),"-",70)=""
- SET I=I+1
- +14 QUIT
- +15 ;
- TAB2 ;Tab spacing for line 7. Set line into global
- +1 ;
- +2 SET PSUTB3=" "
- +3 SET PSUTB4="TOTAL Pharmacy patients across all divisions:"
- +4 SET PSUTB5=(64-$LENGTH(PSUTB4))-$LENGTH($PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSUTOTAL")),U,1))
- +5 FOR S3=1:1:(PSUTB5-1)
- SET PSUTB(S3)=" "
- Begin DoDot:1
- +6 SET PSUTB3=PSUTB3_PSUTB(S3)
- End DoDot:1
- +7 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=PSUTB4_PSUTB3_$PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSUTOTAL")),U,1)
- +8 SET I=I+1
- +9 QUIT
- +10 ;
- UNIQUE1 ;Find total unique pharmacy patients across all divisions when
- +1 ;IV and RX extracts are run together
- +2 ;
- +3 SET PSURXN=0
- SET PSUIVN=0
- +4 ;
- +5 SET N=1
- +6 ;
- +7 FOR
- SET PSURXN=$ORDER(^XTMP("PSU_"_PSUJOB,"PSURXSSN",PSURXN))
- IF PSURXN=""
- QUIT
- Begin DoDot:1
- +8 SET ^XTMP("PSU_"_PSUJOB,"PSUTMP",PSURXN)=N
- SET N=N+1
- +9 FOR
- SET PSUIVN=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUIVSSN",PSUIVN))
- IF PSUIVN=""
- QUIT
- Begin DoDot:2
- +10 IF '$DATA(^XTMP("PSU_"_PSUJOB,"PSUTMP",PSUIVN))
- SET ^XTMP("PSU_"_PSUJOB,"PSUTMP",PSUIVN)=N
- SET N=N+1
- End DoDot:2
- End DoDot:1
- +11 ;
- +12 SET ^XTMP("PSU_"_PSUJOB,"PSUTOTAL")=N-1
- +13 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)="TOTAL Pharmacy patients across all divisions: "_$PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSUTOTAL")),U,1)
- SET I=I+1
- +14 SET $PIECE(^XTMP("PSU_"_PSUJOB,"PSUSUMA",I),"-",70)=""
- SET I=I+1
- +15 QUIT
- +16 ;
- TUDIV ;Calculate total inpatient count and tab spacing for 'Total
- +1 ;INPATIENT (UD or IV)' line and set into message global
- +2 ;
- +3 NEW PSUTB3,PSUTB4,PSUTB5,PSUDT
- +4 ;
- +5 IF '$DATA(PSUMOD(1))
- Begin DoDot:1
- +6 SET PSUDT=$PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSUUDSSN")),U)
- Begin DoDot:2
- +7 ;Total UD inpatient count
- SET ^XTMP("PSU_"_PSUJOB,"PSUUDIVTOT")=PSUDT
- End DoDot:2
- End DoDot:1
- +8 ;
- +9 IF '$DATA(PSUMOD(2))
- Begin DoDot:1
- +10 ;Total IV inpatient count
- SET ^XTMP("PSU_"_PSUJOB,"PSUUDIVTOT")=$PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSUIVIN")),U,1)-1
- End DoDot:1
- +11 ;
- +12 IF '$GET(^XTMP("PSU_"_PSUJOB,"PSUUDIVTOT"))
- SET ^XTMP("PSU_"_PSUJOB,"PSUUDIVTOT")=0
- +13 SET PSUTB3=" "
- +14 SET PSUTB4=" Total INPATIENT (UD or IV):"
- +15 SET PSUTB5=(64-$LENGTH(PSUTB4))-$LENGTH($PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSUUDIVTOT")),U,1))
- +16 FOR S3=1:1:(PSUTB5-1)
- SET PSUTB(S3)=" "
- Begin DoDot:1
- +17 ;Tab position
- SET PSUTB3=PSUTB3_PSUTB(S3)
- End DoDot:1
- +18 ;
- +19 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=PSUTB4_PSUTB3_$PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSUUDIVTOT")),U,1)
- SET I=I+1
- +20 SET $PIECE(^XTMP("PSU_"_PSUJOB,"PSUSUMA",I),"-",70)=""
- SET I=I+1
- +21 QUIT
- +22 ;
- IPDIV1 ;Find UD inpatient division totals
- +1 ;
- +2 SET PSULBL=0
- +3 NEW PSUTTL
- +4 ;
- +5 ;UD inpatients
- IF $DATA(PSUMOD(2))
- Begin DoDot:1
- +6 FOR
- SET PSULBL=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUUDDIV",PSULBL))
- IF PSULBL=""
- QUIT
- Begin DoDot:2
- +7 SET PSUTTL=$PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSUUDDIV",PSULBL)),U,1)
- +8 DO TAB1^PSUSUM6
- +9 DO IPMSG
- End DoDot:2
- End DoDot:1
- +10 QUIT
- +11 ;
- IPMSG ;Set UD inpatient division totals into message global
- +1 ;
- +2 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=" "_PSULBL_" Division:"_PSUTB1_PSUTTL
- +3 SET I=I+1
- +4 QUIT
- +5 ;
- IPDIV2 ;Calculate inpatient totals for IV divisions
- +1 ;
- +2 ;
- +3 ;Construct a storage global containing unique IV inpatients
- +4 ;per division
- +5 SET PSUDV=0
- +6 FOR
- SET PSUDV=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUDIV1",PSUDV))
- IF PSUDV=""
- QUIT
- Begin DoDot:1
- +7 SET PSUPT=0
- +8 FOR
- SET PSUPT=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUDIV1",PSUDV,PSUPT))
- IF PSUPT=""
- QUIT
- Begin DoDot:2
- +9 SET PSUPT1=0
- +10 FOR
- SET PSUPT1=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUIN1",PSUPT1))
- IF PSUPT1=""
- QUIT
- Begin DoDot:3
- +11 IF PSUPT1=PSUPT
- SET ^XTMP("PSU_"_PSUJOB,"PSUDIV",PSUDV,PSUPT1)=""
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +12 DO IPDIV3
- +13 QUIT
- +14 ;
- IPDIV3 ;Find unique inpatient count for each division
- +1 SET PSUCT1=0
- SET PSUCT2=0
- SET T=1
- +2 ;
- +3 FOR
- SET PSUCT1=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUDIV",PSUCT1))
- IF PSUCT1=""
- QUIT
- Begin DoDot:1
- +4 FOR
- SET PSUCT2=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUDIV",PSUCT1,PSUCT2))
- IF PSUCT2=""
- QUIT
- Begin DoDot:2
- +5 ;Total count
- SET ^XTMP("PSU_"_PSUJOB,"PSUTOTAL1")=T
- SET T=T+1
- +6 IF $DATA(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUCT1))
- Begin DoDot:3
- +7 SET C=C+1
- +8 SET ^XTMP("PSU_"_PSUJOB,"PSUCT",PSUCT1)=C
- End DoDot:3
- +9 IF '$DATA(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUCT1))
- Begin DoDot:3
- +10 SET C=1
- +11 SET ^XTMP("PSU_"_PSUJOB,"PSUCT",PSUCT1)=C
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +12 DO DIVNUM
- +13 DO MSG
- +14 QUIT
- +15 ;
- DIVNUM ;Set number of inpatients per division into summary message
- +1 ;
- +2 NEW PSUTB1,PSUTB2
- +3 SET N=1
- +4 ;
- +5 NEW PSUCT2
- +6 SET PSUDIVA1=0
- +7 FOR
- SET PSUDIVA1=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUDIVA1))
- IF PSUDIVA1=""
- QUIT
- Begin DoDot:1
- +8 SET PSUCT2=$PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUDIVA1)),U,1)
- +9 DO TAB5
- +10 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=" "_PSUDIVA1_" Division:"_PSUTB1_PSUCT2
- +11 SET I=I+1
- End DoDot:1
- +12 QUIT
- +13 ;
- TAB5 ;Calculate tab spacing
- +1 ;
- +2 SET PSUTB1=" "
- +3 SET PSUTB2=(59-$LENGTH(PSUCT2))-$LENGTH(PSUDIVA1)-10
- +4 FOR S2=1:1:(PSUTB2-1)
- SET PSUTB(S2)=" "
- Begin DoDot:1
- +5 ;Tab position
- SET PSUTB1=PSUTB1_PSUTB(S2)
- End DoDot:1
- +6 QUIT
- +7 ;
- TAB4 ;Calculate UD totals of all divisions and place in summary
- +1 ;message
- +2 ;
- +3 SET N=0
- SET PSUMKER=0
- SET R=1
- +4 ;
- +5 IF $DATA(PSUMOD(2))
- Begin DoDot:1
- +6 FOR
- SET PSUMKER=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUUDDIV",PSUMKER))
- IF PSUMKER=""
- QUIT
- Begin DoDot:2
- +7 SET N=$PIECE(^XTMP("PSU_"_PSUJOB,"PSUUDDIV",PSUMKER),U)+N
- +8 ;Sum of all UD inpatients
- SET ^XTMP("PSU_"_PSUJOB,"PSUTOTAL1")=N
- End DoDot:2
- End DoDot:1
- +9 ;
- +10 DO MSG
- +11 QUIT
- +12 ;
- MSG ;Final lines of message
- +1 ;
- +2 IF '$DATA(^XTMP("PSU_"_PSUJOB,"PSUTOTAL1"))
- SET ^XTMP("PSU_"_PSUJOB,"PSUTOTAL1")=0
- +3 ;
- +4 NEW PSUTB3,PSUTB4,PSUTB5
- +5 ;
- +6 SET PSUTB3=" "
- +7 SET PSUTB4=" Inpatient Total of all Divisions:"
- +8 SET PSUTB5=(64-$LENGTH(PSUTB4))-$LENGTH($PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSUTOTAL1")),U,1))
- +9 FOR S3=1:1:(PSUTB5-1)
- SET PSUTB(S3)=" "
- Begin DoDot:1
- +10 ;Tab position
- SET PSUTB3=PSUTB3_PSUTB(S3)
- End DoDot:1
- +11 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=" ----------"
- SET I=I+1
- +12 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=PSUTB4_PSUTB3_$PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSUTOTAL1")),U,1)
- SET I=I+1
- +13 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=""
- SET I=I+1
- +14 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)="**PLEASE NOTE: Final TOTAL may not match sum of all SUBTOTALS. A patient may"
- SET I=I+1
- +15 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)="have been provided pharmacy services at more than one outpatient and/or"
- SET I=I+1
- +16 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)="inpatient division."
- +17 QUIT
- +18 ;
- 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