Routine: PSUOPMD

PSUOPMD ;BIR/CFL,DAM - PSU PBM Multidose Outpatient Pharmacy create mailman messages ;17 NOV 2004

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

 ;DBIA(s)

 ; Reference to file #4.3 supported by DBIA 2496

 ; Reference to file #59  supported by DBIA 2510

 ; Reference to file #4   supported by DBIA 10090

EN ;

 S $P(PSUDASH,"-",100)=""

 S $P(PSUFILL," ",100)=""

 ;Organize index of ^XTMP("DATAMD") global

 S (PSUDV,PSUTMP)=""

 F  S PSUDV=$O(^XTMP(PSUOPSUB,"DATAMD",PSUDV)) Q:PSUDV=""  D

 .S PSULCT=0

 .S PSURXIEN=""

 .F  S PSURXIEN=$O(^XTMP(PSUOPSUB,"DATAMD",PSUDV,PSURXIEN)) Q:PSURXIEN=""  D

 ..S PSURCT=0

 ..F  S PSURCT=$O(^XTMP(PSUOPSUB,"DATAMD",PSUDV,PSURXIEN,PSURCT)) Q:PSURCT=""  D

 ...S PSULCT=PSULCT+1

 ...S ^XTMP(PSUOPSUB,"RECMD",PSUDV,PSULCT)=^XTMP(PSUOPSUB,"DATAMD",PSUDV,PSURXIEN,PSURCT,1)

 ...S PSULCT=PSULCT+1

 ...S ^XTMP(PSUOPSUB,"RECMD",PSUDV,PSULCT)=^XTMP(PSUOPSUB,"DATAMD",PSUDV,PSURXIEN,PSURCT,2)

 ...S PSULCT=PSULCT+1

 ...S ^XTMP(PSUOPSUB,"RECMD",PSUDV,PSULCT)=^XTMP(PSUOPSUB,"DATAMD",PSUDV,PSURXIEN,PSURCT,3)

 ...Q:'$D(^XTMP(PSUOPSUB,"DATAMD",PSUDV,PSURXIEN,PSURCT,4))

 ...S PSULCT=PSULCT+1

 ...S ^XTMP(PSUOPSUB,"RECMD",PSUDV,PSULCT)=^XTMP(PSUOPSUB,"DATAMD",PSUDV,PSURXIEN,PSURCT,4)

 ...Q:'$D(^XTMP(PSUOPSUB,"DATAMD",PSUDV,PSURXIEN,PSURCT,5))

 ...S PSULCT=PSULCT+1

 ...S ^XTMP(PSUOPSUB,"RECMD",PSUDV,PSULCT)=^XTMP(PSUOPSUB,"DATAMD",PSUDV,PSURXIEN,PSURCT,5)

 ...Q:'$D(^XTMP(PSUOPSUB,"DATAMD",PSUDV,PSURXIEN,PSURCT,6))

 ...S PSULCT=PSULCT+1

 ...S ^XTMP(PSUOPSUB,"RECMD",PSUDV,PSULCT)=^XTMP(PSUOPSUB,"DATAMD",PSUDV,PSURXIEN,PSURCT,6)

MSG ;Set up the number of lines and messages for mailman

 S PSUNOREC="",NONE=""

 S PSUMSGT("M")=0,PSUMSGT("L")=0

 I '$D(^XTMP(PSUOPSUB,"RECMD")) D NODATA Q  ;Do not go any further if there is no data to report

 S PSUDIV=0,Z=0

 F  S PSUDIV=$O(^XTMP(PSUOPSUB,"RECMD",PSUDIV)) Q:PSUDIV=""  D

 .S X=PSUDIV,DIC=59,DIC(0)="XM" D ^DIC ;**1

 .S X=+Y,PSUDIVNM=$$VAL^PSUTL(59,X,.01)

 .I PSUMASF!PSUDUZ!PSUPBMG D

 ..D XMD,SETCNT

