- 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 Mar 13, 2025@21:32:07 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