| 1 | PSUCSR0 ;BIR/DJM,DJE - Extract records for CS ;25 AUG 1998
 | 
|---|
| 2 |  ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
 | 
|---|
| 3 |  ;
 | 
|---|
| 4 |  ; 3.2.11.34 Functional Requirement 34
 | 
|---|
| 5 |  ;-------------------------------------
 | 
|---|
| 6 |  ;
 | 
|---|
| 7 |  ; 3.2.11.35 Functional Requirement 35
 | 
|---|
| 8 |  ;-------------------------------------
 | 
|---|
| 9 |  ;DBIA(S)
 | 
|---|
| 10 |  ; Reference to file #4.3  supported by DBIA 2496
 | 
|---|
| 11 |  ; Reference to file #40.8 supported by DBIA 2438
 | 
|---|
| 12 |  ;
 | 
|---|
| 13 |  ; ----- SEE SPECS FOR DETAIL
 | 
|---|
| 14 |  ;
 | 
|---|
| 15 | EN(PSUMSG) ;Scan and process for Division(s)
 | 
|---|
| 16 |  ; PSUMSGT ("M")= # MESSAGES  ("L")= # LINES
 | 
|---|
| 17 |  ;
 | 
|---|
| 18 | TEST S Y=PSUSDT\1 X ^DD("DD") S PSUDTS=Y ;    start date
 | 
|---|
| 19 |  S Y=PSUEDT\1 X ^DD("DD") S PSUDTE=Y ;    end date
 | 
|---|
| 20 |  S PSUDUZ=$G(PSUDUZ,DUZ)
 | 
|---|
| 21 |  S PSUDIV=0,Z=0
 | 
|---|
| 22 |  S:'$D(PSUCSJB) PSUCSJB="PSUCS_"_PSUJOB
 | 
|---|
| 23 |  S PSUMC=0 ; No messages set yet
 | 
|---|
| 24 |  K ^XTMP(PSUCSJB,"MAIL")
 | 
|---|
| 25 |  K ^XTMP(PSUCSJB,"REPORT")
 | 
|---|
| 26 |  K ^XTMP(PSUCSJB,"CSFR-37")
 | 
|---|
| 27 |  S PSUXMY(DUZ)="" ; *** TESTING
 | 
|---|
| 28 |  I '$D(PSUXMY) S PSUXMY(PSUDUZ)="" ; THIS IS WHO WE MAIL TO
 | 
|---|
| 29 |  N Z ; Z used to pass back "CONFIRM" numbers
 | 
|---|
| 30 |  F  S PSUDIV=$O(^XTMP(PSUCSJB,"RECORDS",PSUDIV)) Q:PSUDIV=""  D
 | 
|---|
| 31 |  . S PSUMSEQ=0
 | 
|---|
| 32 |  . D DIV(.Z) ; Process a single divisions data extract
 | 
|---|
| 33 |  . D SUMMRY^PSUCSR1(.Z) ; Send the summary report(s)
 | 
|---|
| 34 |  ; PSUMC holding a variable
 | 
|---|
| 35 |  I PSUMC=0 D  ; No data to send messages
 | 
|---|
| 36 |  . S PSUMSEQ=0,PSUDIV=PSUSNDR
 | 
|---|
| 37 |  . D DIV(.Z)
 | 
|---|
| 38 |  . D SUMMRY^PSUCSR1(.Z)
 | 
|---|
| 39 |  D VARS("MAIL",1,PSUMC)
 | 
|---|
| 40 |  M ^XTMP("PSU_"_$G(PSUJOB,$J),"CONFIRM")=Z
 | 
|---|
| 41 |  Q
 | 
|---|
| 42 |  ; 3.2.11.36 Functional Requirement 36
 | 
|---|
| 43 |  ;-------------------------------------
 | 
|---|
| 44 |  ;
 | 
|---|
| 45 |  ; 3.2.11.37 Functional Requirement 37
 | 
|---|
| 46 |  ;-------------------------------------
 | 
|---|
| 47 |  ;
 | 
|---|
| 48 |  ;
 | 
|---|
| 49 | DIV(PSUMSG) ;EP returns PSUMSG("M")= # MESSAGES ("L")= # LINES
 | 
|---|
| 50 |  ; Scan TMP, split lines, transmit per MAX lines in Netmail
 | 
|---|
| 51 |  S PSUMAX=$$VAL^PSUTL(4.3,1,8.3)
 | 
|---|
| 52 |  S PSUMAX=$S(PSUMAX="":10000,PSUMAX>10000:10000,1:PSUMAX)
 | 
|---|
| 53 |  ;
 | 
|---|
| 54 |  ;   Split and store into ^XTMP(PSUCSJB,"MAIL",PSUMC,PSUMLC)
 | 
|---|
| 55 |  S PSUOMC=PSUMC,PSUMC=PSUMC+1,PSUMSEQ=PSUMSEQ+1,PSUMLC=0
 | 
|---|
| 56 |  K ^XTMP(PSUCSJB,"MAIL",PSUMC)
 | 
|---|
| 57 |  S PSUTIEN="",PSULC=0,PSUTLC=0
 | 
|---|
| 58 |  F  S PSUTIEN=$O(^XTMP(PSUCSJB,"RECORDS",PSUDIV,PSUTIEN)) Q:PSUTIEN=""  D
 | 
