PSUAR4.m

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 ---PSUAR4   3215     printed  Mar 13, 2025@21:31:53                                                                                                                                                                                                      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