Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSUV3

PSUV3.m

Go to the documentation of this file.
  1. PSUV3 ;BIR/CFL - Create mailman messages ;10 JUL 1999
  1. ;;4.0;PHARMACY BENEFITS MANAGEMENT;**4**;MARCH, 2005
  1. ;DBIAs
  1. ; Reference to file #4.3 supported by DBIA 2496
  1. ; Reference to file #40.8 supported by DBIA 2438
  1. ;
  1. EN(PSUMSGT) ;
  1. ;
  1. S PSUNOREC="",NONE="",PSUAIS=""
  1. S PSUMSGT("M")=0,PSUMSGT("L")=0
  1. I '$D(^XTMP(PSUIVSUB,"RECORDS")) D NODATA Q ;Do not go any further if there is no data to report
  1. I '$D(^XTMP("PSU_"_PSUJOB,"PSUFLAG")) D AMIS
  1. S PSUDIV=0,Z=0
  1. F S PSUDIV=$O(^XTMP(PSUIVSUB,"RECORDS",PSUDIV)) Q:PSUDIV="" D
  1. .I PSUSMRY=1 D GETDIV Q ;Print only the summary report
  1. .I $G(PSUMASF)!$G(PSUDUZ)!$G(PSUPBMG) D XMD,SETCNT
  1. .D GETDIV
  1. .D DRUGSUM^PSUV4
  1. Q
  1. ;
  1. AMIS ;AMIS SUMMARY
  1. D EN^PSUV6 ;LVP AMIS Summary Data
  1. D EN^PSUV7 ;PB AMIS Summary Data
  1. D EN^PSUV8 ;TPN AMIS Summary Data
  1. D EN^PSUV9 ;CHEMO AMIS Summary Data
  1. D EN^PSUV10 ;SYRINGE AMIS Summary Data
  1. Q
  1. XMD ;
  1. ;
  1. NEW PSUMAX,PSULC,PSUTMC,PSUTLC,PSUMC
  1. S PSUMAX=$$VAL^PSUTL(4.3,1,8.3)
  1. S PSUMAX=$S(PSUMAX="":10000,PSUMAX>10000:10000,1:PSUMAX)
  1. K ^XTMP(PSUIVSUB,"XMD")
  1. S PSUMC=1,PSUMLC=0
  1. F PSULC=1:1 S X=$G(^XTMP(PSUIVSUB,"RECORDS",PSUDIV,PSULC)) Q:X="" D
  1. .S PSUMLC=PSUMLC+1
  1. .I PSUMLC>PSUMAX S PSUMC=PSUMC+1,PSUMLC=0,PSULC=PSULC-1 Q ; + message
  1. .I $L(X)<235 S ^XTMP(PSUIVSUB,"XMD",PSUMC,PSUMLC)=X Q
  1. .F I=235:-1:1 S Z=$E(X,I) Q:Z="^"
  1. .S ^XTMP(PSUIVSUB,"XMD",PSUMC,PSUMLC)=$E(X,1,I)
  1. .S PSUMLC=PSUMLC+1
  1. .S ^XTMP(PSUIVSUB,"XMD",PSUMC,PSUMLC)="*"_$E(X,I+1,999)
  1. ;
  1. ; Count Lines sent
  1. S PSUTLC=0
  1. F PSUM=1:1:PSUMC S X=$O(^XTMP(PSUIVSUB,"XMD",PSUM,""),-1),PSUTLC=PSUTLC+X
  1. ;
  1. ; Transmit Messages
  1. VARS ; Setup variables for contents
  1. F PSUM=1:1:PSUMC D
  1. .D GETDIV
  1. .S XMSUB="V. 4.0 PBMIV "_PSUMON_" "_PSUM_"/"_PSUMC_" "_PSUDIV_" "_PSUDIVNM
  1. .S XMTEXT="^XTMP(PSUIVSUB,""XMD"",PSUM,"
  1. .S XMCHAN=1
  1. .S XMDUZ=DUZ
  1. .M XMY=PSUXMYH
  1. .D ^XMD
  1. ;
  1. I NONE S PSUTLC=0
  1. S PSUMSG("M")=PSUMC
  1. S PSUMSG("L")=PSUTLC
  1. Q
  1. NODATA ;Send "No data to report" message
  1. S PSUDIV=PSUSNDR
  1. S ^XTMP(PSUIVSUB,"RECORDS",PSUDIV,1)="No data to report" S PSUAIS=1
  1. S NONE=1
  1. S ^XTMP("PSU_"_PSUJOB,"PSUNONE","IV")=""
  1. M PSUXMYH=PSUXMYS1
  1. D XMD
  1. SETCNT ;Set message count and line count
  1. S PSUMSGT(PSUDIV,"M")=$G(PSUMSGT(PSUDIV,"M"))+PSUMSG("M")
  1. S PSUMSGT(PSUDIV,"L")=$G(PSUMSGT(PSUDIV,"L"))+PSUMSG("L")
  1. S ^XTMP("PSU_"_PSUJOB,"CONFIRM",PSUDIV,PSUOPTN,"M")=PSUMSGT(PSUDIV,"M")
  1. S ^XTMP("PSU_"_PSUJOB,"CONFIRM",PSUDIV,PSUOPTN,"L")=PSUMSGT(PSUDIV,"L")
  1. Q
  1. GETDIV ;get division name
  1. S X=PSUDIV,DIC=40.8,DIC(0)="X",D="C" D IX^DIC ;**1
  1. S X=+Y S PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
  1. S ^XTMP("PSU_"_PSUJOB,"DIV",PSUDIV)=PSUDIVNM
  1. Q