PSUAR3.m

PSUAR3 ;BIR/PDW - PBM AR/WS EXTRACT DETAILED MAIL GENERATOR ; 1/12/09 12:12pm

 ;;4.0;PHARMACY BENEFITS MANAGEMENT;**15**;MARCH, 2005;Build 2

 ; DBIA(s)

 ; Reference to file  #4.3 supported by DBIA 2496

 ; 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(PSUMSG) ;Scan and process for Division(s)

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

 ;

 ;   restore variables

 S PSUVARS="PSUSDT,PSUEDT,PSUMON,PSUDUZ,PSUMASF,PSUPBMG,PSUSMRY,ZTIO,PSUSNDR,PSUOPTS"

 F I=1:1:$L(PSUVARS,",") S @$P(PSUVARS,",",I)=$P(^XTMP("PSU_"_PSUJOB,1),U,I)

 ;S PSUMSG(PSUDIV,3,"M")=0,PSUMSG("L")=0

 I $G(PSUMASF)!$G(PSUDUZ)!$G(PSUPBMG) D

 .I '$D(^XTMP(PSUARSUB,"RECORDS")) D NODATA Q

 .S PSUDIV=0,Z=0

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

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

 .. S PSUMSG(PSUDIV,3,"M")=$G(PSUMSG(PSUDIV,3,"M"))+Z("M")

 .. S PSUMSG(PSUDIV,3,"L")=$G(PSUMSG(PSUDIV,3,"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'>0 PSUMAX=10000

 ;

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

 K ^XTMP(PSUARSUB,"XMD")

 S PSUMC=1,PSUMLC=0

 F PSULC=1:1 S X=$G(^XTMP(PSUARSUB,"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(PSUARSUB,"XMD",PSUMC,PSUMLC)=X Q

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

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

 . S PSUMLC=PSUMLC+1

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

 ;

 ;   Count Lines sent

 S PSUTLC=0

 F PSUM=1:1:PSUMC S X=$O(^XTMP(PSUARSUB,"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 XMSUB="V. 4.0 PBMAR "_$G(PSUMON)_" "_PSUM_"/"_PSUMC_" "_PSUDIV_" "_PSUDIVNM

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

 . S XMDUZ=DUZ

 . M XMY=PSUXMYH

 . S XMCHAN=1

 . I $G(PSUMASF)!$G(PSUDUZ)!$G(PSUPBMG) D

 ..I '$G(PSUSMRY) D ^XMD

 ;

 S PSUMSG("M")=PSUMC

 S PSUMSG("L")=PSUTLC

 M ^XTMP(PSUARSUB,"MSGCOUNT")=PSUMSG ; 

 Q

 ;

NODATA ;EP Build a NODATA Message

 S PSUDIV=PSUSNDR

 S PSUMSG(PSUDIV,11,"M")=PSUMASF,PSUMSG(PSUDIV,11,"L")=0

 S XMDUZ=DUZ

 M XMY=PSUXMYH

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

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

 S PSUM=1,PSUMC=1

 ;PSU*4*15

 S XMSUB="V. 4.0 PBMAR "_$G(PSUMON)_" "_PSUM_"/"_PSUMC_" "_PSUDIV_" "_PSUDIVNM

 N X

 S X(1)="No data to report"

 S XMTEXT="X("

 S XMCHAN=1

 ;I $G(PSUMASF) D ^XMD

 D ^XMD

 S PSUMSG(PSUDIV,3,"M")=1,PSUMSG(PSUDIV,3,"L")=0

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PSUAR3   3014     printed  Mar 13, 2025@21:31:52                                                                                                                                                                                                      Page 2

PSUAR3    ;BIR/PDW - PBM AR/WS EXTRACT DETAILED MAIL GENERATOR ; 1/12/09 12:12pm

 +1       ;;4.0;PHARMACY BENEFITS MANAGEMENT;**15**;MARCH, 2005;Build 2

 +2       ; DBIA(s)

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

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

 +5       ;PSULC  = Line processing in ^tmp

 +6       ;PSUTLC = Total Line count

 +7       ;PSUMC  = Message counter

 +8       ;PSUMLC = Message Line Counter

 +9       ; RETURNS 

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

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

 +12      ;

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

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

 +2       ;

 +3       ;   restore variables

 +4        SET PSUVARS="PSUSDT,PSUEDT,PSUMON,PSUDUZ,PSUMASF,PSUPBMG,PSUSMRY,ZTIO,PSUSNDR,PSUOPTS"

 +5        FOR I=1:1:$LENGTH(PSUVARS,",")

               SET @$PIECE(PSUVARS,",",I)=$PIECE(^XTMP("PSU_"_PSUJOB,1),U,I)

 +6       ;S PSUMSG(PSUDIV,3,"M")=0,PSUMSG("L")=0

 +7        IF $GET(PSUMASF)!$GET(PSUDUZ)!$GET(PSUPBMG)

               Begin DoDot:1

 +8                IF '$DATA(^XTMP(PSUARSUB,"RECORDS"))

                       DO NODATA

                       QUIT 

 +9                SET PSUDIV=0

                   SET Z=0

 +10               FOR 

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

                       if PSUDIV=""

                           QUIT 

                       Begin DoDot:2

 +11      ; ==> process one division

                           DO XMD^PSUAR3(.Z)

 +12                       SET PSUMSG(PSUDIV,3,"M")=$GET(PSUMSG(PSUDIV,3,"M"))+Z("M")

 +13                       SET PSUMSG(PSUDIV,3,"L")=$GET(PSUMSG(PSUDIV,3,"L"))+Z("L")

                       End DoDot:2

               End DoDot:1

 +14       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        if PSUMAX'>0

               SET PSUMAX=10000

 +5       ;

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

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

 +8        SET PSUMC=1

           SET PSUMLC=0

 +9        FOR PSULC=1:1

               SET X=$GET(^XTMP(PSUARSUB,"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(PSUARSUB,"XMD",PSUMC,PSUMLC)=X

                       QUIT 

 +13               FOR I=235:-1:1

                       SET Z=$EXTRACT(X,I)

                       if Z="^"

                           QUIT 

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

 +15               SET PSUMLC=PSUMLC+1

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

               End DoDot:1

 +17      ;

 +18      ;   Count Lines sent

 +19       SET PSUTLC=0

 +20       FOR PSUM=1:1:PSUMC

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

               SET PSUTLC=PSUTLC+X

 +21      ;

 +22      ;   Transmit Messages

VARS      ; Setup variables for contents

 +1        FOR PSUM=1:1:PSUMC

               Begin DoDot:1

 +2       ;**1

                   SET X=PSUDIV

                   SET DIC=40.8

                   SET DIC(0)="X"

                   SET D="C"

                   DO IX^DIC

 +3                SET X=+Y

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

 +4                SET XMSUB="V. 4.0 PBMAR "_$GET(PSUMON)_" "_PSUM_"/"_PSUMC_" "_PSUDIV_" "_PSUDIVNM

 +5                SET XMTEXT="^XTMP(PSUARSUB,""XMD"",PSUM,"

 +6                SET XMDUZ=DUZ

 +7                MERGE XMY=PSUXMYH

 +8                SET XMCHAN=1

 +9                IF $GET(PSUMASF)!$GET(PSUDUZ)!$GET(PSUPBMG)

                       Begin DoDot:2

 +10                       IF '$GET(PSUSMRY)

                               DO ^XMD

                       End DoDot:2

               End DoDot:1

 +11      ;

 +12       SET PSUMSG("M")=PSUMC

 +13       SET PSUMSG("L")=PSUTLC

 +14      ; 

           MERGE ^XTMP(PSUARSUB,"MSGCOUNT")=PSUMSG

 +15       QUIT 

 +16      ;

NODATA    ;EP Build a NODATA Message

 +1        SET PSUDIV=PSUSNDR

 +2        SET PSUMSG(PSUDIV,11,"M")=PSUMASF

           SET PSUMSG(PSUDIV,11,"L")=0

 +3        SET XMDUZ=DUZ

 +4        MERGE XMY=PSUXMYH

 +5       ;**1

           SET (X,PSUDIV)=PSUSNDR

           SET DIC=40.8

           SET DIC(0)="X"

           SET D="C"

           DO IX^DIC

 +6        SET X=+Y

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

 +7        SET PSUM=1

           SET PSUMC=1

 +8       ;PSU*4*15

 +9        SET XMSUB="V. 4.0 PBMAR "_$GET(PSUMON)_" "_PSUM_"/"_PSUMC_" "_PSUDIV_" "_PSUDIVNM

 +10       NEW X

 +11       SET X(1)="No data to report"

 +12       SET XMTEXT="X("

 +13       SET XMCHAN=1

 +14      ;I $G(PSUMASF) D ^XMD

 +15       DO ^XMD

 +16       SET PSUMSG(PSUDIV,3,"M")=1

           SET PSUMSG(PSUDIV,3,"L")=0

 +17       QUIT