PSUSUM5.m

PSUSUM5 ;BIR/DAM - Patient Demographics Summary for IV/UD ; 20 DEC 2001

 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005

 ;

EN ;EN CALLED FROM PSUUD0

 ;

 I $D(^XTMP("PSU_"_PSUJOB,"PSUFLAG2"))!$D(^XTMP("PSU_"_PSUJOB,"PSUFLAG3")) K ^XTMP("PSU_"_PSUJOB,"PSUSUMA")

 I $D(^XTMP("PSU_"_PSUJOB,"PSUNONE","IV"))&$D(^XTMP("PSU_"_PSUJOB,"PSUNONE","UD")) D  Q    ;Summary report if there is no data

 .D NODATA

 .I $D(^XTMP("PSU_"_PSUJOB,"PSUFLAG1"))!$D(^XTMP("PSU_"_PSUJOB,"PSUFLAG2")) K ^XTMP("PSU_"_PSUJOB,"PSUNONE")

 ;

 D DATE

 S I=7         ;Line Counter

 D UNIQUE

 D DIV

 D TOTAL

 D TAB1^PSUSUM4

 D PDSUM^PSUDEM5      ;Mail message

 K ^XTMP("PSU_"_PSUJOB,"PSUIVOUT")

 K ^XTMP("PSU_"_PSUJOB,"PSUUDIN")

 I $D(^XTMP("PSU_"_PSUJOB,"PSUFLAG2")) K ^XTMP("PSU_"_PSUJOB,"PSUSUMA")

 K ^XTMP("PSU_"_PSUJOB,"PSUFIN")

 K ^XTMP("PSU_"_PSUJOB,"PSUIVSSN")

 K ^XTMP("PSU_"_PSUJOB,"PSUIVDIV")

 K ^XTMP("PSU_"_PSUJOB,"PSUNEW")

 K ^XTMP("PSU_"_PSUJOB,"PSUTOTAL")

 K ^XTMP("PSU_"_PSUJOB,"PSUFLAG2")

 K ^XTMP("PSU_"_PSUJOB,"PSUFLAG3")

 K ^XTMP("PSU_"_PSUJOB,"PSUUDDIV")

 ;

 K ^XTMP("PSU_"_PSUJOB,"PSURXCTA")

 Q

 ;

DATE ;Convert date range of extract to external format

 ;

 D PULL^PSUCP

 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 IVUDSUM

 Q

 ;

IVUDSUM ;Summary report header

 ;

 S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",1)="PHARMACY INPATIENT (UD & IV) 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 patient number across all divisions

 ;

 N PSUSIT

 S PSUSIT=PSUSNDR

 ;

 N PSUIPSUM,PSUOPSUM

 I '$D(^XTMP("PSU_"_PSUJOB,"PSUIVIN")) S $P(^XTMP("PSU_"_PSUJOB,"PSUIVIN"),U,1)=0

 I '$D(^XTMP("PSU_"_PSUJOB,"PSUUDIN")) S $P(^XTMP("PSU_"_PSUJOB,"PSUUDIN"),U,1)=0

 I '$D(^XTMP("PSU_"_PSUJOB,"PSUIVOUT")) S $P(^XTMP("PSU_"_PSUJOB,"PSUIVOUT"),U,1)=0

 ;

 ;Create IP unique global.  Screen out duplicates

 M ^XTMP("PSU_"_PSUJOB,"PSUIPSUM")=^XTMP("PSU_"_PSUJOB,"PSUUDIN")

 M ^XTMP("PSU_"_PSUJOB,"PSUIPSUM")=^XTMP("PSU_"_PSUJOB,"PSUIN")

 ;

 S N=1

 S PSUSUM=0

 F  S PSUSUM=$O(^XTMP("PSU_"_PSUJOB,"PSUIPSUM",PSUSUM))  Q:PSUSUM=""  D

 .S PSUIPSUM=N S N=N+1

 ;

 S PSUOPSUM=$P($G(^XTMP("PSU_"_PSUJOB,"PSUIVOUT")),U,1)

 D TAB

 Q

 ;

