| 1 | PSUPR4 ;BIR/PDW - PBMS PROCUREMENT EMAIL GENERATOR ;10 JUL 1999
|
|---|
| 2 | ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
|
|---|
| 3 | ;DBIA(s)
|
|---|
| 4 | ; Reference to file #4.3 supported by DBIA 2496
|
|---|
| 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 | ;
|
|---|
| 14 | EN(PSUMSG) ;Scan and process for Division(s)
|
|---|
| 15 | ; PSUMSGT ("M")= # MESSAGES ("L")= # LINES
|
|---|
| 16 | ;
|
|---|
| 17 | I $G(PSUMASF)!$G(PSUDUZ)!$G(PSUPBMG) D
|
|---|
| 18 | .NEW PSUMAX,PSULC,PSUTMC,PSUTLC,PSUMC
|
|---|
| 19 | .; Scan TMP, split lines, transmit per MAX lines in Netmail
|
|---|
| 20 | .S PSUMAX=$$VAL^PSUTL(4.3,1,8.3)
|
|---|
| 21 | .S:PSUMAX'>0 PSUMAX=10000
|
|---|
| 22 | .;
|
|---|
| 23 | .I '$D(^XTMP(PSUPRSUB,"RECORDS")) D NODATA Q
|
|---|
| 24 | DIV .; Scan by division and send divisional messages
|
|---|
| 25 | .;
|
|---|
| 26 | .S PSUDIV="" F S PSUDIV=$O(^XTMP(PSUPRSUB,"RECORDS",PSUDIV)) Q:PSUDIV="" D MSG
|
|---|
| 27 | Q
|
|---|
| 28 | ;
|
|---|
| 29 | MSG ;EP Send divisional message
|
|---|
| 30 | ; Split and store into ^XTMP(PSUPRSUB,"MESSAGE",PSUMC,PSULC)
|
|---|
| 31 | K ^XTMP(PSUPRSUB,"MESSAGE")
|
|---|
| 32 | S PSUMC=1,PSUMLC=0
|
|---|
| 33 | F PSULC=1:1 S X=$G(^XTMP(PSUPRSUB,"RECORDS",PSUDIV,PSULC)) Q:X="" D
|
|---|
| 34 | . I $D(^XTMP(PSUPRSUB,"RECORDS",PSUDIV,PSULC,1)) S X=X_^XTMP(PSUPRSUB,"RECORDS",PSUDIV,PSULC,1)
|
|---|
| 35 | . S PSUMLC=PSUMLC+1
|
|---|
| 36 | . I PSUMLC>PSUMAX S PSUMC=PSUMC+1,PSUMLC=0,PSULC=PSULC+1 Q ; + message
|
|---|
| 37 | . I $L(X)<235 S ^XTMP(PSUPRSUB,"MESSAGE",PSUMC,PSUMLC)=X Q
|
|---|
| 38 | . F I=235:-1:1 S Z=$E(X,I) Q:Z="^"
|
|---|
| 39 | . S Z=$E(X,1,I),X=$E(X,I+1,999)
|
|---|
| 40 | . S ^XTMP(PSUPRSUB,"MESSAGE",PSUMC,PSUMLC)=Z
|
|---|
| 41 | . S PSUMLC=PSUMLC+1
|
|---|
| 42 | . F Q:X="" D
|
|---|
| 43 | .. F I=235:-1:1 S Z=$E(X,I) Q:Z="^"
|
|---|
| 44 | .. S Z=$E(X,1,I),X=$E(X,I+1,999)
|
|---|
| 45 | .. S ^XTMP(PSUPRSUB,"MESSAGE",PSUMC,PSUMLC)="*"_Z
|
|---|
| 46 | .. S PSUMLC=PSUMLC+1
|
|---|
| 47 | ;
|
|---|
| 48 | ; Count Lines sent
|
|---|
| 49 | S PSUTLC=0
|
|---|
| 50 | F PSUM=1:1:PSUMC S X=$O(^XTMP(PSUPRSUB,"MESSAGE",PSUM,""),-1),PSUTLC=PSUTLC+X
|
|---|
| 51 | ;
|
|---|
| 52 | S PSUMSG(PSUDIV,5,"M")=$G(PSUMSG(PSUDIV,5,"M"))+PSUMC
|
|---|
| 53 | S PSUMSG(PSUDIV,5,"L")=$G(PSUMSG(PSUDIV,5,"L"))+PSUTLC
|
|---|
| 54 | ; Transmit Messages
|
|---|
| 55 | VARS ; Setup variables for contents
|
|---|
| 56 | ;
|
|---|
| 57 | ; Loop through messages generated and transmit them
|
|---|
| 58 | F PSUM=1:1:PSUMC D
|
|---|
| 59 | . S X=PSUDIV,DIC=40.8,DIC(0)="X",D="C" D IX^DIC ;**1
|
|---|
| 60 | . S X=+Y S PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
|
|---|
| 61 | . S XMSUB="V. 4.0 PBMPR "_$G(PSUMON)_" "_PSUM_"/"_PSUMC_" "_PSUDIV_" "_PSUDIVNM
|
|---|
| 62 | . S XMTEXT="^XTMP(PSUPRSUB,""MESSAGE"",PSUM,"
|
|---|
| 63 | . S XMDUZ=DUZ
|
|---|
| 64 | . M XMY=PSUXMYH
|
|---|
| 65 | . S XMCHAN=1
|
|---|
| 66 | . I $G(PSUMASF)!$G(PSUDUZ)!$G(PSUPBMG) D
|
|---|
| 67 | ..I '$G(PSUSMRY) D ^XMD
|
|---|
| 68 | ;
|
|---|
| 69 | Q
|
|---|
| 70 | NODATA ;EP transmit NO DATA FOUND
|
|---|
| 71 | S XMDUZ=DUZ
|
|---|
| 72 | M XMY=PSUXMYH
|
|---|
| 73 | S PSUM=1,PSUMC=1
|
|---|
| 74 | S PSUDIV=PSUSNDR
|
|---|
| 75 | S X=PSUDIV,DIC=40.8,DIC(0)="X",D="C" D IX^DIC ;**1
|
|---|
| 76 | S X=+Y S PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
|
|---|
| 77 | S XMSUB="V. 4.0 PBMPR "_$G(PSUMON)_" "_PSUM_"/"_PSUMC_" "_PSUDIV_" "_PSUDIVNM
|
|---|
| 78 | S X(1)="No data to report"
|
|---|
| 79 | S XMTEXT="X("
|
|---|
| 80 | S XMCHAN=1
|
|---|
| 81 | I $G(PSUMASF)!$G(PSUDUZ)!$G(PSUPBMG) D ^XMD
|
|---|
| 82 | S PSUMSG(PSUDIV,5,"M")=1,PSUMSG(PSUDIV,5,"L")=0
|
|---|
| 83 | Q
|
|---|
