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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSUPR5 4852 printed Sep 23, 2025@20:04:01 Page 2
PSUPR5 ;BIR/PDW - PROCUREMENT EXTRACT SUMMARY MESSAGE GENERATOR ;10 JUL 1999
+1 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
+2 ;DBIA(s)
+3 ; Reference to file #40.8 supported by DBIA 2438
+4 ;
EN ;EP generate Total & Cost summary
+1 ;
EN1 NEW PSUITT,PSUREC,PSUTC
+1 ;PSUITT - TOTAL ITEMS
+2 ;PSUTC - TOTAL COST
+3 if '$DATA(PSUPRJOB)
SET PSUPRJOB=PSUJOB
+4 if '$DATA(PSUPRSUB)
SET PSUPRSUB="PSUPR_"_PSUPRJOB
+5 ;
+6 IF '$DATA(^XTMP(PSUPRSUB,"RECORDS"))
GOTO NODATA
DIV ;EP Loop by Division
+1 SET PSUDIV=""
FOR
SET PSUDIV=$ORDER(^XTMP(PSUPRSUB,"RECORDS",PSUDIV))
if PSUDIV=""
QUIT
DO MESSAGE
+2 QUIT
+3 ;
MESSAGE ;EP Generate Summary Messages for a Division
+1 ;
+2 ;**1
SET X=PSUDIV
SET DIC=40.8
SET DIC(0)="X"
SET D="C"
DO IX^DIC
+3 SET X=+Y
SET PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
MSG1 ; Generate 1st summary message
+1 ;
+2 SET PSUITT=0
SET PSUTC=0
+3 ;
+4 ; loop to get totals from records stored
+5 SET PSUREC=0
+6 ;
KILL ^TMP($JOB,"PSUITNM")
+7 FOR
SET PSUREC=$ORDER(^XTMP(PSUPRSUB,"RECORDS",PSUDIV,PSUREC))
if PSUREC'>0
QUIT
SET X=^(PSUREC)
SET PSUTC=PSUTC+$PIECE(X,U,19)
SET PSUIT=$PIECE(X,U,8)
if PSUIT=""
SET PSUIT=$PIECE(X,U,7)
if PSUIT'=""
SET ^TMP($JOB,"PSUITNM",PSUIT)=""
+8 ; get number of unique items stored in PSUITNM
+9 SET X=""
FOR PSUITT=0:1
SET X=$ORDER(^TMP($JOB,"PSUITNM",X))
if X=""
QUIT
+10 KILL ^TMP($JOB,"PSUITNM")
+11 SET XMDUZ=DUZ
+12 MERGE XMY=PSUXMYS1
+13 ;
+14 ; start date
SET Y=PSUSDT
XECUTE ^DD("DD")
SET PSUDTS=Y
+15 ; end date
SET Y=PSUEDT
XECUTE ^DD("DD")
SET PSUDTE=Y
+16 NEW PSUMSG
+17 SET PSUMSG(1)=" Procurement Statistical Summary"
+18 SET PSUMSG(2)=" "_PSUDTS_" through "_PSUDTE_" for "_PSUDIVNM
+19 SET PSUMSG(3)=" "
+20 SET PSUMSG(4)="Total of Drug/Supply Items: "_PSUITT
+21 SET PSUMSG(5)="Total Cost: $ "_PSUTC
+22 SET PSUMSG(6)=" "
+23 ;**1
SET X=PSUDIV
SET DIC=40.8
SET DIC(0)="X"
SET D="C"
DO IX^DIC
+24 SET X=+Y
SET PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
+25 SET XMSUB="V. 4.0 PBMPR "_$GET(PSUMON)_" "_PSUDIV_" "_PSUDIVNM
+26 ;Eliminate empty CoreFLS messages
if PSUDIV=0
QUIT
+27 SET XMTEXT="PSUMSG("
+28 SET XMCHAN=1
+29 MERGE ^XTMP(PSUPRSUB,"REPORT1",PSUDIV)=PSUMSG
+30 DO ^XMD
+31 KILL PSUMSG
+32 ;
MSG2 ; SUMMARY BY DRUG
+1 ; loop records stored
+2 ; psunm - name, psudisp - disp unit, psutq - total quantity, psutc - total cost
+3 SET PSUREC=0
SET PSUDRNM=""
+4 KILL ^XTMP(PSUPRSUB,"DRUG")
+5 FOR
SET PSUREC=$ORDER(^XTMP(PSUPRSUB,"RECORDS",PSUDIV,PSUREC))
if PSUREC'>0
QUIT
SET X=^(PSUREC)
Begin DoDot:1
+6 SET PSUNM=$PIECE(X,U,8)
SET PSUTQ=$PIECE(X,U,17)
SET PSUTC=$PIECE(X,U,19)
SET PSUDISP=$PIECE(X,U,12)
+7 if PSUNM=""
SET PSUNM=$PIECE(X,U,7)
+8 SET PSUNM=$EXTRACT(PSUNM,1,30)
+9 IF '$LENGTH(PSUNM)
QUIT
+10 SET ^XTMP(PSUPRSUB,"DRUG",PSUNM)=""
+11 SET ^XTMP(PSUPRSUB,"DRUG",PSUNM,"TQ")=$GET(^XTMP(PSUPRSUB,"DRUG",PSUNM,"TQ"))+PSUTQ
+12 SET ^XTMP(PSUPRSUB,"DRUG",PSUNM,"TC")=$GET(^XTMP(PSUPRSUB,"DRUG",PSUNM,"TC"))+PSUTC
+13 SET ^XTMP(PSUPRSUB,"DRUG",PSUNM,"DISP")=PSUDISP
End DoDot:1
+14 ;
+15 ;
+16 SET PSUG="^XTMP(PSUPRSUB,""REPORT2"",PSUDIV)"
+17 KILL @PSUG
+18 SET @PSUG@(1)=" Procurement Data Summary"
+19 SET @PSUG@(2)=" "_PSUDTS_" through "_PSUDTE_" for "_PSUDIVNM
+20 SET @PSUG@(3)=" "
+21 SET X=""
SET X=$$SETSTR^VALM1("Dispense",X,53,8)
SET X=$$SETSTR^VALM1("Total",X,63,5)
SET X=$$SETSTR^VALM1("Total",X,73,5)
+22 SET @PSUG@(4)=X
+23 SET X="Drug/Supply Name"
SET X=$$SETSTR^VALM1("Unit",X,53,4)
SET X=$$SETSTR^VALM1("Qty",X,63,3)
SET X=$$SETSTR^VALM1("Cost",X,73,4)
+24 SET @PSUG@(5)=X
+25 SET X=""
SET $PIECE(X,"-",79)=""
+26 SET @PSUG@(6)=X
+27 SET PSULC=6
+28 NEW PSUNM,PSUDISP,PSUTQ,PSUTC,PSUTQT,PSUTCT
+29 SET (PSUTQT,PSUDISP,PSUTQ,PSUTC,PSUTCT)=0
+30 ; loop drug names
+31 SET PSUNM=""
+32 FOR
SET PSUNM=$ORDER(^XTMP(PSUPRSUB,"DRUG",PSUNM))
if PSUNM=""
QUIT
SET PSUTQ=^XTMP(PSUPRSUB,"DRUG",PSUNM,"TQ")
SET PSUTC=^("TC")
SET PSUDISP=^("DISP")
Begin DoDot:1
+33 SET PSULC=PSULC+1
+34 SET PSUTQT=$GET(PSUTQT)+PSUTQ
SET PSUTCT=$GET(PSUTCT)+PSUTC
+35 SET X=$EXTRACT(PSUNM,1,50)
+36 SET X=$$SETSTR^VALM1(PSUDISP,X,53,$LENGTH(PSUDISP))
+37 SET X=$$SETSTR^VALM1($JUSTIFY(PSUTQ,6,0),X,62,6)
+38 SET X=$$SETSTR^VALM1($JUSTIFY(PSUTC,8,2),X,70,8)
+39 SET @PSUG@(PSULC)=X
End DoDot:1
+40 ;
+41 SET X=""
SET $PIECE(X,"-",79)=""
+42 SET PSULC=PSULC+1
+43 SET @PSUG@(PSULC)=X
+44 SET X="Total"
SET X=$$SETSTR^VALM1($JUSTIFY(PSUTQT,6,0),X,62,6)
SET X=$$SETSTR^VALM1($JUSTIFY(PSUTCT,8,2),X,70,8)
+45 SET PSULC=PSULC+1
+46 SET @PSUG@(PSULC)=X
+47 SET @PSUG@(PSULC+1)=" "
+48 SET XMSUB="V. 4.0 PBMPR "_$GET(PSUMON)_" "_PSUDIV_" "_PSUDIVNM
+49 SET XMTEXT="^XTMP(PSUPRSUB,""REPORT2"",PSUDIV,"
+50 SET XMCHAN=1
+51 MERGE XMY=PSUXMYS2
+52 IF '$GET(PSUSMRY)
DO ^XMD
+53 QUIT
NODATA ;EP SEND NO DATA MESSAGE
+1 SET XMDUZ=DUZ
+2 MERGE XMY=PSUXMYS1
+3 ;
+4 SET PSUDIV=PSUSNDR
+5 ;**1
SET X=PSUDIV
SET DIC=40.8
SET DIC(0)="X"
SET D="C"
DO IX^DIC
+6 SET X=+Y
SET PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
+7 ; start date
SET Y=PSUSDT
XECUTE ^DD("DD")
SET PSUDTS=Y
+8 ; end date
SET Y=PSUEDT
XECUTE ^DD("DD")
SET PSUDTE=Y
+9 SET XMSUB="V. 4.0 PBMPR "_$GET(PSUMON)_" "_PSUDIV_" "_PSUDIVNM
+10 SET XMTEXT="^XTMP(PSUPRSUB,""REPORT2"",PSUDIV,"
+11 SET XMCHAN=1
+12 KILL X
+13 SET X(1)=" Procurement Statistical Summary"
+14 SET X(2)=" "_PSUDTS_" through "_PSUDTE_" for "_PSUDIVNM
+15 SET X(3)=" "
+16 SET X(4)="No data to report"
+17 SET X(5)=" "
+18 MERGE ^XTMP(PSUPRSUB,"REPORT1",PSUDIV)=X
+19 SET XMTEXT="X("
+20 if $GET(PSUDUZ)
SET XMY(PSUDUZ)=""
+21 DO ^XMD
+22 SET X(1)=" Procurement Data Summary"
+23 ;store for print cycle
MERGE ^XTMP(PSUPRSUB,"REPORT2",PSUDIV)=X
+24 QUIT