TAB ;Calculate tab spacing

 ;

 N PSUTB2,PSUTB3,PSUTB4,PSUTB5

 ;

 S PSUTB1=" "

 S PSUTB2="Total Inpatients across all divisions:"

 S PSUTB3=(64-$L(PSUIPSUM))-$L(PSUTB2)

 F S2=1:1:(PSUTB3-1) S PSUTB(S2)=" " D

 .S PSUTB1=PSUTB1_PSUTB(S2)

 ;

 S PSUTB6=" "

 S PSUTB4="Total Outpatients across all divisions:"

 S PSUTB5=(64-$L(PSUOPSUM))-$L(PSUTB4)

 F S3=1:1:(PSUTB5-1) S PSUTB(S3)=" " D

 .S PSUTB6=PSUTB6_PSUTB(S3)

 D TOT

 Q

 ;

TOT ;Set total number of unique in-patients and out-patients into

 ;summary message

 ;

 S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=PSUTB2_PSUTB1_(PSUIPSUM) S I=I+1

 S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=PSUTB4_PSUTB6_(PSUOPSUM) S I=I+1

 S $P(^XTMP("PSU_"_PSUJOB,"PSUSUMA",I),"-",70)="" S I=I+1

 Q

 ;

DIV ;Set all divisions from both IV and UD extracts into one global

 ;

 M ^XTMP("PSU_"_PSUJOB,"PSUFIN")=^XTMP("PSU_"_PSUJOB,"PSUDIV1")    ;IP division name/SSN

 M ^XTMP("PSU_"_PSUJOB,"PSUFIN")=^XTMP("PSU_"_PSUJOB,"PSUDIVUD")   ;UD division name/SSN

 Q

 S E=1        ;Counter for new global

 S PSUZ=0

 F  S PSUZ=$O(^XTMP("PSU_"_PSUJOB,"PSUIVINDIV",PSUZ)) Q:PSUZ=""  D

 .S ^XTMP("PSU_"_PSUJOB,"PSUNEW",PSUZ,E)=$P($G(^XTMP("PSU_"_PSUJOB,"PSUIVINDIV",PSUZ)),U,1)   ;IV

 .S E=E+1

 ;

 S PSUZ1=0

 F  S PSUZ1=$O(^XTMP("PSU_"_PSUJOB,"PSUUDDIV",PSUZ1)) Q:PSUZ1=""  D

 .S ^XTMP("PSU_"_PSUJOB,"PSUNEW",PSUZ1,E)=$P($G(^XTMP("PSU_"_PSUJOB,"PSUUDDIV",PSUZ1)),U,1)

 .S E=E+1

 Q

 ;

 ;

TOTAL ;Calculate sum of all divisions and set individual division lines

 ;into summary message

 ;

 S T=1

 S PSUDNAM=0

 F  S PSUDNAM=$O(^XTMP("PSU_"_PSUJOB,"PSUFIN",PSUDNAM)) Q:PSUDNAM=""  D

 .S PSUNUM1=0

 .F  S PSUNUM1=$O(^XTMP("PSU_"_PSUJOB,"PSUFIN",PSUDNAM,PSUNUM1)) Q:PSUNUM1=""  D

 ..S ^XTMP("PSU_"_PSUJOB,"PSUTOTAL")=T S T=T+1     ;Set total count

 ..I $D(^XTMP("PSU_"_PSUJOB,"PSUTOT",PSUDNAM)) D

 ...S C=C+1

 ...S ^XTMP("PSU_"_PSUJOB,"PSUTOT",PSUDNAM)=C

 ..I '$D(^XTMP("PSU_"_PSUJOB,"PSUTOT",PSUDNAM)) D

 ...S C=1

 ...S ^XTMP("PSU_"_PSUJOB,"PSUTOT",PSUDNAM)=C

 ;

 S PSUDNAM1=0

 N PSUSNUM

 F  S PSUDNAM1=$O(^XTMP("PSU_"_PSUJOB,"PSUTOT",PSUDNAM1)) Q:PSUDNAM1=""  D

 .S PSUNUM=$P($G(^XTMP("PSU_"_PSUJOB,"PSUTOT",PSUDNAM1)),U,1)

 .D TAB1

 .S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)="     "_PSUDNAM1_" Division:"_PSUTB6_PSUNUM

 .S I=I+1

 ;

 Q

 ;

