Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSUPR5

PSUPR5.m

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