- PSUPR4 ;BIR/PDW - PBMS PROCUREMENT EMAIL GENERATOR ;10 JUL 1999
- ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
- ;DBIA(s)
- ; Reference to file #4.3 supported by DBIA 2496
- ; Reference to file #40.8 supported by DBIA 2438
- ;PSULC = Line processing in ^tmp
- ;PSUTLC = Total Line count
- ;PSUMC = Message counter
- ;PSUMLC = Message Line Counter
- ; RETURNS
- ;PSUMSG("M") = # Messages
- ;PSUMSG("L") = # Lines
- ;
- EN(PSUMSG) ;Scan and process for Division(s)
- ; PSUMSGT ("M")= # MESSAGES ("L")= # LINES
- ;
- I $G(PSUMASF)!$G(PSUDUZ)!$G(PSUPBMG) D
- .NEW PSUMAX,PSULC,PSUTMC,PSUTLC,PSUMC
- .; Scan TMP, split lines, transmit per MAX lines in Netmail
- .S PSUMAX=$$VAL^PSUTL(4.3,1,8.3)
- .S:PSUMAX'>0 PSUMAX=10000
- .;
- .I '$D(^XTMP(PSUPRSUB,"RECORDS")) D NODATA Q
- DIV .; Scan by division and send divisional messages
- .;
- .S PSUDIV="" F S PSUDIV=$O(^XTMP(PSUPRSUB,"RECORDS",PSUDIV)) Q:PSUDIV="" D MSG
- Q
- ;
- MSG ;EP Send divisional message
- ; Split and store into ^XTMP(PSUPRSUB,"MESSAGE",PSUMC,PSULC)
- K ^XTMP(PSUPRSUB,"MESSAGE")
- S PSUMC=1,PSUMLC=0
- F PSULC=1:1 S X=$G(^XTMP(PSUPRSUB,"RECORDS",PSUDIV,PSULC)) Q:X="" D
- . I $D(^XTMP(PSUPRSUB,"RECORDS",PSUDIV,PSULC,1)) S X=X_^XTMP(PSUPRSUB,"RECORDS",PSUDIV,PSULC,1)
- . S PSUMLC=PSUMLC+1
- . I PSUMLC>PSUMAX S PSUMC=PSUMC+1,PSUMLC=0,PSULC=PSULC+1 Q ; + message
- . I $L(X)<235 S ^XTMP(PSUPRSUB,"MESSAGE",PSUMC,PSUMLC)=X Q
- . F I=235:-1:1 S Z=$E(X,I) Q:Z="^"
- . S Z=$E(X,1,I),X=$E(X,I+1,999)
- . S ^XTMP(PSUPRSUB,"MESSAGE",PSUMC,PSUMLC)=Z
- . S PSUMLC=PSUMLC+1
- . F Q:X="" D
- .. F I=235:-1:1 S Z=$E(X,I) Q:Z="^"
- .. S Z=$E(X,1,I),X=$E(X,I+1,999)
- .. S ^XTMP(PSUPRSUB,"MESSAGE",PSUMC,PSUMLC)="*"_Z
- .. S PSUMLC=PSUMLC+1
- ;
- ; Count Lines sent
- S PSUTLC=0
- F PSUM=1:1:PSUMC S X=$O(^XTMP(PSUPRSUB,"MESSAGE",PSUM,""),-1),PSUTLC=PSUTLC+X
- ;
- S PSUMSG(PSUDIV,5,"M")=$G(PSUMSG(PSUDIV,5,"M"))+PSUMC
- S PSUMSG(PSUDIV,5,"L")=$G(PSUMSG(PSUDIV,5,"L"))+PSUTLC
- ; Transmit Messages
- VARS ; Setup variables for contents
- ;
- ; Loop through messages generated and transmit them
- F PSUM=1:1:PSUMC D
- . 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 XMSUB="V. 4.0 PBMPR "_$G(PSUMON)_" "_PSUM_"/"_PSUMC_" "_PSUDIV_" "_PSUDIVNM
- . S XMTEXT="^XTMP(PSUPRSUB,""MESSAGE"",PSUM,"
- . S XMDUZ=DUZ
- . M XMY=PSUXMYH
- . S XMCHAN=1
- . I $G(PSUMASF)!$G(PSUDUZ)!$G(PSUPBMG) D
- ..I '$G(PSUSMRY) D ^XMD
- ;
- Q
- NODATA ;EP transmit NO DATA FOUND
- S XMDUZ=DUZ
- M XMY=PSUXMYH
- S PSUM=1,PSUMC=1
- S PSUDIV=PSUSNDR
- 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 XMSUB="V. 4.0 PBMPR "_$G(PSUMON)_" "_PSUM_"/"_PSUMC_" "_PSUDIV_" "_PSUDIVNM
- S X(1)="No data to report"
- S XMTEXT="X("
- S XMCHAN=1
- I $G(PSUMASF)!$G(PSUDUZ)!$G(PSUPBMG) D ^XMD
- S PSUMSG(PSUDIV,5,"M")=1,PSUMSG(PSUDIV,5,"L")=0
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSUPR4 2886 printed Jan 18, 2025@03:29:02 Page 2
- PSUPR4 ;BIR/PDW - PBMS PROCUREMENT EMAIL GENERATOR ;10 JUL 1999
- +1 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
- +2 ;DBIA(s)
- +3 ; Reference to file #4.3 supported by DBIA 2496
- +4 ; Reference to file #40.8 supported by DBIA 2438
- +5 ;PSULC = Line processing in ^tmp
- +6 ;PSUTLC = Total Line count
- +7 ;PSUMC = Message counter
- +8 ;PSUMLC = Message Line Counter
- +9 ; RETURNS
- +10 ;PSUMSG("M") = # Messages
- +11 ;PSUMSG("L") = # Lines
- +12 ;
- EN(PSUMSG) ;Scan and process for Division(s)
- +1 ; PSUMSGT ("M")= # MESSAGES ("L")= # LINES
- +2 ;
- +3 IF $GET(PSUMASF)!$GET(PSUDUZ)!$GET(PSUPBMG)
- Begin DoDot:1
- +4 NEW PSUMAX,PSULC,PSUTMC,PSUTLC,PSUMC
- +5 ; Scan TMP, split lines, transmit per MAX lines in Netmail
- +6 SET PSUMAX=$$VAL^PSUTL(4.3,1,8.3)
- +7 if PSUMAX'>0
- SET PSUMAX=10000
- +8 ;
- +9 IF '$DATA(^XTMP(PSUPRSUB,"RECORDS"))
- DO NODATA
- QUIT
- DIV ; Scan by division and send divisional messages
- +1 ;
- +2 SET PSUDIV=""
- FOR
- SET PSUDIV=$ORDER(^XTMP(PSUPRSUB,"RECORDS",PSUDIV))
- if PSUDIV=""
- QUIT
- DO MSG
- End DoDot:1
- +3 QUIT
- +4 ;
- MSG ;EP Send divisional message
- +1 ; Split and store into ^XTMP(PSUPRSUB,"MESSAGE",PSUMC,PSULC)
- +2 KILL ^XTMP(PSUPRSUB,"MESSAGE")
- +3 SET PSUMC=1
- SET PSUMLC=0
- +4 FOR PSULC=1:1
- SET X=$GET(^XTMP(PSUPRSUB,"RECORDS",PSUDIV,PSULC))
- if X=""
- QUIT
- Begin DoDot:1
- +5 IF $DATA(^XTMP(PSUPRSUB,"RECORDS",PSUDIV,PSULC,1))
- SET X=X_^XTMP(PSUPRSUB,"RECORDS",PSUDIV,PSULC,1)
- +6 SET PSUMLC=PSUMLC+1
- +7 ; + message
- IF PSUMLC>PSUMAX
- SET PSUMC=PSUMC+1
- SET PSUMLC=0
- SET PSULC=PSULC+1
- QUIT
- +8 IF $LENGTH(X)<235
- SET ^XTMP(PSUPRSUB,"MESSAGE",PSUMC,PSUMLC)=X
- QUIT
- +9 FOR I=235:-1:1
- SET Z=$EXTRACT(X,I)
- if Z="^"
- QUIT
- +10 SET Z=$EXTRACT(X,1,I)
- SET X=$EXTRACT(X,I+1,999)
- +11 SET ^XTMP(PSUPRSUB,"MESSAGE",PSUMC,PSUMLC)=Z
- +12 SET PSUMLC=PSUMLC+1
- +13 FOR
- if X=""
- QUIT
- Begin DoDot:2
- +14 FOR I=235:-1:1
- SET Z=$EXTRACT(X,I)
- if Z="^"
- QUIT
- +15 SET Z=$EXTRACT(X,1,I)
- SET X=$EXTRACT(X,I+1,999)
- +16 SET ^XTMP(PSUPRSUB,"MESSAGE",PSUMC,PSUMLC)="*"_Z
- +17 SET PSUMLC=PSUMLC+1
- End DoDot:2
- End DoDot:1
- +18 ;
- +19 ; Count Lines sent
- +20 SET PSUTLC=0
- +21 FOR PSUM=1:1:PSUMC
- SET X=$ORDER(^XTMP(PSUPRSUB,"MESSAGE",PSUM,""),-1)
- SET PSUTLC=PSUTLC+X
- +22 ;
- +23 SET PSUMSG(PSUDIV,5,"M")=$GET(PSUMSG(PSUDIV,5,"M"))+PSUMC
- +24 SET PSUMSG(PSUDIV,5,"L")=$GET(PSUMSG(PSUDIV,5,"L"))+PSUTLC
- +25 ; Transmit Messages
- VARS ; Setup variables for contents
- +1 ;
- +2 ; Loop through messages generated and transmit them
- +3 FOR PSUM=1:1:PSUMC
- Begin DoDot:1
- +4 ;**1
- SET X=PSUDIV
- SET DIC=40.8
- SET DIC(0)="X"
- SET D="C"
- DO IX^DIC
- +5 SET X=+Y
- SET PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
- +6 SET XMSUB="V. 4.0 PBMPR "_$GET(PSUMON)_" "_PSUM_"/"_PSUMC_" "_PSUDIV_" "_PSUDIVNM
- +7 SET XMTEXT="^XTMP(PSUPRSUB,""MESSAGE"",PSUM,"
- +8 SET XMDUZ=DUZ
- +9 MERGE XMY=PSUXMYH
- +10 SET XMCHAN=1
- +11 IF $GET(PSUMASF)!$GET(PSUDUZ)!$GET(PSUPBMG)
- Begin DoDot:2
- +12 IF '$GET(PSUSMRY)
- DO ^XMD
- End DoDot:2
- End DoDot:1
- +13 ;
- +14 QUIT
- NODATA ;EP transmit NO DATA FOUND
- +1 SET XMDUZ=DUZ
- +2 MERGE XMY=PSUXMYH
- +3 SET PSUM=1
- SET PSUMC=1
- +4 SET PSUDIV=PSUSNDR
- +5 ;**1
- SET X=PSUDIV
- SET DIC=40.8
- SET DIC(0)="X"
- SET D="C"
- DO IX^DIC
- +6 SET X=+Y
- SET PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
- +7 SET XMSUB="V. 4.0 PBMPR "_$GET(PSUMON)_" "_PSUM_"/"_PSUMC_" "_PSUDIV_" "_PSUDIVNM
- +8 SET X(1)="No data to report"
- +9 SET XMTEXT="X("
- +10 SET XMCHAN=1
- +11 IF $GET(PSUMASF)!$GET(PSUDUZ)!$GET(PSUPBMG)
- DO ^XMD
- +12 SET PSUMSG(PSUDIV,5,"M")=1
- SET PSUMSG(PSUDIV,5,"L")=0
- +13 QUIT