TAB1 ;Calculate tab spacing

 ;

 S PSUTB6=" "

 S PSUTB7=(59-$L(PSUNUM))-$L(PSUDNAM1)-10

 F S2=1:1:(PSUTB7-1) S PSUTB(S2)=" " D

 .S PSUTB6=PSUTB6_PSUTB(S2)                  ;Tab position

 Q

 ;

NODATA ;Summary report line to be sent if there is no data

 ;

 S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",1)="PHARMACY INPATIENT (UD & IV) 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 ---PSUSUM5   5418     printed  Feb 18, 2025@23:54:33                                                                                                                                                                                                     Page 2

PSUSUM5   ;BIR/DAM - Patient Demographics Summary for IV/UD ; 20 DEC 2001

 +1       ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005

 +2       ;

EN        ;EN CALLED FROM PSUUD0

 +1       ;

 +2        IF $DATA(^XTMP("PSU_"_PSUJOB,"PSUFLAG2"))!$DATA(^XTMP("PSU_"_PSUJOB,"PSUFLAG3"))

               KILL ^XTMP("PSU_"_PSUJOB,"PSUSUMA")

 +3       ;Summary report if there is no data

           IF $DATA(^XTMP("PSU_"_PSUJOB,"PSUNONE","IV"))&$DATA(^XTMP("PSU_"_PSUJOB,"PSUNONE","UD"))

               Begin DoDot:1

 +4                DO NODATA

 +5                IF $DATA(^XTMP("PSU_"_PSUJOB,"PSUFLAG1"))!$DATA(^XTMP("PSU_"_PSUJOB,"PSUFLAG2"))

                       KILL ^XTMP("PSU_"_PSUJOB,"PSUNONE")

               End DoDot:1

               QUIT 

 +6       ;

 +7        DO DATE

 +8       ;Line Counter

           SET I=7

 +9        DO UNIQUE

 +10       DO DIV

 +11       DO TOTAL

 +12       DO TAB1^PSUSUM4

 +13      ;Mail message

           DO PDSUM^PSUDEM5

 +14       KILL ^XTMP("PSU_"_PSUJOB,"PSUIVOUT")

 +15       KILL ^XTMP("PSU_"_PSUJOB,"PSUUDIN")

 +16       IF $DATA(^XTMP("PSU_"_PSUJOB,"PSUFLAG2"))

               KILL ^XTMP("PSU_"_PSUJOB,"PSUSUMA")

 +17       KILL ^XTMP("PSU_"_PSUJOB,"PSUFIN")

 +18       KILL ^XTMP("PSU_"_PSUJOB,"PSUIVSSN")

 +19       KILL ^XTMP("PSU_"_PSUJOB,"PSUIVDIV")

 +20       KILL ^XTMP("PSU_"_PSUJOB,"PSUNEW")

 +21       KILL ^XTMP("PSU_"_PSUJOB,"PSUTOTAL")

 +22       KILL ^XTMP("PSU_"_PSUJOB,"PSUFLAG2")

 +23       KILL ^XTMP("PSU_"_PSUJOB,"PSUFLAG3")

 +24       KILL ^XTMP("PSU_"_PSUJOB,"PSUUDDIV")

 +25      ;

 +26       KILL ^XTMP("PSU_"_PSUJOB,"PSURXCTA")

 +27       QUIT 

 +28      ;

DATE      ;Convert date range of extract to external format

 +1       ;

 +2        DO PULL^PSUCP

 +3       ;today's date

           SET %H=$EXTRACT($HOROLOG,1,5)

 +4        DO YX^%DTC

 +5        NEW PSUD

           SET PSUD=Y

 +6       ;

 +7        SET Y=PSUSDT

 +8        DO DD^%DT

 +9        NEW PSUS

           SET PSUS=Y

 +10      ;

 +11       SET Y=PSUEDT

 +12       DO DD^%DT

 +13       NEW PSUE

           SET PSUE=Y

 +14      ;

 +15       DO IVUDSUM

 +16       QUIT 

 +17      ;

