- PSUSUM2 ;BIR/DAM - Patient Demographics Summary for OP Extract ; 20 DEC 2001
- ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
- ;
- ;DBIA'S
- ; Reference to File #59 supported by DBIA 1876
- ;
- EN ;EN CALLED FROM PSUOP0
- ;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","RX")) D Q ;Summary report if there is no data
- .I '$D(PSUMOD(1))&'$D(PSUMOD(2)) D
- ..D NODATA
- ..I $D(^XTMP("PSU_"_PSUJOB,"PSUFLAG1"))!$D(^XTMP("PSU_"_PSUJOB,"PSUFLAG2")) K ^XTMP("PSU_"_PSUJOB,"PSUNONE")
- ;
- D DATE
- D DIVNUM
- D TOTAL
- S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=" ---------" S I=I+1
- S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)="" S I=I+1
- D TAB1
- I $D(PSUMOD(1))!$D(PSUMOD(2)) D
- .M ^XTMP("PSU_"_PSUJOB,"PSURXCTA")=^XTMP("PSU_"_PSUJOB,"PSUCT")
- .M ^XTMP("PSU_"_PSUJOB,"PSURXTOTAL")=^XTMP("PSU_"_PSUJOB,"PSUTOTAL")
- .S ^XTMP("PSU_"_PSUJOB,"PSURXUNIQUE")=M-1
- .M ^XTMP("PSU_"_PSUJOB,"PSURXSSN")=^XTMP("PSU_"_PSUJOB,"PSUSSN")
- ;
- I '$D(PSUMOD(1))&'$D(PSUMOD(2)) D
- .D PDSUM^PSUDEM5 ;Mail message
- K ^XTMP("PSU_"_PSUJOB,"PSUTOTAL")
- K ^XTMP("PSU_"_PSUJOB,"PSUSSN")
- K ^XTMP("PSU_"_PSUJOB,"PSUCT")
- K ^XTMP("PSU_"_PSUJOB,"PSUDIV")
- K ^XTMP("PSU_"_PSUJOB,"PSURX")
- I $D(^XTMP("PSU_"_PSUJOB,"PSUFLAG1")) K ^XTMP("PSU_"_PSUJOB,"PSUSUMA")
- K ^XTMP("PSU_"_PSUJOB,"PSUFLAG1")
- 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 RXSUM
- Q
- ;
- RXSUM ;Summary report to be run if Rx (Outpatient) extract is run
- ;
- D UNIQUE
- ;Report header
- S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",1)="PHARMACY OUTPATIENT 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)=""
- D TAB2
- S $P(^XTMP("PSU_"_PSUJOB,"PSUSUMA",8),"-",70)=""
- S I=9
- ;
- 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=(67-$L(PSUTB4))-$L($P(^XTMP("PSU_"_PSUJOB,"PSUUNIQUE"),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(^XTMP("PSU_"_PSUJOB,"PSUUNIQUE"),U,1)
- Q
- ;
- UNIQUE ;Find UNIQUE patients across all divisions
- ;
- N PSUSIT,PSUTOTAL,PSUSOC1,PSUNIQUE,PSURX2,PSURX5
- M ^XTMP("PSU_"_PSUJOB,"PSURX")=^XTMP(PSUOPSUB)
- ;
- S M=0
- S N=1
- S PSUSIT=0
- S PSURX1=0
- F S PSUSIT=$O(^XTMP("PSU_"_PSUJOB,"PSURX","RECORDS",PSUSIT)) Q:'PSUSIT D
- .F S PSURX1=$O(^XTMP("PSU_"_PSUJOB,"PSURX","RECORDS",PSUSIT,PSURX1)) Q:'PSURX1 D
- ..I $P($G(^XTMP("PSU_"_PSUJOB,"PSURX","RECORDS",PSUSIT,PSURX1)),U,7)?9.10E D
- ...;S PSUTOTAL=N
- ...S PSUSOC1=$P($G(^XTMP("PSU_"_PSUJOB,"PSURX","RECORDS",PSUSIT,PSURX1)),U,7)
- ...I $G(PSUSOC1) S ^XTMP("PSU_"_PSUJOB,"PSUSSN",PSUSOC1)=""
- ...S N=N+1
- D ELIM
- Q
- ;
- ELIM ;Eliminate duplicate patient entries to get number of unique pts
- ;
- S PSUADM=0
- F S PSUADM=$O(^XTMP("PSU_"_PSUJOB,"PSUSSN",PSUADM)) Q:'PSUADM D
- .S $P(^XTMP("PSU_"_PSUJOB,"PSUUNIQUE"),U,1)=M
- .S M=M+1
- Q
- ;
- DIVNUM ;Set number of patients per division into summary message
- ;
- ;Find patient SSN's in the following global and place with the division
- ;number
- N PSUPTID,PSUPL
- S PSUDNUM=0
- S C=1
- F S PSUDNUM=$O(^XTMP("PSU_"_PSUJOB,"PSUDIVPT",PSUDNUM)) Q:PSUDNUM="" D
- .S PSUPL=0
- .F S PSUPL=$O(^XTMP("PSU_"_PSUJOB,"PSUDIVPT",PSUDNUM,PSUPL)) Q:PSUPL="" D
- ..S PSUPTID=$P(^XTMP("PSU_"_PSUJOB,"PSUDIVPT",PSUDNUM,PSUPL),U,7)
- ..Q:PSUPTID=""
- ..S ^XTMP("PSU_"_PSUJOB,"PSUCT0",PSUDNUM,PSUPTID)=""
- ;
- ;Get patient count for each division
- S PSUDNUM1=0
- F S PSUDNUM1=$O(^XTMP("PSU_"_PSUJOB,"PSUCT0",PSUDNUM1)) Q:PSUDNUM1="" D
- .S PSUID=0
- .F S PSUID=$O(^XTMP("PSU_"_PSUJOB,"PSUCT0",PSUDNUM1,PSUID)) Q:PSUID="" D
- ..I $D(^XTMP("PSU_"_PSUJOB,"PSUCT1",PSUDNUM1)) D
- ...S C=C+1
- ...S ^XTMP("PSU_"_PSUJOB,"PSUCT1",PSUDNUM1)=C
- ..I '$D(^XTMP("PSU_"_PSUJOB,"PSUCT1",PSUDNUM1)) D
- ...S C=1 S ^XTMP("PSU_"_PSUJOB,"PSUCT1",PSUDNUM1)=C
- ;
- ;Get division name
- S PSUDIV=0
- N PSUNBR
- F S PSUDIV=$O(^XTMP("PSU_"_PSUJOB,"PSUCT1",PSUDIV)) Q:PSUDIV="" D
- .S PSUNBR=$P(^XTMP("PSU_"_PSUJOB,"PSUCT1",PSUDIV),U,1)
- .S X=PSUDIV,DIC=59,DIC(0)="XM" D ^DIC ;**1
- .S X=+Y,PSUDIVNM=$$VAL^PSUTL(59,X,.01)
- .I PSUDIVNM'="" S ^XTMP("PSU_"_PSUJOB,"PSUCT",PSUDIVNM)=PSUNBR
- .I PSUDIVNM="" S ^XTMP("PSU_"_PSUJOB,"PSUCT",PSUDIV)=PSUNBR
- ;
- N PSUTB1,PSUTB2
- ;
- N PSUCT2
- S PSUDIVA1=0
- F S PSUDIVA1=$O(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUDIVA1)) Q:PSUDIVA1="" D
- .S PSUCT2=$P(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUDIVA1),U,1)
- .D TAB
- .S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=" "_PSUDIVA1_" Division:"_PSUTB1_PSUCT2
- .S I=I+1
- Q
- ;
- TAB ;Calculate tab spacing
- ;
- S PSUTB1=" "
- S PSUTB2=(62-$L(PSUCT2))-$L(PSUDIVA1)-10
- F S2=1:1:(PSUTB2-1) S PSUTB(S2)=" " D
- .S PSUTB1=PSUTB1_PSUTB(S2) ;Tab position
- Q
- ;
- TOTAL ;Calculate Outpatient Total of all Divisions
- ;
- S PSUOPTOT=0
- S PSUTOCT1=0
- F S PSUOPTOT=$O(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUOPTOT)) Q:PSUOPTOT="" D
- .S PSUTOCT=$P(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUOPTOT),U,1)
- .S PSUTOCT1=PSUTOCT1+PSUTOCT
- S $P(^XTMP("PSU_"_PSUJOB,"PSUTOTAL"),U,1)=PSUTOCT1
- Q
- ;
- TAB1 ;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
- ;
- S PSUTB3=" "
- S PSUTB4=" Outpatient Total of all Divisions:"
- S PSUTB5=(67-$L(PSUTB4))-$L($P(^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)=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 OUTPATIENT 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[HPSUSUM2 6963 printed Feb 18, 2025@23:54:31 Page 2
- PSUSUM2 ;BIR/DAM - Patient Demographics Summary for OP Extract ; 20 DEC 2001
- +1 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
- +2 ;
- +3 ;DBIA'S
- +4 ; Reference to File #59 supported by DBIA 1876
- +5 ;
- EN ;EN CALLED FROM PSUOP0
- +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 ;Summary report if there is no data
- IF $DATA(^XTMP("PSU_"_PSUJOB,"PSUNONE","RX"))
- Begin DoDot:1
- +7 IF '$DATA(PSUMOD(1))&'$DATA(PSUMOD(2))
- Begin DoDot:2
- +8 DO NODATA
- +9 IF $DATA(^XTMP("PSU_"_PSUJOB,"PSUFLAG1"))!$DATA(^XTMP("PSU_"_PSUJOB,"PSUFLAG2"))
- KILL ^XTMP("PSU_"_PSUJOB,"PSUNONE")
- End DoDot:2
- End DoDot:1
- QUIT
- +10 ;
- +11 DO DATE
- +12 DO DIVNUM
- +13 DO TOTAL
- +14 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=" ---------"
- SET I=I+1
- +15 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=""
- SET I=I+1
- +16 DO TAB1
- +17 IF $DATA(PSUMOD(1))!$DATA(PSUMOD(2))
- Begin DoDot:1
- +18 MERGE ^XTMP("PSU_"_PSUJOB,"PSURXCTA")=^XTMP("PSU_"_PSUJOB,"PSUCT")
- +19 MERGE ^XTMP("PSU_"_PSUJOB,"PSURXTOTAL")=^XTMP("PSU_"_PSUJOB,"PSUTOTAL")
- +20 SET ^XTMP("PSU_"_PSUJOB,"PSURXUNIQUE")=M-1
- +21 MERGE ^XTMP("PSU_"_PSUJOB,"PSURXSSN")=^XTMP("PSU_"_PSUJOB,"PSUSSN")
- End DoDot:1
- +22 ;
- +23 IF '$DATA(PSUMOD(1))&'$DATA(PSUMOD(2))
- Begin DoDot:1
- +24 ;Mail message
- DO PDSUM^PSUDEM5
- End DoDot:1
- +25 KILL ^XTMP("PSU_"_PSUJOB,"PSUTOTAL")
- +26 KILL ^XTMP("PSU_"_PSUJOB,"PSUSSN")
- +27 KILL ^XTMP("PSU_"_PSUJOB,"PSUCT")
- +28 KILL ^XTMP("PSU_"_PSUJOB,"PSUDIV")
- +29 KILL ^XTMP("PSU_"_PSUJOB,"PSURX")
- +30 IF $DATA(^XTMP("PSU_"_PSUJOB,"PSUFLAG1"))
- KILL ^XTMP("PSU_"_PSUJOB,"PSUSUMA")
- +31 KILL ^XTMP("PSU_"_PSUJOB,"PSUFLAG1")
- +32 QUIT
- +33 ;
- 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 RXSUM
- +15 QUIT
- +16 ;
- RXSUM ;Summary report to be run if Rx (Outpatient) extract is run
- +1 ;
- +2 DO UNIQUE
- +3 ;Report header
- +4 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",1)="PHARMACY OUTPATIENT UNIQUE PATIENTS REPORT "_PSUD
- +5 ;Separator bar
- SET $PIECE(^XTMP("PSU_"_PSUJOB,"PSUSUMA",2),"-",80)=""
- +6 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",3)=" "_PSUS_" through "_PSUE
- +7 SET $PIECE(^XTMP("PSU_"_PSUJOB,"PSUSUMA",4),"=",80)=""
- +8 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",5)=" UNIQUE"
- +9 SET $PIECE(^XTMP("PSU_"_PSUJOB,"PSUSUMA",6),"-",70)=""
- +10 DO TAB2
- +11 SET $PIECE(^XTMP("PSU_"_PSUJOB,"PSUSUMA",8),"-",70)=""
- +12 SET I=9
- +13 ;
- +14 QUIT
- +15 ;
- 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=(67-$LENGTH(PSUTB4))-$LENGTH($PIECE(^XTMP("PSU_"_PSUJOB,"PSUUNIQUE"),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(^XTMP("PSU_"_PSUJOB,"PSUUNIQUE"),U,1)
- +10 QUIT
- +11 ;
- UNIQUE ;Find UNIQUE patients across all divisions
- +1 ;
- +2 NEW PSUSIT,PSUTOTAL,PSUSOC1,PSUNIQUE,PSURX2,PSURX5
- +3 MERGE ^XTMP("PSU_"_PSUJOB,"PSURX")=^XTMP(PSUOPSUB)
- +4 ;
- +5 SET M=0
- +6 SET N=1
- +7 SET PSUSIT=0
- +8 SET PSURX1=0
- +9 FOR
- SET PSUSIT=$ORDER(^XTMP("PSU_"_PSUJOB,"PSURX","RECORDS",PSUSIT))
- if 'PSUSIT
- QUIT
- Begin DoDot:1
- +10 FOR
- SET PSURX1=$ORDER(^XTMP("PSU_"_PSUJOB,"PSURX","RECORDS",PSUSIT,PSURX1))
- if 'PSURX1
- QUIT
- Begin DoDot:2
- +11 IF $PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSURX","RECORDS",PSUSIT,PSURX1)),U,7)?9.10E
- Begin DoDot:3
- +12 ;S PSUTOTAL=N
- +13 SET PSUSOC1=$PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSURX","RECORDS",PSUSIT,PSURX1)),U,7)
- +14 IF $GET(PSUSOC1)
- SET ^XTMP("PSU_"_PSUJOB,"PSUSSN",PSUSOC1)=""
- +15 SET N=N+1
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +16 DO ELIM
- +17 QUIT
- +18 ;
- ELIM ;Eliminate duplicate patient entries to get number of unique pts
- +1 ;
- +2 SET PSUADM=0
- +3 FOR
- SET PSUADM=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUSSN",PSUADM))
- if 'PSUADM
- QUIT
- Begin DoDot:1
- +4 SET $PIECE(^XTMP("PSU_"_PSUJOB,"PSUUNIQUE"),U,1)=M
- +5 SET M=M+1
- End DoDot:1
- +6 QUIT
- +7 ;
- DIVNUM ;Set number of patients per division into summary message
- +1 ;
- +2 ;Find patient SSN's in the following global and place with the division
- +3 ;number
- +4 NEW PSUPTID,PSUPL
- +5 SET PSUDNUM=0
- +6 SET C=1
- +7 FOR
- SET PSUDNUM=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUDIVPT",PSUDNUM))
- if PSUDNUM=""
- QUIT
- Begin DoDot:1
- +8 SET PSUPL=0
- +9 FOR
- SET PSUPL=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUDIVPT",PSUDNUM,PSUPL))
- if PSUPL=""
- QUIT
- Begin DoDot:2
- +10 SET PSUPTID=$PIECE(^XTMP("PSU_"_PSUJOB,"PSUDIVPT",PSUDNUM,PSUPL),U,7)
- +11 if PSUPTID=""
- QUIT
- +12 SET ^XTMP("PSU_"_PSUJOB,"PSUCT0",PSUDNUM,PSUPTID)=""
- End DoDot:2
- End DoDot:1
- +13 ;
- +14 ;Get patient count for each division
- +15 SET PSUDNUM1=0
- +16 FOR
- SET PSUDNUM1=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUCT0",PSUDNUM1))
- if PSUDNUM1=""
- QUIT
- Begin DoDot:1
- +17 SET PSUID=0
- +18 FOR
- SET PSUID=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUCT0",PSUDNUM1,PSUID))
- if PSUID=""
- QUIT
- Begin DoDot:2
- +19 IF $DATA(^XTMP("PSU_"_PSUJOB,"PSUCT1",PSUDNUM1))
- Begin DoDot:3
- +20 SET C=C+1
- +21 SET ^XTMP("PSU_"_PSUJOB,"PSUCT1",PSUDNUM1)=C
- End DoDot:3
- +22 IF '$DATA(^XTMP("PSU_"_PSUJOB,"PSUCT1",PSUDNUM1))
- Begin DoDot:3
- +23 SET C=1
- SET ^XTMP("PSU_"_PSUJOB,"PSUCT1",PSUDNUM1)=C
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +24 ;
- +25 ;Get division name
- +26 SET PSUDIV=0
- +27 NEW PSUNBR
- +28 FOR
- SET PSUDIV=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUCT1",PSUDIV))
- if PSUDIV=""
- QUIT
- Begin DoDot:1
- +29 SET PSUNBR=$PIECE(^XTMP("PSU_"_PSUJOB,"PSUCT1",PSUDIV),U,1)
- +30 ;**1
- SET X=PSUDIV
- SET DIC=59
- SET DIC(0)="XM"
- DO ^DIC
- +31 SET X=+Y
- SET PSUDIVNM=$$VAL^PSUTL(59,X,.01)
- +32 IF PSUDIVNM'=""
- SET ^XTMP("PSU_"_PSUJOB,"PSUCT",PSUDIVNM)=PSUNBR
- +33 IF PSUDIVNM=""
- SET ^XTMP("PSU_"_PSUJOB,"PSUCT",PSUDIV)=PSUNBR
- End DoDot:1
- +34 ;
- +35 NEW PSUTB1,PSUTB2
- +36 ;
- +37 NEW PSUCT2
- +38 SET PSUDIVA1=0
- +39 FOR
- SET PSUDIVA1=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUDIVA1))
- if PSUDIVA1=""
- QUIT
- Begin DoDot:1
- +40 SET PSUCT2=$PIECE(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUDIVA1),U,1)
- +41 DO TAB
- +42 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=" "_PSUDIVA1_" Division:"_PSUTB1_PSUCT2
- +43 SET I=I+1
- End DoDot:1
- +44 QUIT
- +45 ;
- TAB ;Calculate tab spacing
- +1 ;
- +2 SET PSUTB1=" "
- +3 SET PSUTB2=(62-$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 ;
- TOTAL ;Calculate Outpatient Total of all Divisions
- +1 ;
- +2 SET PSUOPTOT=0
- +3 SET PSUTOCT1=0
- +4 FOR
- SET PSUOPTOT=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUOPTOT))
- if PSUOPTOT=""
- QUIT
- Begin DoDot:1
- +5 SET PSUTOCT=$PIECE(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUOPTOT),U,1)
- +6 SET PSUTOCT1=PSUTOCT1+PSUTOCT
- End DoDot:1
- +7 SET $PIECE(^XTMP("PSU_"_PSUJOB,"PSUTOTAL"),U,1)=PSUTOCT1
- +8 QUIT
- +9 ;
- TAB1 ;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 SET PSUTB3=" "
- +6 SET PSUTB4=" Outpatient Total of all Divisions:"
- +7 SET PSUTB5=(67-$LENGTH(PSUTB4))-$LENGTH($PIECE(^XTMP("PSU_"_PSUJOB,"PSUTOTAL"),U,1))
- +8 FOR S3=1:1:(PSUTB5-1)
- SET PSUTB(S3)=" "
- Begin DoDot:1
- +9 ;Tab position
- SET PSUTB3=PSUTB3_PSUTB(S3)
- End DoDot:1
- +10 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=PSUTB4_PSUTB3_$PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSUTOTAL")),U,1)
- SET I=I+1
- +11 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=""
- SET I=I+1
- +12 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)="**PLEASE NOTE: Final TOTAL may not match sum of all SUBTOTALS. A patient may"
- SET I=I+1
- +13 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)="have been provided pharmacy services at more than one outpatient and/or"
- SET I=I+1
- +14 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)="inpatient division."
- +15 QUIT
- +16 ;
- NODATA ;Summary report line to be sent if there is no data
- +1 ;
- +2 SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",1)="PHARMACY OUTPATIENT 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