XMD ;

 NEW PSUMAX,PSULC,PSUTMC,PSUTLC,PSUMC,PSUOLD1,PSUOLD2,PSUOLD3

 S PSUMAX=$$VAL^PSUTL(4.3,1,8.3)

 S PSUMAX=$S(PSUMAX="":10000,PSUMAX>10000:10000,1:PSUMAX)

 K ^XTMP(PSUOPSUB,"XMD")

 S PSUMC=1,PSUMLC=0

 F PSULC=1:1 S X=$G(^XTMP(PSUOPSUB,"RECMD",PSUDIV,PSULC)) Q:X=""  D

 .S PSUMLC=PSUMLC+1

 .I PSUMLC>PSUMAX D

 ..I $E(X,1)'="*" S PSUMLC=1

 ..I $E(X,1)="*" D OLD

 .I $L(X)<254 S ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC)=X Q

 .F I=254:-1:1 S Z=$E(X,I) Q:Z="^"

 .S ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC)=$E(X,1,I)

 .S PSUMLC=PSUMLC+1

 .S ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC)="*"_$E(X,I+1,999)

 ;   Count Lines sent

 S PSUTLC=0

 F PSUM=1:1:PSUMC S X=$O(^XTMP(PSUOPSUB,"XMD",PSUM,""),-1),PSUTLC=PSUTLC+X

 D VARS

OLD ; THIS SUBROUTINE STOPS MULTI-LINED MESSAGES FORM SPANNING MAILMAN MSG

 S PSUOLD1=^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-1) I $E(PSUOLD1,1)="*" D

 .S PSUOLD2=^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-2) I $E(PSUOLD2,1)="*" D

 ..S PSUOLD3=^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-3) I $E(PSUOLD3,1)="*" D

 ...S PSUOLD4=^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-4) I $E(PSUOLD4,1)="*" D

 ....S PSUOLD5=^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-5)

 D:$D(PSUOLD5) OLD5 Q

 D:$D(PSUOLD4) OLD4 Q

 D:$D(PSUOLD3) OLD3 Q

 D:$D(PSUOLD2) OLD2 Q

 D:$D(PSUOLD1) OLD1

OLD5 ; * IF A RECORD EXCEEDS THE 10,000 CHARACTER 5 TIMES

 S ^XTMP(PSUOPSUB,"XMD",PSUMC+1,1)=PSUOLD5

 K ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-5)

 S ^XTMP(PSUOPSUB,"XMD",PSUMC+1,2)=PSUOLD4

 K ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-4)

 S ^XTMP(PSUOPSUB,"XMD",PSUMC+1,3)=PSUOLD3

 K ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-3)

 S ^XTMP(PSUOPSUB,"XMD",PSUMC+1,4)=PSUOLD2

 K ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-2)

 S ^XTMP(PSUOPSUB,"XMD",PSUMC+1,5)=PSUOLD1

 K ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-1)

 S PSUMLC=6

 K PSUOLD5,PSUOLD4,PSUOLD3,PSUOLD2,PSUOLD1

OLD4 ; * IF A RECORD EXCEEDS THE 10,000 CHARACTER 4 TIMES

 S ^XTMP(PSUOPSUB,"XMD",PSUMC+1,1)=PSUOLD4

 K ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-4)

 S ^XTMP(PSUOPSUB,"XMD",PSUMC+1,2)=PSUOLD3

 K ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-3)

 S ^XTMP(PSUOPSUB,"XMD",PSUMC+1,3)=PSUOLD2

 K ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-2)

 S ^XTMP(PSUOPSUB,"XMD",PSUMC+1,4)=PSUOLD1

 K ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-1)

 S PSUMLC=5

 K PSUOLD4,PSUOLD3,PSUOLD2,PSUOLD1

OLD3 ;

 S ^XTMP(PSUOPSUB,"XMD",PSUMC+1,1)=PSUOLD3

 K ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-3)

 S ^XTMP(PSUOPSUB,"XMD",PSUMC+1,2)=PSUOLD2

 K ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-2)

 S ^XTMP(PSUOPSUB,"XMD",PSUMC+1,3)=PSUOLD1

 K ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-1)

 S PSUMLC=4

 K PSUOLD3,PSUOLD2,PSUOLD1

