135 lines
4.6 KiB
Mathematica
135 lines
4.6 KiB
Mathematica
|
PSUPR5 ;BIR/PDW - PROCUREMENT EXTRACT SUMMARY MESSAGE GENERATOR ;10 JUL 1999
|
||
|
|
;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
|
||
|
|
;DBIA(s)
|
||
|
|
; Reference to file #40.8 supported by DBIA 2438
|
||
|
|
;
|
||
|
|
EN ;EP generate Total & Cost summary
|
||
|
|
;
|
||
|
|
EN1 N PSUITT,PSUREC,PSUTC
|
||
|
|
;PSUITT - TOTAL ITEMS
|
||
|
|
;PSUTC - TOTAL COST
|
||
|
|
S:'$D(PSUPRJOB) PSUPRJOB=PSUJOB
|
||
|
|
S:'$D(PSUPRSUB) PSUPRSUB="PSUPR_"_PSUPRJOB
|
||
|
|
;
|
||
|
|
I '$D(^XTMP(PSUPRSUB,"RECORDS")) G NODATA
|
||
|
|
DIV ;EP Loop by Division
|
||
|
|
S PSUDIV="" F S PSUDIV=$O(^XTMP(PSUPRSUB,"RECORDS",PSUDIV)) Q:PSUDIV="" D MESSAGE
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
MESSAGE ;EP Generate Summary Messages for a Division
|
||
|
|
;
|
||
|
|
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)
|
||
|
|
MSG1 ; Generate 1st summary message
|
||
|
|
;
|
||
|
|
S PSUITT=0,PSUTC=0
|
||
|
|
;
|
||
|
|
; loop to get totals from records stored
|
||
|
|
S PSUREC=0
|
||
|
|
K ^TMP($J,"PSUITNM") ;
|
||
|
|
F S PSUREC=$O(^XTMP(PSUPRSUB,"RECORDS",PSUDIV,PSUREC)) Q:PSUREC'>0 S X=^(PSUREC),PSUTC=PSUTC+$P(X,U,19) S PSUIT=$P(X,U,8) S:PSUIT="" PSUIT=$P(X,U,7) S:PSUIT'="" ^TMP($J,"PSUITNM",PSUIT)=""
|
||
|
|
; get number of unique items stored in PSUITNM
|
||
|
|
S X="" F PSUITT=0:1 S X=$O(^TMP($J,"PSUITNM",X)) Q:X=""
|
||
|
|
K ^TMP($J,"PSUITNM")
|
||
|
|
S XMDUZ=DUZ
|
||
|
|
M XMY=PSUXMYS1
|
||
|
|
;
|
||
|
|
S Y=PSUSDT X ^DD("DD") S PSUDTS=Y ; start date
|
||
|
|
S Y=PSUEDT X ^DD("DD") S PSUDTE=Y ; end date
|
||
|
|
N PSUMSG
|
||
|
|
S PSUMSG(1)=" Procurement Statistical Summary"
|
||
|
|
S PSUMSG(2)=" "_PSUDTS_" through "_PSUDTE_" for "_PSUDIVNM
|
||
|
|
S PSUMSG(3)=" "
|
||
|
|
S PSUMSG(4)="Total of Drug/Supply Items: "_PSUITT
|
||
|
|
S PSUMSG(5)="Total Cost: $ "_PSUTC
|
||
|
|
S PSUMSG(6)=" "
|
||
|
|
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 XMSUB="V. 4.0 PBMPR "_$G(PSUMON)_" "_PSUDIV_" "_PSUDIVNM
|
||
|
|
Q:PSUDIV=0 ;Eliminate empty CoreFLS messages
|
||
|
|
S XMTEXT="PSUMSG("
|
||
|
|
S XMCHAN=1
|
||
|
|
M ^XTMP(PSUPRSUB,"REPORT1",PSUDIV)=PSUMSG
|
||
|
|
D ^XMD
|
||
|
|
K PSUMSG
|
||
|
|
;
|
||
|
|
MSG2 ; SUMMARY BY DRUG
|
||
|
|
; loop records stored
|
||
|
|
; psunm - name, psudisp - disp unit, psutq - total quantity, psutc - total cost
|
||
|
|
S PSUREC=0,PSUDRNM=""
|
||
|
|
K ^XTMP(PSUPRSUB,"DRUG")
|
||
|
|
F S PSUREC=$O(^XTMP(PSUPRSUB,"RECORDS",PSUDIV,PSUREC)) Q:PSUREC'>0 S X=^(PSUREC) D
|
||
|
|
. S PSUNM=$P(X,U,8),PSUTQ=$P(X,U,17),PSUTC=$P(X,U,19),PSUDISP=$P(X,U,12)
|
||
|
|
. S:PSUNM="" PSUNM=$P(X,U,7)
|
||
|
|
. S PSUNM=$E(PSUNM,1,30)
|
||
|
|
. I '$L(PSUNM) Q
|
||
|
|
. S ^XTMP(PSUPRSUB,"DRUG",PSUNM)=""
|
||
|
|
. S ^XTMP(PSUPRSUB,"DRUG",PSUNM,"TQ")=$G(^XTMP(PSUPRSUB,"DRUG",PSUNM,"TQ"))+PSUTQ
|
||
|
|
. S ^XTMP(PSUPRSUB,"DRUG",PSUNM,"TC")=$G(^XTMP(PSUPRSUB,"DRUG",PSUNM,"TC"))+PSUTC
|
||
|
|
. S ^XTMP(PSUPRSUB,"DRUG",PSUNM,"DISP")=PSUDISP
|
||
|
|
;
|
||
|
|
;
|
||
|
|
S PSUG="^XTMP(PSUPRSUB,""REPORT2"",PSUDIV)"
|
||
|
|
K @PSUG
|
||
|
|
S @PSUG@(1)=" Procurement Data Summary"
|
||
|
|
S @PSUG@(2)=" "_PSUDTS_" through "_PSUDTE_" for "_PSUDIVNM
|
||
|
|
S @PSUG@(3)=" "
|
||
|
|
S X="",X=$$SETSTR^VALM1("Dispense",X,53,8),X=$$SETSTR^VALM1("Total",X,63,5),X=$$SETSTR^VALM1("Total",X,73,5)
|
||
|
|
S @PSUG@(4)=X
|
||
|
|
S X="Drug/Supply Name",X=$$SETSTR^VALM1("Unit",X,53,4),X=$$SETSTR^VALM1("Qty",X,63,3),X=$$SETSTR^VALM1("Cost",X,73,4)
|
||
|
|
S @PSUG@(5)=X
|
||
|
|
S X="",$P(X,"-",79)=""
|
||
|
|
S @PSUG@(6)=X
|
||
|
|
S PSULC=6
|
||
|
|
N PSUNM,PSUDISP,PSUTQ,PSUTC,PSUTQT,PSUTCT
|
||
|
|
S (PSUTQT,PSUDISP,PSUTQ,PSUTC,PSUTCT)=0
|
||
|
|
; loop drug names
|
||
|
|
S PSUNM=""
|
||
|
|
F S PSUNM=$O(^XTMP(PSUPRSUB,"DRUG",PSUNM)) Q:PSUNM="" S PSUTQ=^XTMP(PSUPRSUB,"DRUG",PSUNM,"TQ"),PSUTC=^("TC"),PSUDISP=^("DISP") D
|
||
|
|
. S PSULC=PSULC+1
|
||
|
|
. S PSUTQT=$G(PSUTQT)+PSUTQ,PSUTCT=$G(PSUTCT)+PSUTC
|
||
|
|
. S X=$E(PSUNM,1,50)
|
||
|
|
. S X=$$SETSTR^VALM1(PSUDISP,X,53,$L(PSUDISP))
|
||
|
|
. S X=$$SETSTR^VALM1($J(PSUTQ,6,0),X,62,6)
|
||
|
|
. S X=$$SETSTR^VALM1($J(PSUTC,8,2),X,70,8)
|
||
|
|
. S @PSUG@(PSULC)=X
|
||
|
|
;
|
||
|
|
S X="",$P(X,"-",79)=""
|
||
|
|
S PSULC=PSULC+1
|
||
|
|
S @PSUG@(PSULC)=X
|
||
|
|
S X="Total",X=$$SETSTR^VALM1($J(PSUTQT,6,0),X,62,6),X=$$SETSTR^VALM1($J(PSUTCT,8,2),X,70,8)
|
||
|
|
S PSULC=PSULC+1
|
||
|
|
S @PSUG@(PSULC)=X
|
||
|
|
S @PSUG@(PSULC+1)=" "
|
||
|
|
S XMSUB="V. 4.0 PBMPR "_$G(PSUMON)_" "_PSUDIV_" "_PSUDIVNM
|
||
|
|
S XMTEXT="^XTMP(PSUPRSUB,""REPORT2"",PSUDIV,"
|
||
|
|
S XMCHAN=1
|
||
|
|
M XMY=PSUXMYS2
|
||
|
|
I '$G(PSUSMRY) D ^XMD
|
||
|
|
Q
|
||
|
|
NODATA ;EP SEND NO DATA MESSAGE
|
||
|
|
S XMDUZ=DUZ
|
||
|
|
M XMY=PSUXMYS1
|
||
|
|
;
|
||
|
|
S PSUDIV=PSUSNDR
|
||
|
|
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 Y=PSUSDT X ^DD("DD") S PSUDTS=Y ; start date
|
||
|
|
S Y=PSUEDT X ^DD("DD") S PSUDTE=Y ; end date
|
||
|
|
S XMSUB="V. 4.0 PBMPR "_$G(PSUMON)_" "_PSUDIV_" "_PSUDIVNM
|
||
|
|
S XMTEXT="^XTMP(PSUPRSUB,""REPORT2"",PSUDIV,"
|
||
|
|
S XMCHAN=1
|
||
|
|
K X
|
||
|
|
S X(1)=" Procurement Statistical Summary"
|
||
|
|
S X(2)=" "_PSUDTS_" through "_PSUDTE_" for "_PSUDIVNM
|
||
|
|
S X(3)=" "
|
||
|
|
S X(4)="No data to report"
|
||
|
|
S X(5)=" "
|
||
|
|
M ^XTMP(PSUPRSUB,"REPORT1",PSUDIV)=X
|
||
|
|
S XMTEXT="X("
|
||
|
|
S:$G(PSUDUZ) XMY(PSUDUZ)=""
|
||
|
|
D ^XMD
|
||
|
|
S X(1)=" Procurement Data Summary"
|
||
|
|
M ^XTMP(PSUPRSUB,"REPORT2",PSUDIV)=X ;store for print cycle
|
||
|
|
Q
|