- 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 Jan 18, 2025@03:29:03 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