OLD2 ;

 S ^XTMP(PSUOPSUB,"XMD",PSUMC+1,1)=PSUOLD2

 K ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-2)

 S ^XTMP(PSUOPSUB,"XMD",PSUMC+1,2)=PSUOLD1

 K ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-1)

 S PSUMLC=3

 K PSUOLD2,PSUOLD1

OLD1 ;

 S ^XTMP(PSUOPSUB,"XMD",PSUMC+1,1)=PSUOLD1

 K ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-1)

 S PSUMLC=2

 K PSUOLD1

 ;   Transmit Messages

VARS ; Setup variables for contents

 F PSUM=1:1:PSUMC D

 .S XMSUB="V. 4.0 PBMOP(MULTIDOSE) "_PSUMON_" "_PSUM_"/"_PSUMC_" "_PSUDIV_" "_PSUDIVNM

 .S XMTEXT="^XTMP(PSUOPSUB,""XMD"",PSUM,"

 .S XMCHAN=1

 .I PSUMASF!PSUDUZ!PSUPBMG D

 ..M XMY=PSUXMYH

 .I 'PSUMASF M XMY=PSUXMYS1

 .I '$G(PSUSMRY) D ^XMD

 S:NONE PSUTLC=0

 S PSUMSG("M")=PSUMC

 S PSUMSG("L")=PSUTLC

NODATA ;Send "No data to report" message

 S ^XTMP(PSUOPSUB,"RECMD",PSUSNDR,1)="No data to report"

 S NONE=1,PSUDIV=PSUSNDR

 ;S ^XTMP("PSU_"_PSUJOB,"PSUNONE","RX")=""

 S X=PSUDIV,DIC=4,DIC(0)="XM" D ^DIC ;**1

 S X=+Y,PSUDIVNM=$$VAL^PSUTL(4,X,.01)

 D XMD

SETCNT ;Set message count and line count

 S PSUMSGT(PSUDIV,"MD","M")=$G(PSUMSGT(PSUDIV,"MD","M"))+PSUMSG("M")

 S PSUMSGT(PSUDIV,"MD","L")=$G(PSUMSGT(PSUDIV,"MD","L"))+PSUMSG("L")

 S ^XTMP("PSU_"_PSUJOB,"CONFIRMD",PSUDIV,PSUOPTN,"M")=PSUMSGT(PSUDIV,"MD","M")

 S ^XTMP("PSU_"_PSUJOB,"CONFIRMD",PSUDIV,PSUOPTN,"L")=PSUMSGT(PSUDIV,"MD","L")

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSUOPMD   5978     printed  Mar 13, 2025@21:32:44                                                                                                                                                                                                     Page 2

PSUOPMD   ;BIR/CFL,DAM - PSU PBM Multidose Outpatient Pharmacy create mailman messages ;17 NOV 2004

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

 +2       ;

 +3       ;DBIA(s)

 +4       ; Reference to file #4.3 supported by DBIA 2496

 +5       ; Reference to file #59  supported by DBIA 2510

 +6       ; Reference to file #4   supported by DBIA 10090

 +7       ;

