PSUUD4.m

PSUUD4 ;BIR/TJH - PBM UNIT DOSE EMAIL GENERATOR ;10 JUL 1999

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

 ;DBIA(s)

 ; Reference to file #4.3  supported by DBIA 2496,2596

 ; Reference to file #40.8 supported by DBIA 2438

 ;

 ;PSULC  = Line processing in ^tmp

 ;PSUTLC = Total Line count

 ;PSUMC  = Message counter

 ;PSUMLC = Message Line Counter

 ; RETURNS 

 ;PSUMSG("M") = # Messages

 ;PSUMSG("L") = # Lines

 ;

EN(PSUMSGT) ;Scan and process for Division(s)

 ; PSUMSGT ("M")= # MESSAGES  ("L")= # LINES

 ;

 S PSUDIV=0,Z=0,PSUUDSUB="PSUUD_"_PSUJOB

 F  S PSUDIV=$O(^XTMP(PSUUDSUB,"RECORDS",PSUDIV)) Q:PSUDIV=""  D

 . D XMD^PSUUD4(.Z) ; ==> process one division

 . S PSUMSGT(PSUDIV,PSUOPTN,"M")=$G(PSUMSGT(PSUDIV,PSUOPTN,"M"))+Z("M")

 . S PSUMSGT(PSUDIV,PSUOPTN,"L")=$G(PSUMSGT(PSUDIV,PSUOPTN,"L"))+Z("L")

 Q

XMD(PSUMSG) ;EP returns PSUMSG("M")= # MESSAGES ("L")= # LINES

 NEW PSUMAX,PSULC,PSUTMC,PSUTLC,PSUMC

 ; Scan TMP, split lines, transmit per MAX lines in Netmail

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

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

 ;

 ;   Split and store into ^XTMP(PSUUDSUB,"XMD",PSUMC,PSUMLC)

 K ^XTMP(PSUUDSUB,"XMD")

 S PSUMC=1,PSUMLC=0

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

 . S PSUMLC=PSUMLC+1

 . I PSUMLC>PSUMAX S PSUMC=PSUMC+1,PSUMLC=0,PSULC=PSULC-1 Q  ; +  message

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

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

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

 . S PSUMLC=PSUMLC+1

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

 ;   Count Lines sent

 S PSUTLC=0

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

 ;   Transmit Messages

VARS ; Setup variables for contents

 ;

 F PSUM=1:1:PSUMC D

 . S X=PSUDIV,DIC=40.8,DIC(0)="X",D="C" D IX^DIC ;**1

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

 . S ^XTMP("PSU_"_PSUJOB,"DIV",PSUDIV)=PSUDIVNM

 . I '$D(PSUUDFLG) S XMSUB="V. 4.0 PBMUD "_PSUMON_" "_PSUM_"/"_PSUMC_" "_PSUDIV_" "_PSUDIVNM

 . I $D(PSUUDFLG) S XMSUB="V. 4.0 PBMUD "_PSUMON_" "_PSUDIV_" "_PSUDIVNM

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

 . S XMDUZ=DUZ

 . M XMY=PSUXMY

 . S XMCHAN=1

 . M XMY=PSUXMY

 . I PSUMASF!PSUDUZ!PSUPBMG D ^XMD

 ;

 S PSUMSG("M")=PSUMC

 S PSUMSG("L")=PSUTLC

 Q

 ;

PSUUD4    ;BIR/TJH - PBM UNIT DOSE EMAIL GENERATOR ;10 JUL 1999

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

 +2       ;DBIA(s)

 +3       ; Reference to file #4.3  supported by DBIA 2496,2596

 +4       ; Reference to file #40.8 supported by DBIA 2438

 +5       ;

 +6       ;PSULC  = Line processing in ^tmp

 +7       ;PSUTLC = Total Line count

 +8       ;PSUMC  = Message counter

 +9       ;PSUMLC = Message Line Counter

 +10      ; RETURNS 

 +11      ;PSUMSG("M") = # Messages

 +12      ;PSUMSG("L") = # Lines

 +13      ;

