109 lines
3.9 KiB
Mathematica
109 lines
3.9 KiB
Mathematica
PSUOP4 ;BIR/CFL - PSU PBM Outpatient Pharmacy create mailman messages ;10 JUL 1999
|
|
;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
|
|
;
|
|
;DBIA(s)
|
|
; Reference to file #4.3 supported by DBIA 2496
|
|
; Reference to file #59 supported by DBIA 2510
|
|
; Reference to file #4 supported by DBIA 10090
|
|
;
|
|
EN ;
|
|
;
|
|
S $P(PSUDASH,"-",100)=""
|
|
S $P(PSUFILL," ",100)=""
|
|
;Organize index of ^XTMP("DATA") global
|
|
S (PSUDV,PSUTMP)=""
|
|
F S PSUDV=$O(^XTMP(PSUOPSUB,"DATA",PSUDV)) Q:PSUDV="" D
|
|
.S PSULCT=0
|
|
.S PSURXIEN=""
|
|
.F S PSURXIEN=$O(^XTMP(PSUOPSUB,"DATA",PSUDV,PSURXIEN)) Q:PSURXIEN="" D
|
|
..S PSURCT=0
|
|
..F S PSURCT=$O(^XTMP(PSUOPSUB,"DATA",PSUDV,PSURXIEN,PSURCT)) Q:PSURCT="" D
|
|
...D DATA^PSUOP7 ;Gather data for AMIS summary report
|
|
...S PSULCT=PSULCT+1
|
|
...S ^XTMP(PSUOPSUB,"RECORDS",PSUDV,PSULCT)=^XTMP(PSUOPSUB,"DATA",PSUDV,PSURXIEN,PSURCT,1)
|
|
...S PSULCT=PSULCT+1
|
|
...S ^XTMP(PSUOPSUB,"RECORDS",PSUDV,PSULCT)=^XTMP(PSUOPSUB,"DATA",PSUDV,PSURXIEN,PSURCT,2)
|
|
...;S PSULCT=PSULCT+1
|
|
...;S ^XTMP(PSUOPSUB,"RECORDS",PSUDV,PSULCT)=^XTMP(PSUOPSUB,"DATA",PSUDV,PSURXIEN,PSURCT,3)
|
|
;
|
|
;
|
|
;Create global for Patient Demographics summary message
|
|
M ^XTMP("PSU_"_PSUJOB,"PSUDIVPT")=^XTMP(PSUOPSUB,"RECORDS")
|
|
S PSUST=0
|
|
F S PSUST=$O(^XTMP("PSU_"_PSUJOB,"PSUDIVPT",PSUST)) Q:PSUST="" D
|
|
.S PSUST1=0
|
|
.F S PSUST1=$O(^XTMP("PSU_"_PSUJOB,"PSUDIVPT",PSUST,PSUST1)) Q:PSUST1="" D
|
|
..I $P(^XTMP("PSU_"_PSUJOB,"PSUDIVPT",PSUST,PSUST1),U,1)["*" D
|
|
...K ^XTMP("PSU_"_PSUJOB,"PSUDIVPT",PSUST,PSUST1)
|
|
;
|
|
MSG ;Set up the number of lines and messages for mailman
|
|
;
|
|
S PSUNOREC="",NONE=""
|
|
S PSUMSGT("M")=0,PSUMSGT("L")=0
|
|
I '$D(^XTMP(PSUOPSUB,"RECORDS")) D NODATA Q ;Do not go any further if there is no data to report
|
|
S PSUDIV=0,Z=0
|
|
F S PSUDIV=$O(^XTMP(PSUOPSUB,"RECORDS",PSUDIV)) Q:PSUDIV="" D
|
|
.S X=PSUDIV,DIC=59,DIC(0)="XM" D ^DIC ;;1
|
|
.S X=+Y,PSUDIVNM=$$VAL^PSUTL(59,X,.01)
|
|
.;VMP OIFO BAY PINES;ELR;PSU*3.0*31
|
|
.I '$L(PSUDIVNM) S X=PSUDIV D DIVNM^PSUOP6
|
|
.I PSUMASF!PSUDUZ!PSUPBMG D
|
|
..I 'PSUSMRY D XMD,SETCNT
|
|
.D RECLOOP^PSUOP5,RECSUM^PSUOP5 ; send statistical summary
|
|
.I 'PSUSMRY D DRUGSUM^PSUOP5 ; send drug summary on condition
|
|
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(PSUOPSUB,"XMD")
|
|
S PSUMC=1,PSUMLC=0
|
|
F PSULC=1:1 S X=$G(^XTMP(PSUOPSUB,"RECORDS",PSUDIV,PSULC)) Q:X="" D
|
|
.S PSUMLC=PSUMLC+1
|
|
.I PSUMLC>PSUMAX D
|
|
..I $E(X,1)="*" D
|
|
...S ^XTMP(PSUOPSUB,"XMD",PSUMC+1,1)=^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-1)
|
|
...K ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC-1)
|
|
...S PSUMC=PSUMC+1,PSUMLC=2
|
|
..I $E(X,1)'="*" S PSUMC=PSUMC+1,PSUMLC=1 ; + message
|
|
.I $L(X)<250 S ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC)=X Q
|
|
.F I=250:-1:1 S Z=$E(X,I) Q:Z="^"
|
|
.S ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC)=$E(X,1,I)
|
|
.S PSUMLC=PSUMLC+1
|
|
.S ^XTMP(PSUOPSUB,"XMD",PSUMC,PSUMLC)="*"_$E(X,I+1,999)
|
|
;
|
|
; Count Lines sent
|
|
S PSUTLC=0
|
|
F PSUM=1:1:PSUMC S X=$O(^XTMP(PSUOPSUB,"XMD",PSUM,""),-1),PSUTLC=PSUTLC+X
|
|
;
|
|
; Transmit Messages
|
|
VARS ; Setup variables for contents
|
|
F PSUM=1:1:PSUMC D
|
|
.S X=PSUDIV,DIC=40.8,DIC(0)="X",D="C" D IX^DIC
|
|
.S X=+Y S PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
|
|
.S XMSUB="V. 4.0 PBMOP "_PSUMON_" "_PSUM_"/"_PSUMC_" "_PSUDIV_" "_PSUDIVNM
|
|
.S XMTEXT="^XTMP(PSUOPSUB,""XMD"",PSUM,"
|
|
.S XMCHAN=1
|
|
.I PSUMASF!PSUDUZ!PSUPBMG D
|
|
..M XMY=PSUXMYH
|
|
.I 'PSUMASF M XMY=PSUXMYS1
|
|
.D ^XMD
|
|
;
|
|
S:NONE PSUTLC=0
|
|
S PSUMSG("M")=PSUMC
|
|
S PSUMSG("L")=PSUTLC
|
|
Q
|
|
NODATA ;Send "No data to report" message
|
|
S ^XTMP(PSUOPSUB,"RECORDS",PSUSNDR,1)="No data to report"
|
|
S NONE=1,PSUDIV=PSUSNDR
|
|
S ^XTMP("PSU_"_PSUJOB,"PSUNONE","RX")=""
|
|
;VMP OIFO BAY PINES;ELR;PSU*3.0*31
|
|
S X=PSUDIV D DIVNM^PSUOP6
|
|
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
|