EN        ;

 +1       ;

 +2        SET $PIECE(PSUDASH,"-",100)=""

 +3        SET $PIECE(PSUFILL," ",100)=""

 +4       ;Organize index of ^XTMP("DATAMD") global

 +5        SET (PSUDV,PSUTMP)=""

 +6        FOR

               SET PSUDV=$ORDER(^XTMP(PSUOPSUB,"DATAMD",PSUDV))

               if PSUDV=""

                   QUIT

               Begin DoDot:1

 +7                SET PSULCT=0

 +8                SET PSURXIEN=""

 +9                FOR

                       SET PSURXIEN=$ORDER(^XTMP(PSUOPSUB,"DATAMD",PSUDV,PSURXIEN))

                       if PSURXIEN=""

                           QUIT

                       Begin DoDot:2

 +10                       SET PSURCT=0

 +11                       FOR

                               SET PSURCT=$ORDER(^XTMP(PSUOPSUB,"DATAMD",PSUDV,PSURXIEN,PSURCT))

                               if PSURCT=""

                                   QUIT

                               Begin DoDot:3

 +12                               SET PSULCT=PSULCT+1

 +13                               SET ^XTMP(PSUOPSUB,"RECMD",PSUDV,PSULCT)=^XTMP(PSUOPSUB,"DATAMD",PSUDV,PSURXIEN,PSURCT,1)

 +14                               SET PSULCT=PSULCT+1

 +15                               SET ^XTMP(PSUOPSUB,"RECMD",PSUDV,PSULCT)=^XTMP(PSUOPSUB,"DATAMD",PSUDV,PSURXIEN,PSURCT,2)

 +16                               SET PSULCT=PSULCT+1

 +17                               SET ^XTMP(PSUOPSUB,"RECMD",PSUDV,PSULCT)=^XTMP(PSUOPSUB,"DATAMD",PSUDV,PSURXIEN,PSURCT,3)

 +18                               if '$DATA(^XTMP(PSUOPSUB,"DATAMD",PSUDV,PSURXIEN,PSURCT,4))

                                       QUIT

 +19                               SET PSULCT=PSULCT+1

 +20                               SET ^XTMP(PSUOPSUB,"RECMD",PSUDV,PSULCT)=^XTMP(PSUOPSUB,"DATAMD",PSUDV,PSURXIEN,PSURCT,4)

 +21                               if '$DATA(^XTMP(PSUOPSUB,"DATAMD",PSUDV,PSURXIEN,PSURCT,5))

                                       QUIT

 +22                               SET PSULCT=PSULCT+1

 +23                               SET ^XTMP(PSUOPSUB,"RECMD",PSUDV,PSULCT)=^XTMP(PSUOPSUB,"DATAMD",PSUDV,PSURXIEN,PSURCT,5)

 +24                               if '$DATA(^XTMP(PSUOPSUB,"DATAMD",PSUDV,PSURXIEN,PSURCT,6))

                                       QUIT

 +25                               SET PSULCT=PSULCT+1

 +26                               SET ^XTMP(PSUOPSUB,"RECMD",PSUDV,PSULCT)=^XTMP(PSUOPSUB,"DATAMD",PSUDV,PSURXIEN,PSURCT,6)

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +27      ;

 +28      ;

MSG       ;Set up the number of lines and messages for mailman

 +1       ;

 +2        SET PSUNOREC=""

           SET NONE=""

 +3        SET PSUMSGT("M")=0

           SET PSUMSGT("L")=0

 +4       ;Do not go any further if there is no data to report

           IF '$DATA(^XTMP(PSUOPSUB,"RECMD"))

               DO NODATA

               QUIT

 +5        SET PSUDIV=0

           SET Z=0

 +6        FOR

               SET PSUDIV=$ORDER(^XTMP(PSUOPSUB,"RECMD",PSUDIV))

               if PSUDIV=""

                   QUIT

               Begin DoDot:1

 +7       ;**1

                   SET X=PSUDIV

                   SET DIC=59

                   SET DIC(0)="XM"

                   DO ^DIC

 +8                SET X=+Y

                   SET PSUDIVNM=$$VAL^PSUTL(59,X,.01)

 +9                IF PSUMASF!PSUDUZ!PSUPBMG

                       Begin DoDot:2

 +10                       DO XMD

                           DO SETCNT

                       End DoDot:2

               End DoDot:1

 +11       QUIT

