PSULR4 ;BIR/PDW - PBMS LABORATORY EMAIL GENERATOR ;10 JUL 1999
;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
;
;DBIA(s)
; Reference to file #4.3 supported by DBIA 2496,10091
; 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
;
;I '$G(PSUMASF) Q ;Comment out so user can get detailed msg
;regardless of whether they send to Hines or not
;
;
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
;
I '$D(^XTMP(PSULRSUB,"RECORDS")) G NODATA
DIV ; Scan by division and send divisional messages
;
S PSUDIV="" F S PSUDIV=$O(^XTMP(PSULRSUB,"RECORDS",PSUDIV)) Q:PSUDIV="" D MSG
Q
;
MSG ;EP Send divisional message
; Split and store into ^XTMP(PSULRSUB,"MESSAGE",PSUMC,PSULC)
K ^XTMP(PSULRSUB,"MESSAGE")
S PSUMC=1,PSUMLC=0
F PSULC=1:1 S X=$G(^XTMP(PSULRSUB,"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(PSULRSUB,"MESSAGE",PSUMC,PSUMLC)=X Q
. F I=235:-1:1 S Z=$E(X,I) Q:Z="^"
. S ^XTMP(PSULRSUB,"MESSAGE",PSUMC,PSUMLC)=$E(X,1,I)
. S PSUMLC=PSUMLC+1
. S ^XTMP(PSULRSUB,"MESSAGE",PSUMC,PSUMLC)="*"_$E(X,I+1,999)
;
; Count Lines sent
S PSUTLC=0
F PSUM=1:1:PSUMC S X=$O(^XTMP(PSULRSUB,"MESSAGE",PSUM,""),-1),PSUTLC=PSUTLC+X
;
S PSUMSG(PSUDIV,13,"M")=+$G(PSUMSG(PSUDIV,13,"M"))+PSUMC
S PSUMSG(PSUDIV,13,"L")=+$G(PSUMSG(PSUDIV,13,"L"))+PSUTLC
TRANS ;EP Transmit Messages
VARS ; Setup variables for contents
;
I $D(^XTMP("PSU_"_PSUJOB,"DIV",PSUDIV)) D Q
.F PSUM=1:1:PSUMC D
..S PSUDIVNM=$P(^XTMP("PSU_"_PSUJOB,"DIV",PSUDIV),U,1)
..S XMSUB="V. 4.0 PBMLR "_$G(PSUMON)_" "_PSUM_"/"_PSUMC_" "_PSUDIV_" "_PSUDIVNM
..S XMDUZ=DUZ
..S XMTEXT="^XTMP(PSULRSUB,""MESSAGE"",PSUM,"
..M XMY=PSUXMYH
..S XMCHAN=1
..I $G(PSUMASF)!$G(PSUDUZ)!$G(PSUPBMG) D
...I PSUSMRY'=1 D ^XMD
;
; Loop through messages generated and transmit them
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 PBMLR "_$G(PSUMON)_" "_PSUM_"/"_PSUMC_" "_PSUDIV_" "_PSUDIVNM
. S XMDUZ=DUZ
. S XMTEXT="^XTMP(PSULRSUB,""MESSAGE"",PSUM,"
. M XMY=PSUXMYH
. S XMCHAN=1
. ;I $G(PSUMASF) D ^XMD
. I $G(PSUMASF)!$G(PSUDUZ)!$G(PSUPBMG) D
..I PSUSMRY'=1 D ^XMD
;
Q
NODATA ;EP transmit NO DATA FOUND
S X=$$VALI^PSUTL(4.3,1,217),PSUSNDR=+$$VAL^PSUTL(4,X,99)
S PSUDIV=PSUSNDR
S PSUMSG(PSUDIV,13,"M")=$G(PSUMASF),PSUMSG(PSUDIV,13,"L")=0
S XMDUZ=DUZ
M XMY=PSUXMYH
S PSUM=1,PSUMC=1
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 PBMLR "_$G(PSUMON)_" "_PSUM_"/"_PSUMC_" "_PSUDIV_" "_PSUDIVNM
S X(1)="No data to report"
S XMTEXT="X("
S XMCHAN=1
I $G(PSUMASF)!$G(PSUPBMG)!$G(PSUDUZ) D ^XMD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSULR4 3224 printed Dec 13, 2024@02:27:57 Page 2
PSULR4 ;BIR/PDW - PBMS LABORATORY EMAIL GENERATOR ;10 JUL 1999
+1 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
+2 ;
+3 ;DBIA(s)
+4 ; Reference to file #4.3 supported by DBIA 2496,10091
+5 ; Reference to file #40.8 supported by DBIA 2438
+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(PSUMSG) ;Scan and process for Division(s)
+1 ; PSUMSGT ("M")= # MESSAGES ("L")= # LINES
+2 ;
+3 ;I '$G(PSUMASF) Q ;Comment out so user can get detailed msg
+4 ;regardless of whether they send to Hines or not
+5 ;
+6 ;
+7 NEW PSUMAX,PSULC,PSUTMC,PSUTLC,PSUMC
+8 ; Scan TMP, split lines, transmit per MAX lines in Netmail
+9 SET PSUMAX=$$VAL^PSUTL(4.3,1,8.3)
+10 if PSUMAX'>0
SET PSUMAX=10000
+11 ;
+12 IF '$DATA(^XTMP(PSULRSUB,"RECORDS"))
GOTO NODATA
DIV ; Scan by division and send divisional messages
+1 ;
+2 SET PSUDIV=""
FOR
SET PSUDIV=$ORDER(^XTMP(PSULRSUB,"RECORDS",PSUDIV))
if PSUDIV=""
QUIT
DO MSG
+3 QUIT
+4 ;
MSG ;EP Send divisional message
+1 ; Split and store into ^XTMP(PSULRSUB,"MESSAGE",PSUMC,PSULC)
+2 KILL ^XTMP(PSULRSUB,"MESSAGE")
+3 SET PSUMC=1
SET PSUMLC=0
+4 FOR PSULC=1:1
SET X=$GET(^XTMP(PSULRSUB,"RECORDS",PSUDIV,PSULC))
if X=""
QUIT
Begin DoDot:1
+5 SET PSUMLC=PSUMLC+1
+6 ; + message
IF PSUMLC>PSUMAX
SET PSUMC=PSUMC+1
SET PSUMLC=0
SET PSULC=PSULC-1
QUIT
+7 IF $LENGTH(X)<235
SET ^XTMP(PSULRSUB,"MESSAGE",PSUMC,PSUMLC)=X
QUIT
+8 FOR I=235:-1:1
SET Z=$EXTRACT(X,I)
if Z="^"
QUIT
+9 SET ^XTMP(PSULRSUB,"MESSAGE",PSUMC,PSUMLC)=$EXTRACT(X,1,I)
+10 SET PSUMLC=PSUMLC+1
+11 SET ^XTMP(PSULRSUB,"MESSAGE",PSUMC,PSUMLC)="*"_$EXTRACT(X,I+1,999)
End DoDot:1
+12 ;
+13 ; Count Lines sent
+14 SET PSUTLC=0
+15 FOR PSUM=1:1:PSUMC
SET X=$ORDER(^XTMP(PSULRSUB,"MESSAGE",PSUM,""),-1)
SET PSUTLC=PSUTLC+X
+16 ;
+17 SET PSUMSG(PSUDIV,13,"M")=+$GET(PSUMSG(PSUDIV,13,"M"))+PSUMC
+18 SET PSUMSG(PSUDIV,13,"L")=+$GET(PSUMSG(PSUDIV,13,"L"))+PSUTLC
TRANS ;EP Transmit Messages
VARS ; Setup variables for contents
+1 ;
+2 IF $DATA(^XTMP("PSU_"_PSUJOB,"DIV",PSUDIV))
Begin DoDot:1
+3 FOR PSUM=1:1:PSUMC
Begin DoDot:2
+4 SET PSUDIVNM=$PIECE(^XTMP("PSU_"_PSUJOB,"DIV",PSUDIV),U,1)
+5 SET XMSUB="V. 4.0 PBMLR "_$GET(PSUMON)_" "_PSUM_"/"_PSUMC_" "_PSUDIV_" "_PSUDIVNM
+6 SET XMDUZ=DUZ
+7 SET XMTEXT="^XTMP(PSULRSUB,""MESSAGE"",PSUM,"
+8 MERGE XMY=PSUXMYH
+9 SET XMCHAN=1
+10 IF $GET(PSUMASF)!$GET(PSUDUZ)!$GET(PSUPBMG)
Begin DoDot:3
+11 IF PSUSMRY'=1
DO ^XMD
End DoDot:3
End DoDot:2
End DoDot:1
QUIT
+12 ;
+13 ; Loop through messages generated and transmit them
+14 FOR PSUM=1:1:PSUMC
Begin DoDot:1
+15 ;**1
SET X=PSUDIV
SET DIC=40.8
SET DIC(0)="X"
SET D="C"
DO IX^DIC
+16 SET X=+Y
SET PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
+17 SET XMSUB="V. 4.0 PBMLR "_$GET(PSUMON)_" "_PSUM_"/"_PSUMC_" "_PSUDIV_" "_PSUDIVNM
+18 SET XMDUZ=DUZ
+19 SET XMTEXT="^XTMP(PSULRSUB,""MESSAGE"",PSUM,"
+20 MERGE XMY=PSUXMYH
+21 SET XMCHAN=1
+22 ;I $G(PSUMASF) D ^XMD
+23 IF $GET(PSUMASF)!$GET(PSUDUZ)!$GET(PSUPBMG)
Begin DoDot:2
+24 IF PSUSMRY'=1
DO ^XMD
End DoDot:2
End DoDot:1
+25 ;
+26 QUIT
NODATA ;EP transmit NO DATA FOUND
+1 SET X=$$VALI^PSUTL(4.3,1,217)
SET PSUSNDR=+$$VAL^PSUTL(4,X,99)
+2 SET PSUDIV=PSUSNDR
+3 SET PSUMSG(PSUDIV,13,"M")=$GET(PSUMASF)
SET PSUMSG(PSUDIV,13,"L")=0
+4 SET XMDUZ=DUZ
+5 MERGE XMY=PSUXMYH
+6 SET PSUM=1
SET PSUMC=1
+7 ;**1
SET X=PSUDIV
SET DIC=40.8
SET DIC(0)="X"
SET D="C"
DO IX^DIC
+8 SET X=+Y
SET PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
+9 SET XMSUB="V. 4.0 PBMLR "_$GET(PSUMON)_" "_PSUM_"/"_PSUMC_" "_PSUDIV_" "_PSUDIVNM
+10 SET X(1)="No data to report"
+11 SET XMTEXT="X("
+12 SET XMCHAN=1
+13 IF $GET(PSUMASF)!$GET(PSUPBMG)!$GET(PSUDUZ)
DO ^XMD
+14 QUIT