EN(PSUMSGT) ;Scan and process for Division(s)

 +1       ; PSUMSGT ("M")= # MESSAGES  ("L")= # LINES

 +2       ;

 +3        SET PSUDIV=0

           SET Z=0

           SET PSUUDSUB="PSUUD_"_PSUJOB

 +4        FOR 

               SET PSUDIV=$ORDER(^XTMP(PSUUDSUB,"RECORDS",PSUDIV))

               IF PSUDIV=""

                   QUIT 

               Begin DoDot:1

 +5       ; ==> process one division

                   DO XMD^PSUUD4(.Z)

 +6                SET PSUMSGT(PSUDIV,PSUOPTN,"M")=$GET(PSUMSGT(PSUDIV,PSUOPTN,"M"))+Z("M")

 +7                SET PSUMSGT(PSUDIV,PSUOPTN,"L")=$GET(PSUMSGT(PSUDIV,PSUOPTN,"L"))+Z("L")

               End DoDot:1

 +8        QUIT 

XMD(PSUMSG) ;EP returns PSUMSG("M")= # MESSAGES ("L")= # LINES

 +1        NEW PSUMAX,PSULC,PSUTMC,PSUTLC,PSUMC

 +2       ; Scan TMP, split lines, transmit per MAX lines in Netmail

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

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

 +5       ;

 +6       ;   Split and store into ^XTMP(PSUUDSUB,"XMD",PSUMC,PSUMLC)

 +7        KILL ^XTMP(PSUUDSUB,"XMD")

 +8        SET PSUMC=1

           SET PSUMLC=0

 +9        FOR PSULC=1:1

               SET X=$GET(^XTMP(PSUUDSUB,"RECORDS",PSUDIV,PSULC))

               IF X=""

                   QUIT 

               Begin DoDot:1

 +10               SET PSUMLC=PSUMLC+1

 +11      ; +  message

                   IF PSUMLC>PSUMAX

                       SET PSUMC=PSUMC+1

                       SET PSUMLC=0

                       SET PSULC=PSULC-1

                       QUIT 

 +12               IF $LENGTH(X)<235

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

                       QUIT 

 +13               FOR I=235:-1:1

                       SET Z=$EXTRACT(X,I)

                       IF Z="^"

                           QUIT 

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

 +15               SET PSUMLC=PSUMLC+1

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

               End DoDot:1

 +17      ;   Count Lines sent

 +18       SET PSUTLC=0

 +19       FOR PSUM=1:1:PSUMC

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

               SET PSUTLC=PSUTLC+X

 +20      ;   Transmit Messages

VARS      ; Setup variables for contents

 +1       ;

 +2        FOR PSUM=1:1:PSUMC

               Begin DoDot:1

 +3       ;**1

                   SET X=PSUDIV

                   SET DIC=40.8

                   SET DIC(0)="X"

                   SET D="C"

                   DO IX^DIC

 +4                SET X=+Y

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

 +5                SET ^XTMP("PSU_"_PSUJOB,"DIV",PSUDIV)=PSUDIVNM

 +6                IF '$DATA(PSUUDFLG)

                       SET XMSUB="V. 4.0 PBMUD "_PSUMON_" "_PSUM_"/"_PSUMC_" "_PSUDIV_" "_PSUDIVNM

 +7                IF $DATA(PSUUDFLG)

                       SET XMSUB="V. 4.0 PBMUD "_PSUMON_" "_PSUDIV_" "_PSUDIVNM

 +8                SET XMTEXT="^XTMP(PSUUDSUB,""XMD"",PSUM,"

 +9                SET XMDUZ=DUZ

 +10               MERGE XMY=PSUXMY

 +11               SET XMCHAN=1

 +12               MERGE XMY=PSUXMY

 +13               IF PSUMASF!PSUDUZ!PSUPBMG

                       DO ^XMD

               End DoDot:1

 +14      ;

 +15       SET PSUMSG("M")=PSUMC

 +16       SET PSUMSG("L")=PSUTLC

 +17       QUIT 

 +18      ;