- PSUUD4 ;BIR/TJH - PBM UNIT DOSE EMAIL GENERATOR ;10 JUL 1999
- ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
- ;DBIA(s)
- ; Reference to file #4.3 supported by DBIA 2496,2596
- ; 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(PSUMSGT) ;Scan and process for Division(s)
- ; PSUMSGT ("M")= # MESSAGES ("L")= # LINES
- ;
- S PSUDIV=0,Z=0,PSUUDSUB="PSUUD_"_PSUJOB
- F S PSUDIV=$O(^XTMP(PSUUDSUB,"RECORDS",PSUDIV)) Q:PSUDIV="" D
- . D XMD^PSUUD4(.Z) ; ==> process one division
- . S PSUMSGT(PSUDIV,PSUOPTN,"M")=$G(PSUMSGT(PSUDIV,PSUOPTN,"M"))+Z("M")
- . S PSUMSGT(PSUDIV,PSUOPTN,"L")=$G(PSUMSGT(PSUDIV,PSUOPTN,"L"))+Z("L")
- Q
- XMD(PSUMSG) ;EP returns PSUMSG("M")= # MESSAGES ("L")= # LINES
- 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=$S(PSUMAX="":10000,PSUMAX>10000:10000,1:PSUMAX)
- ;
- ; Split and store into ^XTMP(PSUUDSUB,"XMD",PSUMC,PSUMLC)
- K ^XTMP(PSUUDSUB,"XMD")
- S PSUMC=1,PSUMLC=0
- F PSULC=1:1 S X=$G(^XTMP(PSUUDSUB,"RECORDS",PSUDIV,PSULC)) Q:X="" D
- . S PSUMLC=PSUMLC+1
- . I PSUMLC>PSUMAX S PSUMC=PSUMC+1,PSUMLC=0,PSULC=PSULC-1 Q ; + message
- . I $L(X)<235 S ^XTMP(PSUUDSUB,"XMD",PSUMC,PSUMLC)=X Q
- . F I=235:-1:1 S Z=$E(X,I) Q:Z="^"
- . S ^XTMP(PSUUDSUB,"XMD",PSUMC,PSUMLC)=$E(X,1,I)
- . S PSUMLC=PSUMLC+1
- . S ^XTMP(PSUUDSUB,"XMD",PSUMC,PSUMLC)="*"_$E(X,I+1,999)
- ; Count Lines sent
- S PSUTLC=0
- F PSUM=1:1:PSUMC S X=$O(^XTMP(PSUUDSUB,"XMD",PSUM,""),-1),PSUTLC=PSUTLC+X
- ; Transmit Messages
- VARS ; Setup variables for contents
- ;
- 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 ^XTMP("PSU_"_PSUJOB,"DIV",PSUDIV)=PSUDIVNM
- . I '$D(PSUUDFLG) S XMSUB="V. 4.0 PBMUD "_PSUMON_" "_PSUM_"/"_PSUMC_" "_PSUDIV_" "_PSUDIVNM
- . I $D(PSUUDFLG) S XMSUB="V. 4.0 PBMUD "_PSUMON_" "_PSUDIV_" "_PSUDIVNM
- . S XMTEXT="^XTMP(PSUUDSUB,""XMD"",PSUM,"
- . S XMDUZ=DUZ
- . M XMY=PSUXMY
- . S XMCHAN=1
- . M XMY=PSUXMY
- . I PSUMASF!PSUDUZ!PSUPBMG D ^XMD
- ;
- S PSUMSG("M")=PSUMC
- S PSUMSG("L")=PSUTLC
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSUUD4 2315 printed Feb 18, 2025@23:54:42 Page 2
- PSUUD4 ;BIR/TJH - PBM UNIT DOSE 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,2596
- +4 ; Reference to file #40.8 supported by DBIA 2438
- +5 ;
- +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 ;
- EN(PSUMSGT) ;Scan and process for Division(s)
- +1 ; PSUMSGT ("M")= # MESSAGES ("L")= # LINES
- +2 ;
- +3 SET PSUDIV=0
- SET Z=0
- SET PSUUDSUB="PSUUD_"_PSUJOB
- +4 FOR
- SET PSUDIV=$ORDER(^XTMP(PSUUDSUB,"RECORDS",PSUDIV))
- if PSUDIV=""
- QUIT
- Begin DoDot:1
- +5 ; ==> process one division
- DO XMD^PSUUD4(.Z)
- +6 SET PSUMSGT(PSUDIV,PSUOPTN,"M")=$GET(PSUMSGT(PSUDIV,PSUOPTN,"M"))+Z("M")
- +7 SET PSUMSGT(PSUDIV,PSUOPTN,"L")=$GET(PSUMSGT(PSUDIV,PSUOPTN,"L"))+Z("L")
- End DoDot:1
- +8 QUIT
- XMD(PSUMSG) ;EP returns PSUMSG("M")= # MESSAGES ("L")= # LINES
- +1 NEW PSUMAX,PSULC,PSUTMC,PSUTLC,PSUMC
- +2 ; Scan TMP, split lines, transmit per MAX lines in Netmail
- +3 SET PSUMAX=$$VAL^PSUTL(4.3,1,8.3)
- +4 SET PSUMAX=$SELECT(PSUMAX="":10000,PSUMAX>10000:10000,1:PSUMAX)
- +5 ;
- +6 ; Split and store into ^XTMP(PSUUDSUB,"XMD",PSUMC,PSUMLC)
- +7 KILL ^XTMP(PSUUDSUB,"XMD")
- +8 SET PSUMC=1
- SET PSUMLC=0
- +9 FOR PSULC=1:1
- SET X=$GET(^XTMP(PSUUDSUB,"RECORDS",PSUDIV,PSULC))
- if X=""
- QUIT
- Begin DoDot:1
- +10 SET PSUMLC=PSUMLC+1
- +11 ; + message
- IF PSUMLC>PSUMAX
- SET PSUMC=PSUMC+1
- SET PSUMLC=0
- SET PSULC=PSULC-1
- QUIT
- +12 IF $LENGTH(X)<235
- SET ^XTMP(PSUUDSUB,"XMD",PSUMC,PSUMLC)=X
- QUIT
- +13 FOR I=235:-1:1
- SET Z=$EXTRACT(X,I)
- if Z="^"
- QUIT
- +14 SET ^XTMP(PSUUDSUB,"XMD",PSUMC,PSUMLC)=$EXTRACT(X,1,I)
- +15 SET PSUMLC=PSUMLC+1
- +16 SET ^XTMP(PSUUDSUB,"XMD",PSUMC,PSUMLC)="*"_$EXTRACT(X,I+1,999)
- End DoDot:1
- +17 ; Count Lines sent
- +18 SET PSUTLC=0
- +19 FOR PSUM=1:1:PSUMC
- SET X=$ORDER(^XTMP(PSUUDSUB,"XMD",PSUM,""),-1)
- SET PSUTLC=PSUTLC+X
- +20 ; Transmit Messages
- VARS ; Setup variables for contents
- +1 ;
- +2 FOR PSUM=1:1:PSUMC
- Begin DoDot:1
- +3 ;**1
- SET X=PSUDIV
- SET DIC=40.8
- SET DIC(0)="X"
- SET D="C"
- DO IX^DIC
- +4 SET X=+Y
- SET PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
- +5 SET ^XTMP("PSU_"_PSUJOB,"DIV",PSUDIV)=PSUDIVNM
- +6 IF '$DATA(PSUUDFLG)
- SET XMSUB="V. 4.0 PBMUD "_PSUMON_" "_PSUM_"/"_PSUMC_" "_PSUDIV_" "_PSUDIVNM
- +7 IF $DATA(PSUUDFLG)
- SET XMSUB="V. 4.0 PBMUD "_PSUMON_" "_PSUDIV_" "_PSUDIVNM
- +8 SET XMTEXT="^XTMP(PSUUDSUB,""XMD"",PSUM,"
- +9 SET XMDUZ=DUZ
- +10 MERGE XMY=PSUXMY
- +11 SET XMCHAN=1
- +12 MERGE XMY=PSUXMY
- +13 IF PSUMASF!PSUDUZ!PSUPBMG
- DO ^XMD
- End DoDot:1
- +14 ;
- +15 SET PSUMSG("M")=PSUMC
- +16 SET PSUMSG("L")=PSUTLC
- +17 QUIT
- +18 ;