PSUAR4 ;BIR/PDW - AR/WS SUMMARY MAILMESSAGES ;25 SEP 1998
;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
;DBIAs
; Reference to file #40.8 supported by DBIA 2438
; Reference to file #50 supported by DBIA 221
;
EN ;EP Generate mail message summaries
; also store image for printed reports
;
D DRUGSUM
;
Q
;
DRUGSUM ;EP Generate Drug Summary Message(s) by DIV
; ^XTMP(PSUARSUB,"DIV_DRUG",PSUDIV)=Total Dispenses ;from PSUAR2
S PSUDIV=0
F S PSUDIV=$O(^XTMP(PSUARSUB,"DIV_DRUG",PSUDIV)) Q:PSUDIV="" D DRUGXMD
Q
;
DRUGXMD ;EP Generate Mail Message with PSUDIV provided
; Assemble top of message
; Find Division Name
I '$D(^XTMP(PSUARSUB,"DIV_DRUG")) Q
;
K DIC
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 PBMAR "_$G(PSUMON)_" "_PSUDIV_" "_PSUDIVNM
M XMY=PSUXMYS2
S XMDUZ=DUZ
S XMTEXT="PSUMSG("
S XMCHAN=1
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)=" Automatic Replenishment/Ward Stock Data Summary"
S PSUMSG(2)=" "_PSUDTS_" through "_PSUDTE_" for "_PSUDIVNM
S PSUMSG(3)=" "
S X=""
S X=$$SETSTR^VALM1("Total",X,40,5)
S X=$$SETSTR^VALM1("Total",X,52,5)
S PSUMSG(4)=X
S X="",X=$$SETSTR^VALM1("Dispensed",X,40,9),X=$$SETSTR^VALM1("Dispensed",X,52,9),X=$$SETSTR^VALM1("AMIS",X,64,4)
S PSUMSG(5)=X
S X="DRUG NAME",X=$$SETSTR^VALM1("Units",X,40,5),X=$$SETSTR^VALM1("Cost",X,52,4),X=$$SETSTR^VALM1("Category",X,64,8)
S PSUMSG(6)=X
S X="",$P(X,"-",79)=""
S PSUMSG(7)=X
;
; Drug Data: Move into local array ^TMP($J,"PSUDRUG",da)=Total dispenses
K ^TMP($J,"PSUDRUG")
M ^TMP($J,"PSUDRUG")=^XTMP(PSUARSUB,"DIV_DRUG",PSUDIV)
;
; alphabetize the list of drugs into PSUDRNM()=PSUDRDA
K ^TMP($J,"PSUDRNM")
S PSUDRDA=0 F S PSUDRDA=$O(^TMP($J,"PSUDRUG",PSUDRDA)) Q:'PSUDRDA S ^TMP($J,"PSUDRNM",$$VAL^PSUTL(50,PSUDRDA,.01))=PSUDRDA
;
; Build the drug lines of the message
S PSUNM="",PSUTDISP=0,PSUCOSTT=0
F PSULC=8:1 S PSUNM=$O(^TMP($J,"PSUDRNM",PSUNM)) Q:PSUNM="" D
. S PSUDRDA=^TMP($J,"PSUDRNM",PSUNM)
. ; retrieve drug details
. K PSUD,PSUCAT
. M PSUD=^XTMP(PSUARSUB,"PSUDRUG_DET",PSUDRDA)
. S PSUDISP=^XTMP(PSUARSUB,"DIV_DRUG",PSUDIV,PSUDRDA)
. S PSUCOST=PSUD(16)
. S PSUTCOST=PSUDISP*PSUCOST*100\1/100
. S PSUNFI=PSUD(99999.17),PSUNFI=$S(PSUNFI="":" ",PSUNFI=1:"",1:"#")
. S PSUNONF=PSUD(51),PSUNONF=$S(PSUNONF:"*",1:" ")
. S PSUNMT=$E(PSUNM,1,35)_PSUNONF_PSUNFI
. S PSUCAT=PSUD(301)
. S X=PSUNMT
. S X=$$SETSTR^VALM1($J(PSUDISP,8,2),X,40,8)
. S X=$$SETSTR^VALM1($J(PSUTCOST,8,2),X,52,8)
. S X=$$SETSTR^VALM1(PSUCAT,X,64,$L(PSUCAT))
. S PSUMSG(PSULC)=X
. S PSUTDISP=PSUTDISP+PSUDISP,PSUCOSTT=PSUCOSTT+PSUTCOST
;
S X=""
S $P(X,"-",79)=""
S PSUMSG(PSULC)=X
S X="TOTALS",X=$$SETSTR^VALM1($J(PSUTDISP,8,2),X,40,8),X=$$SETSTR^VALM1($J(PSUCOSTT,8,2),X,52,8)
S PSUMSG(PSULC+1)=X
S PSUMSG(PSULC+2)=" "
S PSUMSG(PSULC+3)="* Non-Formulary"
S PSUMSG(PSULC+4)="# Not on National Formulary"
S PSUMSG(PSULC+5)=" "
;
I '$G(PSUSMRY) D ^XMD
M ^XTMP(PSUARSUB,"REPORT2",PSUDIV)=PSUMSG
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSUAR4 3215 printed Oct 16, 2024@18:28:07 Page 2
PSUAR4 ;BIR/PDW - AR/WS SUMMARY MAILMESSAGES ;25 SEP 1998
+1 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
+2 ;DBIAs
+3 ; Reference to file #40.8 supported by DBIA 2438
+4 ; Reference to file #50 supported by DBIA 221
+5 ;
EN ;EP Generate mail message summaries
+1 ; also store image for printed reports
+2 ;
+3 DO DRUGSUM
+4 ;
+5 QUIT
+6 ;
DRUGSUM ;EP Generate Drug Summary Message(s) by DIV
+1 ; ^XTMP(PSUARSUB,"DIV_DRUG",PSUDIV)=Total Dispenses ;from PSUAR2
+2 SET PSUDIV=0
+3 FOR
SET PSUDIV=$ORDER(^XTMP(PSUARSUB,"DIV_DRUG",PSUDIV))
if PSUDIV=""
QUIT
DO DRUGXMD
+4 QUIT
+5 ;
DRUGXMD ;EP Generate Mail Message with PSUDIV provided
+1 ; Assemble top of message
+2 ; Find Division Name
+3 IF '$DATA(^XTMP(PSUARSUB,"DIV_DRUG"))
QUIT
+4 ;
+5 KILL DIC
+6 ;**1
SET X=PSUDIV
SET DIC=40.8
SET DIC(0)="X"
SET D="C"
DO IX^DIC
+7 SET X=+Y
SET PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
+8 SET XMSUB="V. 4.0 PBMAR "_$GET(PSUMON)_" "_PSUDIV_" "_PSUDIVNM
+9 MERGE XMY=PSUXMYS2
+10 SET XMDUZ=DUZ
+11 SET XMTEXT="PSUMSG("
+12 SET XMCHAN=1
+13 ; start date
SET Y=PSUSDT
XECUTE ^DD("DD")
SET PSUDTS=Y
+14 ; end date
SET Y=PSUEDT
XECUTE ^DD("DD")
SET PSUDTE=Y
+15 NEW PSUMSG
+16 SET PSUMSG(1)=" Automatic Replenishment/Ward Stock Data Summary"
+17 SET PSUMSG(2)=" "_PSUDTS_" through "_PSUDTE_" for "_PSUDIVNM
+18 SET PSUMSG(3)=" "
+19 SET X=""
+20 SET X=$$SETSTR^VALM1("Total",X,40,5)
+21 SET X=$$SETSTR^VALM1("Total",X,52,5)
+22 SET PSUMSG(4)=X
+23 SET X=""
SET X=$$SETSTR^VALM1("Dispensed",X,40,9)
SET X=$$SETSTR^VALM1("Dispensed",X,52,9)
SET X=$$SETSTR^VALM1("AMIS",X,64,4)
+24 SET PSUMSG(5)=X
+25 SET X="DRUG NAME"
SET X=$$SETSTR^VALM1("Units",X,40,5)
SET X=$$SETSTR^VALM1("Cost",X,52,4)
SET X=$$SETSTR^VALM1("Category",X,64,8)
+26 SET PSUMSG(6)=X
+27 SET X=""
SET $PIECE(X,"-",79)=""
+28 SET PSUMSG(7)=X
+29 ;
+30 ; Drug Data: Move into local array ^TMP($J,"PSUDRUG",da)=Total dispenses
+31 KILL ^TMP($JOB,"PSUDRUG")
+32 MERGE ^TMP($JOB,"PSUDRUG")=^XTMP(PSUARSUB,"DIV_DRUG",PSUDIV)
+33 ;
+34 ; alphabetize the list of drugs into PSUDRNM()=PSUDRDA
+35 KILL ^TMP($JOB,"PSUDRNM")
+36 SET PSUDRDA=0
FOR
SET PSUDRDA=$ORDER(^TMP($JOB,"PSUDRUG",PSUDRDA))
if 'PSUDRDA
QUIT
SET ^TMP($JOB,"PSUDRNM",$$VAL^PSUTL(50,PSUDRDA,.01))=PSUDRDA
+37 ;
+38 ; Build the drug lines of the message
+39 SET PSUNM=""
SET PSUTDISP=0
SET PSUCOSTT=0
+40 FOR PSULC=8:1
SET PSUNM=$ORDER(^TMP($JOB,"PSUDRNM",PSUNM))
if PSUNM=""
QUIT
Begin DoDot:1
+41 SET PSUDRDA=^TMP($JOB,"PSUDRNM",PSUNM)
+42 ; retrieve drug details
+43 KILL PSUD,PSUCAT
+44 MERGE PSUD=^XTMP(PSUARSUB,"PSUDRUG_DET",PSUDRDA)
+45 SET PSUDISP=^XTMP(PSUARSUB,"DIV_DRUG",PSUDIV,PSUDRDA)
+46 SET PSUCOST=PSUD(16)
+47 SET PSUTCOST=PSUDISP*PSUCOST*100\1/100
+48 SET PSUNFI=PSUD(99999.17)
SET PSUNFI=$SELECT(PSUNFI="":" ",PSUNFI=1:"",1:"#")
+49 SET PSUNONF=PSUD(51)
SET PSUNONF=$SELECT(PSUNONF:"*",1:" ")
+50 SET PSUNMT=$EXTRACT(PSUNM,1,35)_PSUNONF_PSUNFI
+51 SET PSUCAT=PSUD(301)
+52 SET X=PSUNMT
+53 SET X=$$SETSTR^VALM1($JUSTIFY(PSUDISP,8,2),X,40,8)
+54 SET X=$$SETSTR^VALM1($JUSTIFY(PSUTCOST,8,2),X,52,8)
+55 SET X=$$SETSTR^VALM1(PSUCAT,X,64,$LENGTH(PSUCAT))
+56 SET PSUMSG(PSULC)=X
+57 SET PSUTDISP=PSUTDISP+PSUDISP
SET PSUCOSTT=PSUCOSTT+PSUTCOST
End DoDot:1
+58 ;
+59 SET X=""
+60 SET $PIECE(X,"-",79)=""
+61 SET PSUMSG(PSULC)=X
+62 SET X="TOTALS"
SET X=$$SETSTR^VALM1($JUSTIFY(PSUTDISP,8,2),X,40,8)
SET X=$$SETSTR^VALM1($JUSTIFY(PSUCOSTT,8,2),X,52,8)
+63 SET PSUMSG(PSULC+1)=X
+64 SET PSUMSG(PSULC+2)=" "
+65 SET PSUMSG(PSULC+3)="* Non-Formulary"
+66 SET PSUMSG(PSULC+4)="# Not on National Formulary"
+67 SET PSUMSG(PSULC+5)=" "
+68 ;
+69 IF '$GET(PSUSMRY)
DO ^XMD
+70 MERGE ^XTMP(PSUARSUB,"REPORT2",PSUDIV)=PSUMSG
+71 QUIT
