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
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSUUD4 2315 printed Oct 16, 2024@18:29:23 Page 2
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 ;