XMD       ;

 +1        NEW PSUMAX,PSULC,PSUTMC,PSUTLC,PSUMC,PSUOLD1,PSUOLD2,PSUOLD3

 +2        SET PSUMAX=$$VAL^PSUTL(4.3,1,8.3)

 +3        SET PSUMAX=$SELECT(PSUMAX="":10000,PSUMAX>10000:10000,1:PSUMAX)

 +4        KILL ^XTMP(PSUOPSUB,"XMD")

 +5        SET PSUMC=1

           SET PSUMLC=0

 +6        FOR PSULC=1:1

               SET X=$GET(^XTMP(PSUOPSUB,"RECMD",PSUDIV,PSULC))

               if X=""

                   QUIT

               Begin DoDot:1

 +7                SET PSUMLC=PSUMLC+1

 +8                IF PSUMLC>PSUMAX

                       Begin DoDot:2

 +9                        IF $EXTRACT(X,1)'="*"

                               SET PSUMLC=1

 +10                       IF $EXTRACT(X,1)="*"

                               DO OLD

                       End DoDot:2

 +11               IF $LENGTH(X)<254

                       SET ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC)=X

                       QUIT

 +12               FOR I=254:-1:1

                       SET Z=$EXTRACT(X,I)

                       if Z="^"

                           QUIT

 +13               SET ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC)=$EXTRACT(X,1,I)

 +14               SET PSUMLC=PSUMLC+1

 +15               SET ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC)="*"_$EXTRACT(X,I+1,999)

               End DoDot:1

 +16      ;

 +17      ;   Count Lines sent

 +18       SET PSUTLC=0

 +19       FOR PSUM=1:1:PSUMC

               SET X=$ORDER(^XTMP(PSUOPSUB,"XMD",PSUM,""),-1)

               SET PSUTLC=PSUTLC+X

 +20       DO VARS

 +21       QUIT

 +22      ;

OLD       ; THIS SUBROUTINE STOPS MULTI-LINED MESSAGES FORM SPANNING MAILMAN MSG

 +1        SET PSUOLD1=^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-1)

           IF $EXTRACT(PSUOLD1,1)="*"

               Begin DoDot:1

 +2                SET PSUOLD2=^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-2)

                   IF $EXTRACT(PSUOLD2,1)="*"

                       Begin DoDot:2

 +3                        SET PSUOLD3=^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-3)

                           IF $EXTRACT(PSUOLD3,1)="*"

                               Begin DoDot:3

 +4                                SET PSUOLD4=^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-4)

                                   IF $EXTRACT(PSUOLD4,1)="*"

                                       Begin DoDot:4

 +5                                        SET PSUOLD5=^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-5)

                                       End DoDot:4

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +6        if $DATA(PSUOLD5)

               DO OLD5

           QUIT

 +7        if $DATA(PSUOLD4)

               DO OLD4

           QUIT

 +8        if $DATA(PSUOLD3)

               DO OLD3

           QUIT

 +9        if $DATA(PSUOLD2)

               DO OLD2

           QUIT

 +10       if $DATA(PSUOLD1)

               DO OLD1

 +11       QUIT

 +12      ;

OLD5      ; * IF A RECORD EXCEEDS THE 10,000 CHARACTER 5 TIMES

 +1        SET ^XTMP(PSUOPSUB,"XMD",PSUMC+1,1)=PSUOLD5

 +2        KILL ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-5)

 +3        SET ^XTMP(PSUOPSUB,"XMD",PSUMC+1,2)=PSUOLD4

 +4        KILL ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-4)

 +5        SET ^XTMP(PSUOPSUB,"XMD",PSUMC+1,3)=PSUOLD3

 +6        KILL ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-3)

 +7        SET ^XTMP(PSUOPSUB,"XMD",PSUMC+1,4)=PSUOLD2

 +8        KILL ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-2)

 +9        SET ^XTMP(PSUOPSUB,"XMD",PSUMC+1,5)=PSUOLD1

 +10       KILL ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-1)

 +11       SET PSUMLC=6

 +12       KILL PSUOLD5,PSUOLD4,PSUOLD3,PSUOLD2,PSUOLD1

 +13       QUIT

 +14      ;

OLD4      ; * IF A RECORD EXCEEDS THE 10,000 CHARACTER 4 TIMES

 +1        SET ^XTMP(PSUOPSUB,"XMD",PSUMC+1,1)=PSUOLD4

 +2        KILL ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-4)

 +3        SET ^XTMP(PSUOPSUB,"XMD",PSUMC+1,2)=PSUOLD3

 +4        KILL ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-3)

 +5        SET ^XTMP(PSUOPSUB,"XMD",PSUMC+1,3)=PSUOLD2

 +6        KILL ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-2)

 +7        SET ^XTMP(PSUOPSUB,"XMD",PSUMC+1,4)=PSUOLD1

 +8        KILL ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-1)

 +9        SET PSUMLC=5

 +10       KILL PSUOLD4,PSUOLD3,PSUOLD2,PSUOLD1

 +11       QUIT

 +12      ;