IVUDSUM   ;Summary report header

 +1       ;

 +2        SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",1)="PHARMACY INPATIENT (UD & IV) UNIQUE PATIENTS REPORT          "_PSUD

 +3       ;Separator bar

           SET $PIECE(^XTMP("PSU_"_PSUJOB,"PSUSUMA",2),"-",80)=""

 +4        SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",3)="                 "_PSUS_"  through  "_PSUE

 +5        SET $PIECE(^XTMP("PSU_"_PSUJOB,"PSUSUMA",4),"=",80)=""

 +6        SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",5)="                                                           UNIQUE"

 +7        SET $PIECE(^XTMP("PSU_"_PSUJOB,"PSUSUMA",6),"-",70)=""

 +8        QUIT 

 +9       ;

UNIQUE    ;Find Total unique patient number across all divisions

 +1       ;

 +2        NEW PSUSIT

 +3        SET PSUSIT=PSUSNDR

 +4       ;

 +5        NEW PSUIPSUM,PSUOPSUM

 +6        IF '$DATA(^XTMP("PSU_"_PSUJOB,"PSUIVIN"))

               SET $PIECE(^XTMP("PSU_"_PSUJOB,"PSUIVIN"),U,1)=0

 +7        IF '$DATA(^XTMP("PSU_"_PSUJOB,"PSUUDIN"))

               SET $PIECE(^XTMP("PSU_"_PSUJOB,"PSUUDIN"),U,1)=0

 +8        IF '$DATA(^XTMP("PSU_"_PSUJOB,"PSUIVOUT"))

               SET $PIECE(^XTMP("PSU_"_PSUJOB,"PSUIVOUT"),U,1)=0

 +9       ;

 +10      ;Create IP unique global.  Screen out duplicates

 +11       MERGE ^XTMP("PSU_"_PSUJOB,"PSUIPSUM")=^XTMP("PSU_"_PSUJOB,"PSUUDIN")

 +12       MERGE ^XTMP("PSU_"_PSUJOB,"PSUIPSUM")=^XTMP("PSU_"_PSUJOB,"PSUIN")

 +13      ;

 +14       SET N=1

 +15       SET PSUSUM=0

 +16       FOR 

               SET PSUSUM=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUIPSUM",PSUSUM))

               if PSUSUM=""

                   QUIT 

               Begin DoDot:1

 +17               SET PSUIPSUM=N

                   SET N=N+1

               End DoDot:1

 +18      ;

 +19       SET PSUOPSUM=$PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSUIVOUT")),U,1)

 +20       DO TAB

 +21       QUIT 

 +22      ;

TAB       ;Calculate tab spacing

 +1       ;

 +2        NEW PSUTB2,PSUTB3,PSUTB4,PSUTB5

 +3       ;

 +4        SET PSUTB1=" "

 +5        SET PSUTB2="Total Inpatients across all divisions:"

 +6        SET PSUTB3=(64-$LENGTH(PSUIPSUM))-$LENGTH(PSUTB2)

 +7        FOR S2=1:1:(PSUTB3-1)

               SET PSUTB(S2)=" "

               Begin DoDot:1

 +8                SET PSUTB1=PSUTB1_PSUTB(S2)

               End DoDot:1

 +9       ;

 +10       SET PSUTB6=" "

 +11       SET PSUTB4="Total Outpatients across all divisions:"

 +12       SET PSUTB5=(64-$LENGTH(PSUOPSUM))-$LENGTH(PSUTB4)

 +13       FOR S3=1:1:(PSUTB5-1)

               SET PSUTB(S3)=" "

               Begin DoDot:1

 +14               SET PSUTB6=PSUTB6_PSUTB(S3)

               End DoDot:1

 +15       DO TOT

 +16       QUIT 

 +17      ;

TOT       ;Set total number of unique in-patients and out-patients into

 +1       ;summary message

 +2       ;

 +3        SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=PSUTB2_PSUTB1_(PSUIPSUM)

           SET I=I+1

 +4        SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=PSUTB4_PSUTB6_(PSUOPSUM)

           SET I=I+1

 +5        SET $PIECE(^XTMP("PSU_"_PSUJOB,"PSUSUMA",I),"-",70)=""

           SET I=I+1

 +6        QUIT 

 +7       ;

