- 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 Feb 18, 2025@23:53:59 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