81 lines
2.1 KiB
Mathematica
81 lines
2.1 KiB
Mathematica
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
|