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
 Q
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
 Q
 ;
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
 Q
 ;
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
 Q
 ;
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
 Q
 ;
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
 Q
 ;
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
 Q
 ;
OLD1 ;
 S ^XTMP(PSUOPSUB,"XMD",PSUMC+1,1)=PSUOLD1
 K ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-1)
 S PSUMLC=2
 K PSUOLD1
 Q
 ;
 ;   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
 Q
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")
 Q
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSUOPMD   5978     printed  Sep 23, 2025@20:03:55                                                                                                                                                                                                     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