PSUV3 ;BIR/CFL - Create mailman messages ;10 JUL 1999
;;4.0;PHARMACY BENEFITS MANAGEMENT;**4**;MARCH, 2005
;DBIAs
; Reference to file #4.3 supported by DBIA 2496
; Reference to file #40.8 supported by DBIA 2438
;
EN(PSUMSGT) ;
;
S PSUNOREC="",NONE="",PSUAIS=""
S PSUMSGT("M")=0,PSUMSGT("L")=0
I '$D(^XTMP(PSUIVSUB,"RECORDS")) D NODATA Q ;Do not go any further if there is no data to report
I '$D(^XTMP("PSU_"_PSUJOB,"PSUFLAG")) D AMIS
S PSUDIV=0,Z=0
F S PSUDIV=$O(^XTMP(PSUIVSUB,"RECORDS",PSUDIV)) Q:PSUDIV="" D
.I PSUSMRY=1 D GETDIV Q ;Print only the summary report
.I $G(PSUMASF)!$G(PSUDUZ)!$G(PSUPBMG) D XMD,SETCNT
.D GETDIV
.D DRUGSUM^PSUV4
Q
;
AMIS ;AMIS SUMMARY
D EN^PSUV6 ;LVP AMIS Summary Data
D EN^PSUV7 ;PB AMIS Summary Data
D EN^PSUV8 ;TPN AMIS Summary Data
D EN^PSUV9 ;CHEMO AMIS Summary Data
D EN^PSUV10 ;SYRINGE AMIS Summary Data
Q
XMD ;
;
NEW PSUMAX,PSULC,PSUTMC,PSUTLC,PSUMC
S PSUMAX=$$VAL^PSUTL(4.3,1,8.3)
S PSUMAX=$S(PSUMAX="":10000,PSUMAX>10000:10000,1:PSUMAX)
K ^XTMP(PSUIVSUB,"XMD")
S PSUMC=1,PSUMLC=0
F PSULC=1:1 S X=$G(^XTMP(PSUIVSUB,"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(PSUIVSUB,"XMD",PSUMC,PSUMLC)=X Q
.F I=235:-1:1 S Z=$E(X,I) Q:Z="^"
.S ^XTMP(PSUIVSUB,"XMD",PSUMC,PSUMLC)=$E(X,1,I)
.S PSUMLC=PSUMLC+1
.S ^XTMP(PSUIVSUB,"XMD",PSUMC,PSUMLC)="*"_$E(X,I+1,999)
;
; Count Lines sent
S PSUTLC=0
F PSUM=1:1:PSUMC S X=$O(^XTMP(PSUIVSUB,"XMD",PSUM,""),-1),PSUTLC=PSUTLC+X
;
; Transmit Messages
VARS ; Setup variables for contents
F PSUM=1:1:PSUMC D
.D GETDIV
.S XMSUB="V. 4.0 PBMIV "_PSUMON_" "_PSUM_"/"_PSUMC_" "_PSUDIV_" "_PSUDIVNM
.S XMTEXT="^XTMP(PSUIVSUB,""XMD"",PSUM,"
.S XMCHAN=1
.S XMDUZ=DUZ
.M XMY=PSUXMYH
.D ^XMD
;
I NONE S PSUTLC=0
S PSUMSG("M")=PSUMC
S PSUMSG("L")=PSUTLC
Q
NODATA ;Send "No data to report" message
S PSUDIV=PSUSNDR
S ^XTMP(PSUIVSUB,"RECORDS",PSUDIV,1)="No data to report" S PSUAIS=1
S NONE=1
S ^XTMP("PSU_"_PSUJOB,"PSUNONE","IV")=""
M PSUXMYH=PSUXMYS1
D XMD
SETCNT ;Set message count and line count
S PSUMSGT(PSUDIV,"M")=$G(PSUMSGT(PSUDIV,"M"))+PSUMSG("M")
S PSUMSGT(PSUDIV,"L")=$G(PSUMSGT(PSUDIV,"L"))+PSUMSG("L")
S ^XTMP("PSU_"_PSUJOB,"CONFIRM",PSUDIV,PSUOPTN,"M")=PSUMSGT(PSUDIV,"M")
S ^XTMP("PSU_"_PSUJOB,"CONFIRM",PSUDIV,PSUOPTN,"L")=PSUMSGT(PSUDIV,"L")
Q
GETDIV ;get division name
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
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSUV3 2659 printed Dec 13, 2024@02:28:49 Page 2
PSUV3 ;BIR/CFL - Create mailman messages ;10 JUL 1999
+1 ;;4.0;PHARMACY BENEFITS MANAGEMENT;**4**;MARCH, 2005
+2 ;DBIAs
+3 ; Reference to file #4.3 supported by DBIA 2496
+4 ; Reference to file #40.8 supported by DBIA 2438
+5 ;
EN(PSUMSGT) ;
+1 ;
+2 SET PSUNOREC=""
SET NONE=""
SET PSUAIS=""
+3 SET PSUMSGT("M")=0
SET PSUMSGT("L")=0
+4 ;Do not go any further if there is no data to report
IF '$DATA(^XTMP(PSUIVSUB,"RECORDS"))
DO NODATA
QUIT
+5 IF '$DATA(^XTMP("PSU_"_PSUJOB,"PSUFLAG"))
DO AMIS
+6 SET PSUDIV=0
SET Z=0
+7 FOR
SET PSUDIV=$ORDER(^XTMP(PSUIVSUB,"RECORDS",PSUDIV))
if PSUDIV=""
QUIT
Begin DoDot:1
+8 ;Print only the summary report
IF PSUSMRY=1
DO GETDIV
QUIT
+9 IF $GET(PSUMASF)!$GET(PSUDUZ)!$GET(PSUPBMG)
DO XMD
DO SETCNT
+10 DO GETDIV
+11 DO DRUGSUM^PSUV4
End DoDot:1
+12 QUIT
+13 ;
AMIS ;AMIS SUMMARY
+1 ;LVP AMIS Summary Data
DO EN^PSUV6
+2 ;PB AMIS Summary Data
DO EN^PSUV7
+3 ;TPN AMIS Summary Data
DO EN^PSUV8
+4 ;CHEMO AMIS Summary Data
DO EN^PSUV9
+5 ;SYRINGE AMIS Summary Data
DO EN^PSUV10
+6 QUIT
XMD ;
+1 ;
+2 NEW PSUMAX,PSULC,PSUTMC,PSUTLC,PSUMC
+3 SET PSUMAX=$$VAL^PSUTL(4.3,1,8.3)
+4 SET PSUMAX=$SELECT(PSUMAX="":10000,PSUMAX>10000:10000,1:PSUMAX)
+5 KILL ^XTMP(PSUIVSUB,"XMD")
+6 SET PSUMC=1
SET PSUMLC=0
+7 FOR PSULC=1:1
SET X=$GET(^XTMP(PSUIVSUB,"RECORDS",PSUDIV,PSULC))
if X=""
QUIT
Begin DoDot:1
+8 SET PSUMLC=PSUMLC+1
+9 ; + message
IF PSUMLC>PSUMAX
SET PSUMC=PSUMC+1
SET PSUMLC=0
SET PSULC=PSULC-1
QUIT
+10 IF $LENGTH(X)<235
SET ^XTMP(PSUIVSUB,"XMD",PSUMC,PSUMLC)=X
QUIT
+11 FOR I=235:-1:1
SET Z=$EXTRACT(X,I)
if Z="^"
QUIT
+12 SET ^XTMP(PSUIVSUB,"XMD",PSUMC,PSUMLC)=$EXTRACT(X,1,I)
+13 SET PSUMLC=PSUMLC+1
+14 SET ^XTMP(PSUIVSUB,"XMD",PSUMC,PSUMLC)="*"_$EXTRACT(X,I+1,999)
End DoDot:1
+15 ;
+16 ; Count Lines sent
+17 SET PSUTLC=0
+18 FOR PSUM=1:1:PSUMC
SET X=$ORDER(^XTMP(PSUIVSUB,"XMD",PSUM,""),-1)
SET PSUTLC=PSUTLC+X
+19 ;
+20 ; Transmit Messages
VARS ; Setup variables for contents
+1 FOR PSUM=1:1:PSUMC
Begin DoDot:1
+2 DO GETDIV
+3 SET XMSUB="V. 4.0 PBMIV "_PSUMON_" "_PSUM_"/"_PSUMC_" "_PSUDIV_" "_PSUDIVNM
+4 SET XMTEXT="^XTMP(PSUIVSUB,""XMD"",PSUM,"
+5 SET XMCHAN=1
+6 SET XMDUZ=DUZ
+7 MERGE XMY=PSUXMYH
+8 DO ^XMD
End DoDot:1
+9 ;
+10 IF NONE
SET PSUTLC=0
+11 SET PSUMSG("M")=PSUMC
+12 SET PSUMSG("L")=PSUTLC
+13 QUIT
NODATA ;Send "No data to report" message
+1 SET PSUDIV=PSUSNDR
+2 SET ^XTMP(PSUIVSUB,"RECORDS",PSUDIV,1)="No data to report"
SET PSUAIS=1
+3 SET NONE=1
+4 SET ^XTMP("PSU_"_PSUJOB,"PSUNONE","IV")=""
+5 MERGE PSUXMYH=PSUXMYS1
+6 DO XMD
SETCNT ;Set message count and line count
+1 SET PSUMSGT(PSUDIV,"M")=$GET(PSUMSGT(PSUDIV,"M"))+PSUMSG("M")
+2 SET PSUMSGT(PSUDIV,"L")=$GET(PSUMSGT(PSUDIV,"L"))+PSUMSG("L")
+3 SET ^XTMP("PSU_"_PSUJOB,"CONFIRM",PSUDIV,PSUOPTN,"M")=PSUMSGT(PSUDIV,"M")
+4 SET ^XTMP("PSU_"_PSUJOB,"CONFIRM",PSUDIV,PSUOPTN,"L")=PSUMSGT(PSUDIV,"L")
+5 QUIT
GETDIV ;get division name
+1 ;**1
SET X=PSUDIV
SET DIC=40.8
SET DIC(0)="X"
SET D="C"
DO IX^DIC
+2 SET X=+Y
SET PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
+3 SET ^XTMP("PSU_"_PSUJOB,"DIV",PSUDIV)=PSUDIVNM
+4 QUIT