DIV       ;Set all divisions from both IV and UD extracts into one global

 +1       ;

 +2       ;IP division name/SSN

           MERGE ^XTMP("PSU_"_PSUJOB,"PSUFIN")=^XTMP("PSU_"_PSUJOB,"PSUDIV1")

 +3       ;UD division name/SSN

           MERGE ^XTMP("PSU_"_PSUJOB,"PSUFIN")=^XTMP("PSU_"_PSUJOB,"PSUDIVUD")

 +4        QUIT 

 +5       ;Counter for new global

           SET E=1

 +6        SET PSUZ=0

 +7        FOR 

               SET PSUZ=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUIVINDIV",PSUZ))

               if PSUZ=""

                   QUIT 

               Begin DoDot:1

 +8       ;IV

                   SET ^XTMP("PSU_"_PSUJOB,"PSUNEW",PSUZ,E)=$PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSUIVINDIV",PSUZ)),U,1)

 +9                SET E=E+1

               End DoDot:1

 +10      ;

 +11       SET PSUZ1=0

 +12       FOR 

               SET PSUZ1=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUUDDIV",PSUZ1))

               if PSUZ1=""

                   QUIT 

               Begin DoDot:1

 +13               SET ^XTMP("PSU_"_PSUJOB,"PSUNEW",PSUZ1,E)=$PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSUUDDIV",PSUZ1)),U,1)

 +14               SET E=E+1

               End DoDot:1

 +15       QUIT 

 +16      ;

 +17      ;

TOTAL     ;Calculate sum of all divisions and set individual division lines

 +1       ;into summary message

 +2       ;

 +3        SET T=1

 +4        SET PSUDNAM=0

 +5        FOR 

               SET PSUDNAM=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUFIN",PSUDNAM))

               if PSUDNAM=""

                   QUIT 

               Begin DoDot:1

 +6                SET PSUNUM1=0

 +7                FOR 

                       SET PSUNUM1=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUFIN",PSUDNAM,PSUNUM1))

                       if PSUNUM1=""

                           QUIT 

                       Begin DoDot:2

 +8       ;Set total count

                           SET ^XTMP("PSU_"_PSUJOB,"PSUTOTAL")=T

                           SET T=T+1

 +9                        IF $DATA(^XTMP("PSU_"_PSUJOB,"PSUTOT",PSUDNAM))

                               Begin DoDot:3

 +10                               SET C=C+1

 +11                               SET ^XTMP("PSU_"_PSUJOB,"PSUTOT",PSUDNAM)=C

                               End DoDot:3

 +12                       IF '$DATA(^XTMP("PSU_"_PSUJOB,"PSUTOT",PSUDNAM))

                               Begin DoDot:3

 +13                               SET C=1

 +14                               SET ^XTMP("PSU_"_PSUJOB,"PSUTOT",PSUDNAM)=C

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +15      ;

 +16       SET PSUDNAM1=0

 +17       NEW PSUSNUM

 +18       FOR 

               SET PSUDNAM1=$ORDER(^XTMP("PSU_"_PSUJOB,"PSUTOT",PSUDNAM1))

               if PSUDNAM1=""

                   QUIT 

               Begin DoDot:1

 +19               SET PSUNUM=$PIECE($GET(^XTMP("PSU_"_PSUJOB,"PSUTOT",PSUDNAM1)),U,1)

 +20               DO TAB1

 +21               SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)="     "_PSUDNAM1_" Division:"_PSUTB6_PSUNUM

 +22               SET I=I+1

               End DoDot:1

 +23      ;

 +24       QUIT 

 +25      ;

TAB1      ;Calculate tab spacing

 +1       ;

 +2        SET PSUTB6=" "

 +3        SET PSUTB7=(59-$LENGTH(PSUNUM))-$LENGTH(PSUDNAM1)-10

 +4        FOR S2=1:1:(PSUTB7-1)

               SET PSUTB(S2)=" "

               Begin DoDot:1

 +5       ;Tab position

                   SET PSUTB6=PSUTB6_PSUTB(S2)

               End DoDot:1

 +6        QUIT 

 +7       ;

NODATA    ;Summary report line to be sent if there is no data

 +1       ;

 +2        SET ^XTMP("PSU_"_PSUJOB,"PSUSUMA",1)="PHARMACY INPATIENT (UD & IV) 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