- PSUSUM3 ;BIR/DAM - Patient Demographics Summary for UD Extract ; 20 DEC 2001
- ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
- ;
- ;DBIA's
- ; Reference to file #55 supported by DBIA 3502
- ; Reference to file #42 supported by DBIA 1848
- ; Reference to file #40.8 supported by DBIA 1576
- ;
- EN ;EN CALLED FROM PSUUD0
- ;Q:$D(^XTMP("PSU_"_PSUJOB,"PSUMFLAG")) ;Do not run if auto extract
- ;
- D PULL^PSUCP
- F I=1:1:$L(PSUOPTS,",") S PSUMOD($P(PSUOPTS,",",I))=""
- ;
- I $D(^XTMP("PSU_"_PSUJOB,"PSUNONE","UD")) D Q ;report if there is no data
- .I $D(PSUMOD(2))&'$D(PSUMOD(1)) D
- ..I '$D(PSUMOD(4)) D
- ...D NODATA D
- ....I $D(^XTMP("PSU_"_PSUJOB,"PSUFLAG1")) K ^XTMP("PSU_"_PSUJOB,"PSUNONE")
- ....K ^XTMP("PSU_"_PSUJOB,"PSUSUMA")
- D EN1
- Q
- ;
- EN1 ;Entry point to collect data
- D DATE
- M ^XTMP("PSU_"_PSUJOB,"PSUUD")=^XTMP(PSUUDSUB)
- D RE
- D UNIQUE
- S I=9 ;Line counter for division data in summary report
- D DIVNUM
- D TOTAL
- D TAB1
- ;
- I $D(PSUMOD(1))&$D(PSUMOD(2)) D
- .I $D(PSUMOD(4)) D
- ..M ^XTMP("PSU_"_PSUJOB,"PSUUDDIV")=^XTMP("PSU_"_PSUJOB,"PSUCT")
- ..M ^XTMP("PSU_"_PSUJOB,"PSUUDSSN")=^XTMP("PSU_"_PSUJOB,"PSUIPT")
- ..M ^XTMP("PSU_"_PSUJOB,"PSUDIVUD")=^XTMP("PSU_"_PSUJOB,"PSUDIV")
- ;
- I '$D(PSUMOD(1))&$D(PSUMOD(2)) D
- .I $D(PSUMOD(4)) D
- ..M ^XTMP("PSU_"_PSUJOB,"PSUUDDIV")=^XTMP("PSU_"_PSUJOB,"PSUCT")
- ..M ^XTMP("PSU_"_PSUJOB,"PSUUDSSN")=^XTMP("PSU_"_PSUJOB,"PSUIPT")
- ;
- I $D(PSUMOD(1))&$D(PSUMOD(2)) D
- .I '$D(PSUMOD(4)) D
- ..M ^XTMP("PSU_"_PSUJOB,"PSUUDDIV")=^XTMP("PSU_"_PSUJOB,"PSUCT")
- ..M ^XTMP("PSU_"_PSUJOB,"PSUUDIN")=^XTMP("PSU_"_PSUJOB,"PSUIPT")
- ..M ^XTMP("PSU_"_PSUJOB,"PSUDIVUD")=^XTMP("PSU_"_PSUJOB,"PSUDIV")
- ;
- I '$D(PSUMOD(1))&'$D(PSUMOD(4)) D
- .D PDSUM^PSUDEM5 ;Mail message
- .K ^XTMP("PSU_"_PSUJOB,"PSUUDDIV")
- K ^XTMP("PSU_"_PSUJOB,"PSUUD")
- I $D(^XTMP("PSU_"_PSUJOB,"PSUFLAG1")) K ^XTMP("PSU_"_PSUJOB,"PSUSUMA")
- K ^XTMP("PSU_"_PSUJOB,"PSUFLAG1")
- ;K ^XTMP("PSU_"_PSUJOB,"PSUTOTAL")
- K ^XTMP("PSU_"_PSUJOB,"PSUCT")
- K ^XTMP("PSU_"_PSUJOB,"PSURXCTA")
- Q
- ;
- RE ;Rearrange the ^XTMP("PSU_"_PSUJOB,"PSUUD","DETAIL" global so information in PATDIV
- ;can be accessed quickly.
- ;
- N PSUSIT
- S PSUSIT=PSUSNDR
- ;D INST^PSUDEM1 S PSUSIT=$P(^XTMP("PSU_"_PSUJOB,"PSUSITE"),U,1)
- ;
- N PSUSSNA,PSUUDA
- S PSUPN1=0,PSUSIT1=0
- F S PSUSIT1=$O(^XTMP("PSU_"_PSUJOB,"PSUUD","DETAIL",PSUSIT1)) Q:PSUSIT1="" D
- .F S PSUPN1=$O(^XTMP("PSU_"_PSUJOB,"PSUUD","DETAIL",PSUSIT1,PSUPN1)) Q:PSUPN1="" D
- ..S PSUUDA=$P($G(^XTMP("PSU_"_PSUJOB,"PSUUD","DETAIL",PSUSIT1,PSUPN1)),U,4)
- ..S PSUSSNA=$P($G(^XTMP("PSU_"_PSUJOB,"PSUUD","DETAIL",PSUSIT1,PSUPN1)),U,5) D
- ...S PSUDFN=0
- ...F S PSUDFN=$O(^XTMP("PSU_"_PSUJOB,"PSUTDFN",PSUDFN)) Q:PSUDFN="" D
- ....S PSUSN=0
- ....F S PSUSN=$O(^XTMP("PSU_"_PSUJOB,"PSUTDFN",PSUDFN,PSUSN)) Q:PSUSN="" D
- .....I PSUSN=PSUSSNA S ^XTMP("PSU_"_PSUJOB,"PSUORSN1",PSUDFN,PSUUDA)=PSUSN
- .....;S ^XTMP("PSU_"_PSUJOB,"PSUORSN",PSUUDA)=PSUSSNA
- Q
- ;
- DATE ;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 ;Start date of extract
- D DD^%DT
- N PSUS S PSUS=Y
- ;
- S Y=PSUEDT ;End date of extract
- D DD^%DT
- N PSUE S PSUE=Y
- ;
- D UDSUM
- Q
- ;
- UDSUM ;Summary report header to be run if UD (Inpatient) extract is run
- ;
- ;Report header
- S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",1)="PHARMACY INPATIENT (UD) 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 number of unique patients across all divisions
- ;
- S PSUUDS=0
- N PSUUDS3
- F S PSUUDS=$O(^XTMP("PSU_"_PSUJOB,"PSUORSN1",PSUUDS)) Q:PSUUDS="" D
- .S PSUUDS1=0
- .S PSUUDS1=$O(^XTMP("PSU_"_PSUJOB,"PSUORSN1",PSUUDS,PSUUDS1)) Q:PSUUDS1="" D
- ..S PSUUDS3=$P($G(^XTMP("PSU_"_PSUJOB,"PSUORSN1",PSUUDS,PSUUDS1)),U,1)
- ..S ^XTMP("PSU_"_PSUJOB,"PSUIPT",PSUUDS3)="" ;Set up global for unique SSNs
- .;S PSUUDS1=$P(^XTMP("PSU_"_PSUJOB,"PSUORSN",PSUUDS),U)
- .;S ^XTMP("PSU_"_PSUJOB,"PSUIPT",PSUUDS1)="" ;Set up global for unique SSNs
- ;
- S B=1
- S PSUUDS2=0
- F S PSUUDS2=$O(^XTMP("PSU_"_PSUJOB,"PSUIPT",PSUUDS2)) Q:PSUUDS2="" D
- .S ^XTMP("PSU_"_PSUJOB,"PSUIPT")=B,B=B+1 ;B=total count unique patients
- .D TAB2
- S $P(^XTMP("PSU_"_PSUJOB,"PSUSUMA",8),"-",70)=""
- Q
- ;
- TAB2 ;Tab spacing for line 7. Set line into global
- ;
- N PSUTB3,PSUTB4,PSUTB5
- ;
- S PSUTB3=" "
- S PSUTB4="TOTAL patients across all divisions:"
- S PSUTB5=(64-$L(PSUTB4))-$L($P($G(^XTMP("PSU_"_PSUJOB,"PSUIPT")),U,1))
- F S3=1:1:(PSUTB5-1) S PSUTB(S3)=" " D
- .S PSUTB3=PSUTB3_PSUTB(S3)
- S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",7)=PSUTB4_PSUTB3_$P($G(^XTMP("PSU_"_PSUJOB,"PSUIPT")),U,1)
- Q
- ;
- DIVNUM ;Set number of patients per division into summary message
- ;
- N PSUTB1,PSUTB2
- ;
- N PSUCT3
- S PSUDIVA2=0
- F S PSUDIVA2=$O(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUDIVA2)) Q:PSUDIVA2="" D
- .S PSUCT3=$P($G(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUDIVA2)),U,1)
- .D TAB
- .S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=" "_PSUDIVA2_" Division:"_PSUTB1_PSUCT3
- .S I=I+1
- Q
- ;
- TAB ;Calculate tab spacing
- ;
- S PSUTB1=" "
- S PSUTB2=(59-$L(PSUCT3))-$L(PSUDIVA2)-10
- F S2=1:1:(PSUTB2-1) S PSUTB(S2)=" " D
- .S PSUTB1=PSUTB1_PSUTB(S2) ;Tab position
- Q
- ;
- TOTAL ;EN Calculate Inpatient total of all divisions
- ;
- N PSUIPCT
- S PSUIPTOT=0
- S PSUTOCT1=0
- F S PSUIPTOT=$O(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUIPTOT)) Q:PSUIPTOT="" D
- .S PSUIPCT=$P($G(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUIPTOT)),U,1)
- .S PSUTOCT1=PSUTOCT1+PSUIPCT
- S $P(^XTMP("PSU_"_PSUJOB,"PSUTOTAL"),U,1)=PSUTOCT1
- Q
- ;
- TAB1 ;EN Calculate tab spacing for 'Outpatient Total of all Divisions' line.
- ;and set the last lines of message into the summary global.
- ;
- N PSUTB3,PSUTB4,PSUTB5
- ;
- I '$G(^XTMP("PSU_"_PSUJOB,"PSUTOTAL")) D
- .S ^XTMP("PSU_"_PSUJOB,"PSUTOTAL")=0
- S PSUTB3=" "
- S PSUTB4=" Inpatient Total of 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) ;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,"PSUTOTAL")),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 INPATIENT (UD) UNIQUE PATIENTS REPORT"
- S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",2)=" "
- S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",3)="No data to report"
- D PDSUM^PSUDEM5
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSUSUM3 7280 printed Feb 18, 2025@23:54:32 Page 2
- PSUSUM3 ;BIR/DAM - Patient Demographics Summary for UD Extract ; 20 DEC 2001
- +1 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
- +2 ;
- +3 ;DBIA's
- +4 ; Reference to file #55 supported by DBIA 3502
- +5 ; Reference to file #42 supported by DBIA 1848
- +6 ; Reference to file #40.8 supported by DBIA 1576
- +7 ;
- EN ;EN CALLED FROM PSUUD0
- +1 ;Q:$D(^XTMP("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 ;report if there is no data
- IF $DATA(^XTMP("PSU_"_PSUJOB,"PSUNONE","UD"))
- Begin DoDot:1
- +7 IF $DATA(PSUMOD(2))&'$DATA(PSUMOD(1))
- Begin DoDot:2
- +8 IF '$DATA(PSUMOD(4))
- Begin DoDot:3
- +9 DO NODATA
- Begin DoDot:4
- +10 IF $DATA(^XTMP("PSU_"_PSUJOB,"PSUFLAG1"))
- KILL ^XTMP("PSU_"_PSUJOB,"PSUNONE")
- +11 KILL ^XTMP("PSU_"_PSUJOB,"PSUSUMA")
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- QUIT
- +12 DO EN1
- +13 QUIT
- +14 ;
- EN1 ;Entry point to collect data
- +1 DO DATE
- +2 MERGE ^XTMP("PSU_"_PSUJOB,"PSUUD")=^XTMP(PSUUDSUB)
- +3 DO RE
- +4 DO UNIQUE
- +5 ;Line counter for division data in summary report
- SET I=9
- +6 DO DIVNUM
- +7 DO TOTAL
- +8 DO TAB1
- +9 ;
- +10 IF $DATA(PSUMOD(1))&$DATA(PSUMOD(2))
- Begin DoDot:1
- +11 IF $DATA(PSUMOD(4))
- Begin DoDot:2
- +12 MERGE ^XTMP("PSU_"_PSUJOB,"PSUUDDIV")=^XTMP("PSU_"_PSUJOB,"PSUCT")
- +13 MERGE ^XTMP("PSU_"_PSUJOB,"PSUUDSSN")=^XTMP("PSU_"_PSUJOB,"PSUIPT")
- +14 MERGE ^XTMP("PSU_"_PSUJOB,"PSUDIVUD")=^XTMP("PSU_"_PSUJOB,"PSUDIV")
- End DoDot:2
- End DoDot:1
- +15 ;
- +16 IF '$DATA(PSUMOD(1))&$DATA(PSUMOD(2))
- Begin DoDot:1
- +17 IF $DATA(PSUMOD(4))
- Begin DoDot:2
- +18 MERGE ^XTMP("PSU_"_PSUJOB,"PSUUDDIV")=^XTMP("PSU_"_PSUJOB,"PSUCT")
- +19 MERGE ^XTMP("PSU_"_PSUJOB,"PSUUDSSN")=^XTMP("PSU_"_PSUJOB,"PSUIPT")
- End DoDot:2
- End DoDot:1
- +20 ;
- +21 IF $DATA(PSUMOD(1))&$DATA(PSUMOD(2))
- Begin DoDot:1
- +22 IF '$DATA(PSUMOD(4))
- Begin DoDot:2
- +23 MERGE ^XTMP("PSU_"_PSUJOB,"PSUUDDIV")=^XTMP("PSU_"_PSUJOB,"PSUCT")
- +24 MERGE ^XTMP("PSU_"_PSUJOB,"PSUUDIN")=^XTMP("PSU_"_PSUJOB,"PSUIPT")
- +25 MERGE ^XTMP("PSU_"_PSUJOB,"PSUDIVUD")=^XTMP("PSU_"_PSUJOB,"PSUDIV")
- End DoDot:2
- End DoDot:1
- +26 ;
- +27 IF '$DATA(PSUMOD(1))&'$DATA(PSUMOD(4))
- Begin DoDot:1
- +28 ;Mail message
- DO PDSUM^PSUDEM5
- +29 KILL ^XTMP("PSU_"_PSUJOB,"PSUUDDIV")
- End DoDot:1
- +30 KILL ^XTMP("PSU_"_PSUJOB,"PSUUD")
- +31 IF $DATA(^XTMP("PSU_"_PSUJOB,"PSUFLAG1"))
- KILL ^XTMP("PSU_"_PSUJOB,"PSUSUMA")
- +32 KILL ^XTMP("PSU_"_PSUJOB,"PSUFLAG1")
- +33 ;K ^XTMP("PSU_"_PSUJOB,"PSUTOTAL")
- +34 KILL ^XTMP("PSU_"_PSUJOB,"PSUCT")
- +35 KILL ^XTMP("PSU_"_PSUJOB,"PSURXCTA")
- +36 QUIT
- +37 ;
- RE ;Rearrange the ^XTMP("PSU_"_PSUJOB,"PSUUD","DETAIL" global so information in PATDIV
- +1 ;can be accessed quickly.
- +2 ;
- +3 NEW PSUSIT
- +4 SET PSUSIT=PSUSNDR
- +5 ;D INST^PSUDEM1 S PSUSIT=$P(^XTMP("PSU_"_PSUJOB,"PSUSITE"),U,1)
- +6 ;
- +7 NEW PSUSSNA,PSUUDA
- +8 SET PSUPN1=0
- SET PSUSIT1=0
- +9 FOR
- SET PSUSIT1=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUUD","DETAIL",PSUSIT1))
- if PSUSIT1=""
- QUIT
- Begin DoDot:1
- +10 FOR
- SET PSUPN1=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUUD","DETAIL",PSUSIT1,PSUPN1))
- if PSUPN1=""
- QUIT
- Begin DoDot:2
- +11 SET PSUUDA=$PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSUUD","DETAIL",PSUSIT1,PSUPN1)),U,4)
- +12 SET PSUSSNA=$PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSUUD","DETAIL",PSUSIT1,PSUPN1)),U,5)
- Begin DoDot:3
- +13 SET PSUDFN=0
- +14 FOR
- SET PSUDFN=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUTDFN",PSUDFN))
- if PSUDFN=""
- QUIT
- Begin DoDot:4
- +15 SET PSUSN=0
- +16 FOR
- SET PSUSN=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUTDFN",PSUDFN,PSUSN))
- if PSUSN=""
- QUIT
- Begin DoDot:5
- +17 IF PSUSN=PSUSSNA
- SET ^XTMP("PSU_"_PSUJOB,"PSUORSN1",PSUDFN,PSUUDA)=PSUSN
- +18 ;S ^XTMP("PSU_"_PSUJOB,"PSUORSN",PSUUDA)=PSUSSNA
- End DoDot:5
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +19 QUIT
- +20 ;
- DATE ;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 ;Start date of extract
- SET Y=PSUSDT
- +7 DO DD^%DT
- +8 NEW PSUS
- SET PSUS=Y
- +9 ;
- +10 ;End date of extract
- SET Y=PSUEDT
- +11 DO DD^%DT
- +12 NEW PSUE
- SET PSUE=Y
- +13 ;
- +14 DO UDSUM
- +15 QUIT
- +16 ;
- UDSUM ;Summary report header to be run if UD (Inpatient) extract is run
- +1 ;
- +2 ;Report header
- +3 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",1)="PHARMACY INPATIENT (UD) 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 number of unique patients across all divisions
- +1 ;
- +2 SET PSUUDS=0
- +3 NEW PSUUDS3
- +4 FOR
- SET PSUUDS=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUORSN1",PSUUDS))
- if PSUUDS=""
- QUIT
- Begin DoDot:1
- +5 SET PSUUDS1=0
- +6 SET PSUUDS1=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUORSN1",PSUUDS,PSUUDS1))
- if PSUUDS1=""
- QUIT
- Begin DoDot:2
- +7 SET PSUUDS3=$PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSUORSN1",PSUUDS,PSUUDS1)),U,1)
- +8 ;Set up global for unique SSNs
- SET ^XTMP("PSU_"_PSUJOB,"PSUIPT",PSUUDS3)=""
- End DoDot:2
- +9 ;S PSUUDS1=$P(^XTMP("PSU_"_PSUJOB,"PSUORSN",PSUUDS),U)
- +10 ;S ^XTMP("PSU_"_PSUJOB,"PSUIPT",PSUUDS1)="" ;Set up global for unique SSNs
- End DoDot:1
- +11 ;
- +12 SET B=1
- +13 SET PSUUDS2=0
- +14 FOR
- SET PSUUDS2=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUIPT",PSUUDS2))
- if PSUUDS2=""
- QUIT
- Begin DoDot:1
- +15 ;B=total count unique patients
- SET ^XTMP("PSU_"_PSUJOB,"PSUIPT")=B
- SET B=B+1
- +16 DO TAB2
- End DoDot:1
- +17 SET $PIECE(^XTMP("PSU_"_PSUJOB,"PSUSUMA",8),"-",70)=""
- +18 QUIT
- +19 ;
- TAB2 ;Tab spacing for line 7. Set line into global
- +1 ;
- +2 NEW PSUTB3,PSUTB4,PSUTB5
- +3 ;
- +4 SET PSUTB3=" "
- +5 SET PSUTB4="TOTAL patients across all divisions:"
- +6 SET PSUTB5=(64-$LENGTH(PSUTB4))-$LENGTH($PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSUIPT")),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 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",7)=PSUTB4_PSUTB3_$PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSUIPT")),U,1)
- +10 QUIT
- +11 ;
- DIVNUM ;Set number of patients per division into summary message
- +1 ;
- +2 NEW PSUTB1,PSUTB2
- +3 ;
- +4 NEW PSUCT3
- +5 SET PSUDIVA2=0
- +6 FOR
- SET PSUDIVA2=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUDIVA2))
- if PSUDIVA2=""
- QUIT
- Begin DoDot:1
- +7 SET PSUCT3=$PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUDIVA2)),U,1)
- +8 DO TAB
- +9 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=" "_PSUDIVA2_" Division:"_PSUTB1_PSUCT3
- +10 SET I=I+1
- End DoDot:1
- +11 QUIT
- +12 ;
- TAB ;Calculate tab spacing
- +1 ;
- +2 SET PSUTB1=" "
- +3 SET PSUTB2=(59-$LENGTH(PSUCT3))-$LENGTH(PSUDIVA2)-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 ;
- TOTAL ;EN Calculate Inpatient total of all divisions
- +1 ;
- +2 NEW PSUIPCT
- +3 SET PSUIPTOT=0
- +4 SET PSUTOCT1=0
- +5 FOR
- SET PSUIPTOT=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUIPTOT))
- if PSUIPTOT=""
- QUIT
- Begin DoDot:1
- +6 SET PSUIPCT=$PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUIPTOT)),U,1)
- +7 SET PSUTOCT1=PSUTOCT1+PSUIPCT
- End DoDot:1
- +8 SET $PIECE(^XTMP("PSU_"_PSUJOB,"PSUTOTAL"),U,1)=PSUTOCT1
- +9 QUIT
- +10 ;
- TAB1 ;EN Calculate tab spacing for 'Outpatient Total of all Divisions' line.
- +1 ;and set the last lines of message into the summary global.
- +2 ;
- +3 NEW PSUTB3,PSUTB4,PSUTB5
- +4 ;
- +5 IF '$GET(^XTMP("PSU_"_PSUJOB,"PSUTOTAL"))
- Begin DoDot:1
- +6 SET ^XTMP("PSU_"_PSUJOB,"PSUTOTAL")=0
- End DoDot:1
- +7 SET PSUTB3=" "
- +8 SET PSUTB4=" Inpatient Total of all Divisions:"
- +9 SET PSUTB5=(64-$LENGTH(PSUTB4))-$LENGTH($PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSUTOTAL")),U,1))
- +10 FOR S3=1:1:(PSUTB5-1)
- SET PSUTB(S3)=" "
- Begin DoDot:1
- +11 ;Tab position
- SET PSUTB3=PSUTB3_PSUTB(S3)
- End DoDot:1
- +12 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=" ----------"
- SET I=I+1
- +13 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=PSUTB4_PSUTB3_$PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSUTOTAL")),U,1)
- SET I=I+1
- +14 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=""
- SET I=I+1
- +15 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)="**PLEASE NOTE: Final TOTAL may not match sum of all SUBTOTALS. A patient may"
- SET I=I+1
- +16 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)="have been provided pharmacy services at more than one outpatient and/or"
- SET I=I+1
- +17 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)="inpatient division."
- +18 QUIT
- +19 ;
- NODATA ;Summary report line to be sent if there is no data
- +1 ;
- +2 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",1)="PHARMACY INPATIENT (UD) 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