PSUCSR0 ;BIR/DJM,DJE - Extract records for CS ;25 AUG 1998
;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
;
; 3.2.11.34 Functional Requirement 34
;-------------------------------------
;
; 3.2.11.35 Functional Requirement 35
;-------------------------------------
;DBIA(S)
; Reference to file #4.3 supported by DBIA 2496
; Reference to file #40.8 supported by DBIA 2438
;
; ----- SEE SPECS FOR DETAIL
;
EN(PSUMSG) ;Scan and process for Division(s)
; PSUMSGT ("M")= # MESSAGES ("L")= # LINES
;
TEST S Y=PSUSDT\1 X ^DD("DD") S PSUDTS=Y ; start date
S Y=PSUEDT\1 X ^DD("DD") S PSUDTE=Y ; end date
S PSUDUZ=$G(PSUDUZ,DUZ)
S PSUDIV=0,Z=0
S:'$D(PSUCSJB) PSUCSJB="PSUCS_"_PSUJOB
S PSUMC=0 ; No messages set yet
K ^XTMP(PSUCSJB,"MAIL")
K ^XTMP(PSUCSJB,"REPORT")
K ^XTMP(PSUCSJB,"CSFR-37")
S PSUXMY(DUZ)="" ; *** TESTING
I '$D(PSUXMY) S PSUXMY(PSUDUZ)="" ; THIS IS WHO WE MAIL TO
N Z ; Z used to pass back "CONFIRM" numbers
F S PSUDIV=$O(^XTMP(PSUCSJB,"RECORDS",PSUDIV)) Q:PSUDIV="" D
. S PSUMSEQ=0
. D DIV(.Z) ; Process a single divisions data extract
. D SUMMRY^PSUCSR1(.Z) ; Send the summary report(s)
; PSUMC holding a variable
I PSUMC=0 D ; No data to send messages
. S PSUMSEQ=0,PSUDIV=PSUSNDR
. D DIV(.Z)
. D SUMMRY^PSUCSR1(.Z)
D VARS("MAIL",1,PSUMC)
M ^XTMP("PSU_"_$G(PSUJOB,$J),"CONFIRM")=Z
Q
; 3.2.11.36 Functional Requirement 36
;-------------------------------------
;
; 3.2.11.37 Functional Requirement 37
;-------------------------------------
;
;
DIV(PSUMSG) ;EP returns PSUMSG("M")= # MESSAGES ("L")= # LINES
; Scan TMP, split lines, transmit per MAX lines in Netmail
S PSUMAX=$$VAL^PSUTL(4.3,1,8.3)
S PSUMAX=$S(PSUMAX="":10000,PSUMAX>10000:10000,1:PSUMAX)
;
; Split and store into ^XTMP(PSUCSJB,"MAIL",PSUMC,PSUMLC)
S PSUOMC=PSUMC,PSUMC=PSUMC+1,PSUMSEQ=PSUMSEQ+1,PSUMLC=0
K ^XTMP(PSUCSJB,"MAIL",PSUMC)
S PSUTIEN="",PSULC=0,PSUTLC=0
F S PSUTIEN=$O(^XTMP(PSUCSJB,"RECORDS",PSUDIV,PSUTIEN)) Q:PSUTIEN="" D
. S PSULC=PSULC+1
. S PSURC=$O(^XTMP(PSUCSJB,"RECORDS",PSUDIV,PSUTIEN,""))
. S X=$G(^XTMP(PSUCSJB,"RECORDS",PSUDIV,PSUTIEN,PSURC))
. D EN^PSUCSR1 ; Prepare data for next report (drug breakdown)
. Q:$G(PSUSMRY) ; Only do a summary
. I $G(PSUMASF)!$G(PSUDUZ)!$G(PSUPBMG) D ; Detail to Hines,self,group
.. S PSUMLC=PSUMLC+1,PSUTLC=PSUTLC+1
.. I PSUMLC>PSUMAX S PSUMC=PSUMC+1,PSUMLC=0,PSULC=PSULC+1 Q ; + message
.. I $L(X)<235 S ^XTMP(PSUCSJB,"MAIL",PSUMC,PSUMLC)=X Q
.. F I=235:-1:1 S Z=$E(X,I) Q:Z="^"
.. S ^XTMP(PSUCSJB,"MAIL",PSUMC,PSUMLC)=$E(X,1,I)
.. S PSUMLC=PSUMLC+1
.. S ^XTMP(PSUCSJB,"MAIL",PSUMC,PSUMLC)="*"_$E(X,I+1,999)
; Go mail the message now
;I '$G(PSUMASF) S PSUMC=PSUMC-1 Q ; Do not update the master file, commented out to send detailed message to user DAM
I PSUMLC=0 D
. S PSUMLC=PSUMLC+1
. S ^XTMP(PSUCSJB,"MAIL",PSUMC,PSUMLC)="No data to report"
S ^XTMP(PSUCSJB,"MAIL",PSUMC)=PSUDIV
S ^XTMP(PSUCSJB,"DETAIL",PSUMC)=PSUMSEQ_"/"_(PSUMC-PSUOMC)
S PSUMSG(PSUDIV,6,"M")=$G(PSUMSG(PSUDIV,6,"M"))+(PSUMC-PSUOMC)
S PSUMSG(PSUDIV,6,"L")=$G(PSUMSG(PSUDIV,6,"L"))+PSUMLC
Q
;
VARS(PSUMMS,S,E) ; Setup variables for contents
S PSUMC=0,PSUTLC=0
S XMDUZ=PSUDUZ
F PSUM=S:1:E D
. Q:'$D(^XTMP(PSUCSJB,"MAIL",PSUM))
. S PSUMC=PSUMC+1
. S PSUMLC=$O(^XTMP(PSUCSJB,"MAIL",PSUM,""),-1),PSUTLC=PSUTLC+PSUMLC
. S PSUDIV=^XTMP(PSUCSJB,"MAIL",PSUM)
. I $D(^XTMP(PSUCSJB,"DETAIL",PSUM)) M XMY=PSUXMYH
. I $D(^XTMP(PSUCSJB,"SUMMARY 1",PSUM)) M XMY=PSUXMYS1
. I $D(^XTMP(PSUCSJB,"SUMMARY 2",PSUM)) M XMY=PSUXMYS2
. 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 PSUMSEQ=$G(^XTMP(PSUCSJB,"DETAIL",PSUM)) ; Get the mail sequence data
. S PSUMSEQ=$S(PSUMSEQ="":" ",1:" "_PSUMSEQ_" ")
. S XMSUB="V. 4.0 PBMCS "_PSUMON_PSUMSEQ_PSUDIV_" "_PSUDIVNM
. S XMTEXT="^XTMP(PSUCSJB,PSUMMS,PSUM,"
. S XMCHAN=1
. D ^XMD
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSUCSR0 3983 printed Nov 22, 2024@17:37:40 Page 2
PSUCSR0 ;BIR/DJM,DJE - Extract records for CS ;25 AUG 1998
+1 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
+2 ;
+3 ; 3.2.11.34 Functional Requirement 34
+4 ;-------------------------------------
+5 ;
+6 ; 3.2.11.35 Functional Requirement 35
+7 ;-------------------------------------
+8 ;DBIA(S)
+9 ; Reference to file #4.3 supported by DBIA 2496
+10 ; Reference to file #40.8 supported by DBIA 2438
+11 ;
+12 ; ----- SEE SPECS FOR DETAIL
+13 ;
EN(PSUMSG) ;Scan and process for Division(s)
+1 ; PSUMSGT ("M")= # MESSAGES ("L")= # LINES
+2 ;
TEST ; start date
SET Y=PSUSDT\1
XECUTE ^DD("DD")
SET PSUDTS=Y
+1 ; end date
SET Y=PSUEDT\1
XECUTE ^DD("DD")
SET PSUDTE=Y
+2 SET PSUDUZ=$GET(PSUDUZ,DUZ)
+3 SET PSUDIV=0
SET Z=0
+4 if '$DATA(PSUCSJB)
SET PSUCSJB="PSUCS_"_PSUJOB
+5 ; No messages set yet
SET PSUMC=0
+6 KILL ^XTMP(PSUCSJB,"MAIL")
+7 KILL ^XTMP(PSUCSJB,"REPORT")
+8 KILL ^XTMP(PSUCSJB,"CSFR-37")
+9 ; *** TESTING
SET PSUXMY(DUZ)=""
+10 ; THIS IS WHO WE MAIL TO
IF '$DATA(PSUXMY)
SET PSUXMY(PSUDUZ)=""
+11 ; Z used to pass back "CONFIRM" numbers
NEW Z
+12 FOR
SET PSUDIV=$ORDER(^XTMP(PSUCSJB,"RECORDS",PSUDIV))
if PSUDIV=""
QUIT
Begin DoDot:1
+13 SET PSUMSEQ=0
+14 ; Process a single divisions data extract
DO DIV(.Z)
+15 ; Send the summary report(s)
DO SUMMRY^PSUCSR1(.Z)
End DoDot:1
+16 ; PSUMC holding a variable
+17 ; No data to send messages
IF PSUMC=0
Begin DoDot:1
+18 SET PSUMSEQ=0
SET PSUDIV=PSUSNDR
+19 DO DIV(.Z)
+20 DO SUMMRY^PSUCSR1(.Z)
End DoDot:1
+21 DO VARS("MAIL",1,PSUMC)
+22 MERGE ^XTMP("PSU_"_$GET(PSUJOB,$JOB),"CONFIRM")=Z
+23 QUIT
+24 ; 3.2.11.36 Functional Requirement 36
+25 ;-------------------------------------
+26 ;
+27 ; 3.2.11.37 Functional Requirement 37
+28 ;-------------------------------------
+29 ;
+30 ;
DIV(PSUMSG) ;EP returns PSUMSG("M")= # MESSAGES ("L")= # LINES
+1 ; Scan TMP, split lines, transmit per MAX lines in Netmail
+2 SET PSUMAX=$$VAL^PSUTL(4.3,1,8.3)
+3 SET PSUMAX=$SELECT(PSUMAX="":10000,PSUMAX>10000:10000,1:PSUMAX)
+4 ;
+5 ; Split and store into ^XTMP(PSUCSJB,"MAIL",PSUMC,PSUMLC)
+6 SET PSUOMC=PSUMC
SET PSUMC=PSUMC+1
SET PSUMSEQ=PSUMSEQ+1
SET PSUMLC=0
+7 KILL ^XTMP(PSUCSJB,"MAIL",PSUMC)
+8 SET PSUTIEN=""
SET PSULC=0
SET PSUTLC=0
+9 FOR
SET PSUTIEN=$ORDER(^XTMP(PSUCSJB,"RECORDS",PSUDIV,PSUTIEN))
if PSUTIEN=""
QUIT
Begin DoDot:1
+10 SET PSULC=PSULC+1
+11 SET PSURC=$ORDER(^XTMP(PSUCSJB,"RECORDS",PSUDIV,PSUTIEN,""))
+12 SET X=$GET(^XTMP(PSUCSJB,"RECORDS",PSUDIV,PSUTIEN,PSURC))
+13 ; Prepare data for next report (drug breakdown)
DO EN^PSUCSR1
+14 ; Only do a summary
if $GET(PSUSMRY)
QUIT
+15 ; Detail to Hines,self,group
IF $GET(PSUMASF)!$GET(PSUDUZ)!$GET(PSUPBMG)
Begin DoDot:2
+16 SET PSUMLC=PSUMLC+1
SET PSUTLC=PSUTLC+1
+17 ; + message
IF PSUMLC>PSUMAX
SET PSUMC=PSUMC+1
SET PSUMLC=0
SET PSULC=PSULC+1
QUIT
+18 IF $LENGTH(X)<235
SET ^XTMP(PSUCSJB,"MAIL",PSUMC,PSUMLC)=X
QUIT
+19 FOR I=235:-1:1
SET Z=$EXTRACT(X,I)
if Z="^"
QUIT
+20 SET ^XTMP(PSUCSJB,"MAIL",PSUMC,PSUMLC)=$EXTRACT(X,1,I)
+21 SET PSUMLC=PSUMLC+1
+22 SET ^XTMP(PSUCSJB,"MAIL",PSUMC,PSUMLC)="*"_$EXTRACT(X,I+1,999)
End DoDot:2
End DoDot:1
+23 ; Go mail the message now
+24 ;I '$G(PSUMASF) S PSUMC=PSUMC-1 Q ; Do not update the master file, commented out to send detailed message to user DAM
+25 IF PSUMLC=0
Begin DoDot:1
+26 SET PSUMLC=PSUMLC+1
+27 SET ^XTMP(PSUCSJB,"MAIL",PSUMC,PSUMLC)="No data to report"
End DoDot:1
+28 SET ^XTMP(PSUCSJB,"MAIL",PSUMC)=PSUDIV
+29 SET ^XTMP(PSUCSJB,"DETAIL",PSUMC)=PSUMSEQ_"/"_(PSUMC-PSUOMC)
+30 SET PSUMSG(PSUDIV,6,"M")=$GET(PSUMSG(PSUDIV,6,"M"))+(PSUMC-PSUOMC)
+31 SET PSUMSG(PSUDIV,6,"L")=$GET(PSUMSG(PSUDIV,6,"L"))+PSUMLC
+32 QUIT
+33 ;
VARS(PSUMMS,S,E) ; Setup variables for contents
+1 SET PSUMC=0
SET PSUTLC=0
+2 SET XMDUZ=PSUDUZ
+3 FOR PSUM=S:1:E
Begin DoDot:1
+4 if '$DATA(^XTMP(PSUCSJB,"MAIL",PSUM))
QUIT
+5 SET PSUMC=PSUMC+1
+6 SET PSUMLC=$ORDER(^XTMP(PSUCSJB,"MAIL",PSUM,""),-1)
SET PSUTLC=PSUTLC+PSUMLC
+7 SET PSUDIV=^XTMP(PSUCSJB,"MAIL",PSUM)
+8 IF $DATA(^XTMP(PSUCSJB,"DETAIL",PSUM))
MERGE XMY=PSUXMYH
+9 IF $DATA(^XTMP(PSUCSJB,"SUMMARY 1",PSUM))
MERGE XMY=PSUXMYS1
+10 IF $DATA(^XTMP(PSUCSJB,"SUMMARY 2",PSUM))
MERGE XMY=PSUXMYS2
+11 ;**1
SET X=PSUDIV
SET DIC=40.8
SET DIC(0)="X"
SET D="C"
DO IX^DIC
+12 SET X=+Y
SET PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
+13 ; Get the mail sequence data
SET PSUMSEQ=$GET(^XTMP(PSUCSJB,"DETAIL",PSUM))
+14 SET PSUMSEQ=$SELECT(PSUMSEQ="":" ",1:" "_PSUMSEQ_" ")
+15 SET XMSUB="V. 4.0 PBMCS "_PSUMON_PSUMSEQ_PSUDIV_" "_PSUDIVNM
+16 SET XMTEXT="^XTMP(PSUCSJB,PSUMMS,PSUM,"
+17 SET XMCHAN=1
+18 DO ^XMD
End DoDot:1
+19 ;
+20 QUIT
