PSURT2 ; BIR/RDC - DYNAMIC REPORT OF PATIENT DEMOGRAPHIC DATA; 12 APR 2004
 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
 ;
 ; THIS PROGRAM IS CALLED TO EXTRACT DATES FROM ^PSUDEM AND 
 ; CALLS ^PSUDEM1 TO EXTRACT PMB PATIENT DEMOGRAPHIC DATA
 ;
EN ;
 D INITZ
 D LODXTMP
 D MAILIT
 K ^XTMP("PSU"_PSUJOB,"REXMT")
 Q
 ;
INITZ ;
 S START=PSUSTART,LAST=PSULAST
 I $D(PSURMON) S PSURMON=$E(PSURMON,1,5)
 I '$D(PSURMON) S PSURMON=PSUSRNG_" through "_PSUERNG
 S PSUJOB=$J_"_"_$P($H,",",2)
 S PSUMASF=$G(PSUMASF)
 S PSUDUZ=$G(PSUDUZ)
 S PSUPBMG=$G(PSUPBMG)
 N PSURXMT
 S PSURXMT=1
 ;
 S X=$$VALI^PSUTL(4.3,1,217)
 S PSUSNDR=+$$VAL^PSUTL(4,X,99)
 S X=PSUSNDR,DIC=40.8,DIC(0)="X",D="C" D IX^DIC  ; ** set facility
 S X=+Y S PSUVDIV=$$VAL^PSUTL(40.8,X,.01)        ; ** set division
 ;
 Q
 ;
LODXTMP ;
 ;
 S START=START-1
 F  S START=$O(^PSUDEM("B",START)) Q:START>LAST!(START="")  D
 . S I=""
 . S I=$O(^PSUDEM("B",START,I))
 . S DFN=$P(^PSUDEM(I,0),U,2)
 . S ^XTMP("PSU"_PSUJOB,"REXMT",DFN)=""
 ;
 ; ** ^XTMP SHOULD NOW HOLD ONE NODE PER PATIENT FOR THIS TIME FRAME **
 Q
 ;
MAILIT ;
 S ^XTMP("PSU_"_PSUJOB,"REXMIT")="YES"
 S XMCHAN=1
 S XMDUZ=DUZ
 I $G(PSUMSTR) S PSUXMYH("G.PSU PBM@CMOP-NAT.MED.VA.GOV")=""
 I $G(PSUMME) S PSUXMYH(DUZ)="",PSUXMYH("G.PSU PBM")=""
 M XMY=PSUXMYH
 ; MAILGROUPS ARE SET INTO XMY
 S DFN=""
 F  S (DFN,PSUDMDFN)=$O(^XTMP("PSU"_PSUJOB,"REXMT",DFN)) Q:PSUDMDFN=""  D
 . D DAT^PSUDEM1
 . D DEM1^PSUDEM1
 D XMD^PSUDEM1
 D CONFIRM
 ;
 Q
CONFIRM ;
 I $G(PSUMSTR) S PSUXMYH("G.PSU PBM@CMOP-NAT.MED.VA.GOV")=""
 I $G(PSUMME) S PSUXMYH(DUZ)="",PSUXMYH("G.PSU PBM")=""
 M XMY=PSUXMYH
 F I=1:1:79 S $E(ZZ,I)="-"
 S PSUPKG="Patient Demographics"
 S PSUCONF(1)="The chart below shows the package(s) whose dispensing statistics were extracted"
 S PSUCONF(2)="by the PBM Pharmacy Statistics Retransmission option."
 S PSUCONF(3)=" "
 S PSUCONF(4)="PACKAGE"_$J("# Line items",35)_$J("# MailMan msgs",19)
 S PSUCONF(5)=ZZ
 K ^XTMP(PSUSUB,"XMD")
 M ^XTMP(PSUSUB,"XMD")=PSUCONF
 S ^XTMP(PSUSUB,"XMD",6)=PSUPKG_$J(PSUMLC,37-$L(PSUPKG))_$J(PSUM,12)
 S XMSUB="V. 4.0 PBMRXMT "_PSURMON_" "_PSUSIT_" "_PSUDIVNM
 S XMDUZ=DUZ
 S XMCHAN=1
 S XMTEXT="^XTMP(PSUSUB,""XMD"","
 D ^XMD
 ;
 Q