- 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 Jan 18, 2025@03:29:31 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