|---|
| 59 |  . S PSULC=PSULC+1
 | 
|---|
| 60 |  . S PSURC=$O(^XTMP(PSUCSJB,"RECORDS",PSUDIV,PSUTIEN,""))
 | 
|---|
| 61 |  . S X=$G(^XTMP(PSUCSJB,"RECORDS",PSUDIV,PSUTIEN,PSURC))
 | 
|---|
| 62 |  . D EN^PSUCSR1 ; Prepare data for next report (drug breakdown)
 | 
|---|
| 63 |  . Q:$G(PSUSMRY)  ; Only do a summary
 | 
|---|
| 64 |  . I $G(PSUMASF)!$G(PSUDUZ)!$G(PSUPBMG) D  ; Detail to Hines,self,group
 | 
|---|
| 65 |  .. S PSUMLC=PSUMLC+1,PSUTLC=PSUTLC+1
 | 
|---|
| 66 |  .. I PSUMLC>PSUMAX S PSUMC=PSUMC+1,PSUMLC=0,PSULC=PSULC+1 Q  ; +  message
 | 
|---|
| 67 |  .. I $L(X)<235 S ^XTMP(PSUCSJB,"MAIL",PSUMC,PSUMLC)=X Q
 | 
|---|
| 68 |  .. F I=235:-1:1 S Z=$E(X,I) Q:Z="^"
 | 
|---|
| 69 |  .. S ^XTMP(PSUCSJB,"MAIL",PSUMC,PSUMLC)=$E(X,1,I)
 | 
|---|
| 70 |  .. S PSUMLC=PSUMLC+1
 | 
|---|
| 71 |  .. S ^XTMP(PSUCSJB,"MAIL",PSUMC,PSUMLC)="*"_$E(X,I+1,999)
 | 
|---|
| 72 |  ; Go mail the message now
 | 
|---|
| 73 |  ;I '$G(PSUMASF) S PSUMC=PSUMC-1 Q  ; Do not update the master file, commented out to send detailed message to user DAM
 | 
|---|
| 74 |  I PSUMLC=0 D
 | 
|---|
| 75 |  . S PSUMLC=PSUMLC+1
 | 
|---|
| 76 |  . S ^XTMP(PSUCSJB,"MAIL",PSUMC,PSUMLC)="No data to report"
 | 
|---|
| 77 |  S ^XTMP(PSUCSJB,"MAIL",PSUMC)=PSUDIV
 | 
|---|
| 78 |  S ^XTMP(PSUCSJB,"DETAIL",PSUMC)=PSUMSEQ_"/"_(PSUMC-PSUOMC)
 | 
|---|
| 79 |  S PSUMSG(PSUDIV,6,"M")=$G(PSUMSG(PSUDIV,6,"M"))+(PSUMC-PSUOMC)
 | 
|---|
| 80 |  S PSUMSG(PSUDIV,6,"L")=$G(PSUMSG(PSUDIV,6,"L"))+PSUMLC
 | 
|---|
| 81 |  Q
 | 
|---|
| 82 |  ;
 | 
|---|
| 83 | VARS(PSUMMS,S,E) ; Setup variables for contents
 | 
|---|
| 84 |  S PSUMC=0,PSUTLC=0
 | 
|---|
| 85 |  S XMDUZ=PSUDUZ
 | 
|---|
| 86 |  F PSUM=S:1:E D
 | 
|---|
| 87 |  . Q:'$D(^XTMP(PSUCSJB,"MAIL",PSUM))
 | 
|---|
| 88 |  . S PSUMC=PSUMC+1
 | 
|---|
| 89 |  . S PSUMLC=$O(^XTMP(PSUCSJB,"MAIL",PSUM,""),-1),PSUTLC=PSUTLC+PSUMLC
 | 
|---|
| 90 |  . S PSUDIV=^XTMP(PSUCSJB,"MAIL",PSUM)
 | 
|---|
| 91 |  . I $D(^XTMP(PSUCSJB,"DETAIL",PSUM)) M XMY=PSUXMYH
 | 
|---|
| 92 |  . I $D(^XTMP(PSUCSJB,"SUMMARY 1",PSUM)) M XMY=PSUXMYS1
 | 
|---|
| 93 |  . I $D(^XTMP(PSUCSJB,"SUMMARY 2",PSUM)) M XMY=PSUXMYS2
 | 
|---|
| 94 |  . S X=PSUDIV,DIC=40.8,DIC(0)="X",D="C" D IX^DIC ;**1
 | 
|---|
| 95 |  . S X=+Y S PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
 | 
|---|
| 96 |  . S PSUMSEQ=$G(^XTMP(PSUCSJB,"DETAIL",PSUM)) ; Get the mail sequence data
 | 
|---|
| 97 |  . S PSUMSEQ=$S(PSUMSEQ="":" ",1:" "_PSUMSEQ_" ")
 | 
|---|
| 98 |  . S XMSUB="V. 4.0 PBMCS "_PSUMON_PSUMSEQ_PSUDIV_" "_PSUDIVNM
 | 
|---|
| 99 |  . S XMTEXT="^XTMP(PSUCSJB,PSUMMS,PSUM,"
 | 
|---|
| 100 |  . S XMCHAN=1
 | 
|---|
| 101 |  . D ^XMD
 | 
|---|
| 102 |  ;
 | 
|---|
| 103 |  Q
 | 
|---|