OLD3      ;

 +1        SET ^XTMP(PSUOPSUB,"XMD",PSUMC+1,1)=PSUOLD3

 +2        KILL ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-3)

 +3        SET ^XTMP(PSUOPSUB,"XMD",PSUMC+1,2)=PSUOLD2

 +4        KILL ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-2)

 +5        SET ^XTMP(PSUOPSUB,"XMD",PSUMC+1,3)=PSUOLD1

 +6        KILL ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-1)

 +7        SET PSUMLC=4

 +8        KILL PSUOLD3,PSUOLD2,PSUOLD1

 +9        QUIT

 +10      ;

OLD2      ;

 +1        SET ^XTMP(PSUOPSUB,"XMD",PSUMC+1,1)=PSUOLD2

 +2        KILL ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-2)

 +3        SET ^XTMP(PSUOPSUB,"XMD",PSUMC+1,2)=PSUOLD1

 +4        KILL ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-1)

 +5        SET PSUMLC=3

 +6        KILL PSUOLD2,PSUOLD1

 +7        QUIT

 +8       ;

OLD1      ;

 +1        SET ^XTMP(PSUOPSUB,"XMD",PSUMC+1,1)=PSUOLD1

 +2        KILL ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-1)

 +3        SET PSUMLC=2

 +4        KILL PSUOLD1

 +5        QUIT

 +6       ;

 +7       ;   Transmit Messages

VARS      ; Setup variables for contents

 +1        FOR PSUM=1:1:PSUMC

               Begin DoDot:1

 +2                SET XMSUB="V. 4.0 PBMOP(MULTIDOSE) "_PSUMON_" "_PSUM_"/"_PSUMC_" "_PSUDIV_" "_PSUDIVNM

 +3                SET XMTEXT="^XTMP(PSUOPSUB,""XMD"",PSUM,"

 +4                SET XMCHAN=1

 +5                IF PSUMASF!PSUDUZ!PSUPBMG

                       Begin DoDot:2

 +6                        MERGE XMY=PSUXMYH

                       End DoDot:2

 +7                IF 'PSUMASF

                       MERGE XMY=PSUXMYS1

 +8                IF '$GET(PSUSMRY)

                       DO ^XMD

               End DoDot:1

 +9       ;

 +10       if NONE

               SET PSUTLC=0

 +11       SET PSUMSG("M")=PSUMC

 +12       SET PSUMSG("L")=PSUTLC

 +13       QUIT

NODATA    ;Send "No data to report" message

 +1        SET ^XTMP(PSUOPSUB,"RECMD",PSUSNDR,1)="No data to report"

 +2        SET NONE=1

           SET PSUDIV=PSUSNDR

 +3       ;S ^XTMP("PSU_"_PSUJOB,"PSUNONE","RX")=""

 +4       ;**1

           SET X=PSUDIV

           SET DIC=4

           SET DIC(0)="XM"

           DO ^DIC

 +5        SET X=+Y

           SET PSUDIVNM=$$VAL^PSUTL(4,X,.01)

 +6        DO XMD

SETCNT    ;Set message count and line count

 +1        SET PSUMSGT(PSUDIV,"MD","M")=$GET(PSUMSGT(PSUDIV,"MD","M"))+PSUMSG("M")

 +2        SET PSUMSGT(PSUDIV,"MD","L")=$GET(PSUMSGT(PSUDIV,"MD","L"))+PSUMSG("L")

 +3        SET ^XTMP("PSU_"_PSUJOB,"CONFIRMD",PSUDIV,PSUOPTN,"M")=PSUMSGT(PSUDIV,"MD","M")

 +4        SET ^XTMP("PSU_"_PSUJOB,"CONFIRMD",PSUDIV,PSUOPTN,"L")=PSUMSGT(PSUDIV,"MD","L")

 +5        QUIT

PSUOPMD.m