Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSULR4

PSULR4.m

Go to the documentation of this file.
  1. PSULR4 ;BIR/PDW - PBMS LABORATORY EMAIL GENERATOR ;10 JUL 1999
  1. ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
  1. ;
  1. ;DBIA(s)
  1. ; Reference to file #4.3 supported by DBIA 2496,10091
  1. ; Reference to file #40.8 supported by DBIA 2438
  1. ;PSULC = Line processing in ^tmp
  1. ;PSUTLC = Total Line count
  1. ;PSUMC = Message counter
  1. ;PSUMLC = Message Line Counter
  1. ; RETURNS
  1. ;PSUMSG("M") = # Messages
  1. ;PSUMSG("L") = # Lines
  1. ;
  1. EN(PSUMSG) ;Scan and process for Division(s)
  1. ; PSUMSGT ("M")= # MESSAGES ("L")= # LINES
  1. ;
  1. ;I '$G(PSUMASF) Q ;Comment out so user can get detailed msg
  1. ;regardless of whether they send to Hines or not
  1. ;
  1. ;
  1. NEW PSUMAX,PSULC,PSUTMC,PSUTLC,PSUMC
  1. ; Scan TMP, split lines, transmit per MAX lines in Netmail
  1. S PSUMAX=$$VAL^PSUTL(4.3,1,8.3)
  1. S:PSUMAX'>0 PSUMAX=10000
  1. ;
  1. I '$D(^XTMP(PSULRSUB,"RECORDS")) G NODATA
  1. DIV ; Scan by division and send divisional messages
  1. ;
  1. S PSUDIV="" F S PSUDIV=$O(^XTMP(PSULRSUB,"RECORDS",PSUDIV)) Q:PSUDIV="" D MSG
  1. Q
  1. ;
  1. MSG ;EP Send divisional message
  1. ; Split and store into ^XTMP(PSULRSUB,"MESSAGE",PSUMC,PSULC)
  1. K ^XTMP(PSULRSUB,"MESSAGE")
  1. S PSUMC=1,PSUMLC=0
  1. F PSULC=1:1 S X=$G(^XTMP(PSULRSUB,"RECORDS",PSUDIV,PSULC)) Q:X="" D
  1. . S PSUMLC=PSUMLC+1
  1. . I PSUMLC>PSUMAX S PSUMC=PSUMC+1,PSUMLC=0,PSULC=PSULC-1 Q ; + message
  1. . I $L(X)<235 S ^XTMP(PSULRSUB,"MESSAGE",PSUMC,PSUMLC)=X Q
  1. . F I=235:-1:1 S Z=$E(X,I) Q:Z="^"
  1. . S ^XTMP(PSULRSUB,"MESSAGE",PSUMC,PSUMLC)=$E(X,1,I)
  1. . S PSUMLC=PSUMLC+1
  1. . S ^XTMP(PSULRSUB,"MESSAGE",PSUMC,PSUMLC)="*"_$E(X,I+1,999)
  1. ;
  1. ; Count Lines sent
  1. S PSUTLC=0
  1. F PSUM=1:1:PSUMC S X=$O(^XTMP(PSULRSUB,"MESSAGE",PSUM,""),-1),PSUTLC=PSUTLC+X
  1. ;
  1. S PSUMSG(PSUDIV,13,"M")=+$G(PSUMSG(PSUDIV,13,"M"))+PSUMC
  1. S PSUMSG(PSUDIV,13,"L")=+$G(PSUMSG(PSUDIV,13,"L"))+PSUTLC
  1. TRANS ;EP Transmit Messages
  1. VARS ; Setup variables for contents
  1. ;
  1. I $D(^XTMP("PSU_"_PSUJOB,"DIV",PSUDIV)) D Q
  1. .F PSUM=1:1:PSUMC D
  1. ..S PSUDIVNM=$P(^XTMP("PSU_"_PSUJOB,"DIV",PSUDIV),U,1)
  1. ..S XMSUB="V. 4.0 PBMLR "_$G(PSUMON)_" "_PSUM_"/"_PSUMC_" "_PSUDIV_" "_PSUDIVNM
  1. ..S XMDUZ=DUZ
  1. ..S XMTEXT="^XTMP(PSULRSUB,""MESSAGE"",PSUM,"
  1. ..M XMY=PSUXMYH
  1. ..S XMCHAN=1
  1. ..I $G(PSUMASF)!$G(PSUDUZ)!$G(PSUPBMG) D
  1. ...I PSUSMRY'=1 D ^XMD
  1. ;
  1. ; Loop through messages generated and transmit them
  1. F PSUM=1:1:PSUMC D
  1. . S X=PSUDIV,DIC=40.8,DIC(0)="X",D="C" D IX^DIC ;**1
  1. . S X=+Y S PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
  1. . S XMSUB="V. 4.0 PBMLR "_$G(PSUMON)_" "_PSUM_"/"_PSUMC_" "_PSUDIV_" "_PSUDIVNM
  1. . S XMDUZ=DUZ
  1. . S XMTEXT="^XTMP(PSULRSUB,""MESSAGE"",PSUM,"
  1. . M XMY=PSUXMYH
  1. . S XMCHAN=1
  1. . ;I $G(PSUMASF) D ^XMD
  1. . I $G(PSUMASF)!$G(PSUDUZ)!$G(PSUPBMG) D
  1. ..I PSUSMRY'=1 D ^XMD
  1. ;
  1. Q
  1. NODATA ;EP transmit NO DATA FOUND
  1. S X=$$VALI^PSUTL(4.3,1,217),PSUSNDR=+$$VAL^PSUTL(4,X,99)
  1. S PSUDIV=PSUSNDR
  1. S PSUMSG(PSUDIV,13,"M")=$G(PSUMASF),PSUMSG(PSUDIV,13,"L")=0
  1. S XMDUZ=DUZ
  1. M XMY=PSUXMYH
  1. S PSUM=1,PSUMC=1
  1. S X=PSUDIV,DIC=40.8,DIC(0)="X",D="C" D IX^DIC ;**1
  1. S X=+Y S PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
  1. S XMSUB="V. 4.0 PBMLR "_$G(PSUMON)_" "_PSUM_"/"_PSUMC_" "_PSUDIV_" "_PSUDIVNM
  1. S X(1)="No data to report"
  1. S XMTEXT="X("
  1. S XMCHAN=1
  1. I $G(PSUMASF)!$G(PSUPBMG)!$G(PSUDUZ) D ^XMD
  1. Q