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

PSS192PO.m

Go to the documentation of this file. 
  1. PSS192PO ; ALB/ESG - ePharmacy Compliance Phase 3 PSS patch post install ;10/9/2015
  1.  ;;1.0;PHARMACY DATA MANAGEMENT;**192**;9/30/97;Build 25
  1.  ;
  1.  D BMES^XPDUTL("Starting post-install for PSS*1*192 ... ")
  1.  D DRUGS
  1.  D MES^XPDUTL("Finished with post-install for PSS*1*192.")
  1.  Q
  1.  ;
  1. DRUGS ; loop through DRUG file and make changes
  1.  ;
  1.  ; Examine all drugs and build a scratch global:
  1.  ;   ^TMP(RTN,$J,1,DRUGNAME,DRUGIEN) = OLD DEA ^ NEW DEA ^ CHARACTERS REMOVED
  1.  ;   ^TMP(RTN,$J,2,DRUGNAME,DRUGIEN) = ""    <---  For drugs with BLANK DEA fields
  1.  ;   ^TMP(RTN,$J,3,DRUGIEN)=""               <---  For Billable Drugs
  1.  ;   ^TMP(RTN,$J,4,DRUGIEN)=""               <---  For Non-Billable Drugs
  1.  ;   ^TMP(RTN,$J,5,DRUGIEN)=""               <---  For Sensitive Diagnosis Drugs
  1.  ;
  1.  D MES^XPDUTL("   Examining all Drugs in the Drug file (#50) ... ")
  1.  ;
  1.  N RTN,DRGIEN,DRUGNM,OLDDEA,NEWDEA,STOP,G,EPHBL
  1.  S RTN="PSS192PO"
  1.  K ^TMP(RTN,$J)
  1.  ;
  1.  ; check the drug file data to see if this patch post-install has already been run
  1.  S STOP=0
  1.  S DRGIEN=0 F G=1:1:100 S DRGIEN=$O(^PSDRUG(DRGIEN)) Q:'DRGIEN  D  Q:STOP
  1.  . S EPHBL=$P($G(^PSDRUG(DRGIEN,"EPH")),U,4)
  1.  . I EPHBL'="" S STOP=1 Q      ; already been run, get out
  1.  . Q
  1.  I STOP D MES^XPDUTL("      Patch post-install has already been run. No Changes Made.") G DRGX
  1.  ;
  1.  S DRGIEN=0 F  S DRGIEN=$O(^PSDRUG(DRGIEN)) Q:'DRGIEN  D
  1.  . S DRUGNM=$P($G(^PSDRUG(DRGIEN,0)),U,1) S:DRUGNM="" DRUGNM="~missing drug name"
  1.  . S OLDDEA=$$TRIM^XLFSTR($P($G(^PSDRUG(DRGIEN,0)),U,3))
  1.  . ;
  1.  . ; check for missing DEA, SPECIAL HDLG field
  1.  . I OLDDEA="" D  Q
  1.  .. S ^TMP(RTN,$J,2,DRUGNM,DRGIEN)=""  ; save in scratch for later display
  1.  .. S ^TMP(RTN,$J,4,DRGIEN)=""         ; save drug in non-billable list
  1.  .. Q
  1.  . ;
  1.  . ; Do this block of code for billable/non-billable determination for each drug
  1.  . D
  1.  .. ; Contains M or 0:  Non-Billable
  1.  .. I OLDDEA["M"!(OLDDEA["0") S ^TMP(RTN,$J,4,DRGIEN)="" Q
  1.  .. ;
  1.  .. ; Contains any of these and does not contain "E":  Non-Billable
  1.  .. I (OLDDEA["I"!(OLDDEA["S")!(OLDDEA["9"))!(OLDDEA["N"),OLDDEA'["E" S ^TMP(RTN,$J,4,DRGIEN)="" Q
  1.  .. ;
  1.  .. ; otherwise, drug is billable
  1.  .. S ^TMP(RTN,$J,3,DRGIEN)=""
  1.  .. Q
  1.  . ;
  1.  . ; now work on removing the "E" and the "U" characters
  1.  . I OLDDEA["E",OLDDEA["U" D DEA("EU")     ; DEA indicates both billable and sensitive dx
  1.  . I OLDDEA["E",OLDDEA'["U" D DEA("E")     ; DEA indicates billable only
  1.  . I OLDDEA'["E",OLDDEA["U" D DEA("U")     ; DEA indicates sensitive dx only
  1.  . Q
  1.  ;
  1.  ; Now loop through the Scratch global areas and make changes to the database
  1.  D MES^XPDUTL("   Updating the values of the DEA, SPECIAL HDLG field ... ")
  1.  S DRUGNM="" F  S DRUGNM=$O(^TMP(RTN,$J,1,DRUGNM)) Q:DRUGNM=""  S DRGIEN=0 F  S DRGIEN=$O(^TMP(RTN,$J,1,DRUGNM,DRGIEN)) Q:'DRGIEN  D
  1.  . N DIE,DA,DR
  1.  . S NEWDEA=$P($G(^TMP(RTN,$J,1,DRUGNM,DRGIEN)),U,2) S:NEWDEA="" NEWDEA="@"
  1.  . S DIE=50,DA=DRGIEN,DR="3////"_NEWDEA D ^DIE
  1.  . Q
  1.  ;
  1.  D MES^XPDUTL("   Updating the values of the ePharmacy Billable field ... ")
  1.  ; Billable area
  1.  S DRGIEN=0 F  S DRGIEN=$O(^TMP(RTN,$J,3,DRGIEN)) Q:'DRGIEN  D
  1.  . N DIE,DA,DR
  1.  . S DIE=50,DA=DRGIEN,DR="84////1" D ^DIE     ; billable
  1.  ;
  1.  ; Non-Billable area
  1.  S DRGIEN=0 F  S DRGIEN=$O(^TMP(RTN,$J,4,DRGIEN)) Q:'DRGIEN  D
  1.  . N DIE,DA,DR
  1.  . S DIE=50,DA=DRGIEN,DR="84////0" D ^DIE     ; non-billable
  1.  . Q
  1.  ;
  1.  D MES^XPDUTL("   Updating the values of the Sensitive Diagnosis Drug field ... ")
  1.  S DRGIEN=0 F  S DRGIEN=$O(^TMP(RTN,$J,5,DRGIEN)) Q:'DRGIEN  D
  1.  . N DIE,DA,DR
  1.  . S DIE=50,DA=DRGIEN,DR="87////1" D ^DIE     ; sensitive diagnosis drug
  1.  . Q
  1.  ;
  1.  D MES^XPDUTL("   Generating and sending the ePharmacy Drug File Changes report ... ")
  1.  D EMAIL
  1.  ;
  1. DRGX ;
  1.  D MES^XPDUTL("   Done with ePharmacy Drug File Changes.")
  1.  K ^TMP(RTN,$J)
  1.  Q
  1.  ;
  1. DEA(CHAR) ; remove characters from DEA and save new DEA and drug action to be taken
  1.  S NEWDEA=$TR(OLDDEA,CHAR)                                  ; remove characters from DEA value
  1.  S ^TMP(RTN,$J,1,DRUGNM,DRGIEN)=OLDDEA_U_NEWDEA_U_CHAR      ; save drug for DEA changes
  1.  I CHAR["U" S ^TMP(RTN,$J,5,DRGIEN)=""                      ; add drug to sensitive dx list if "U"
  1.  I NEWDEA="" S ^TMP(RTN,$J,2,DRUGNM,DRGIEN)=""              ; if the new DEA field is now blank, save it for display
  1.  Q
  1.  ;
  1. EMAIL ; send email when patch is installed and this post-install message is run
  1.  N SUBJ,MSG,XMTO,GLO,GLB,XMINSTR,NOTIF,SITE,G,DEACNT,DRUGNM,DRGIEN,NILCNT,USR
  1.  S SITE=$$SITE^VASITE
  1.  S SUBJ="ePharmacy Drug File Changes: PSS*1*192 #"_$P(SITE,U,3)_" #"_$P(SITE,U,2)
  1.  S SUBJ=$E(SUBJ,1,65)
  1.  S G=0
  1.  S G=G+1,MSG(G)="VistA patch PSS*1*192 was successfully installed at your site."
  1.  S G=G+1,MSG(G)=""
  1.  S G=G+1,MSG(G)="        Name: "_$P(SITE,U,2)
  1.  S G=G+1,MSG(G)="    Station#: "_$P(SITE,U,3)
  1.  S G=G+1,MSG(G)="   Date/Time: "_$$FMTE^XLFDT($$NOW^XLFDT,"5ZPM")
  1.  S G=G+1,MSG(G)="          By: "_$P($G(^VA(200,DUZ,0)),U,1)
  1.  S G=G+1,MSG(G)=""
  1.  S G=G+1,MSG(G)="The following entries in your DRUG file (#50) have been modified to remove"
  1.  S G=G+1,MSG(G)="characters ""E"" Electronically Billable and ""U"" Sensitive Diagnosis from the"
  1.  S G=G+1,MSG(G)="DEA, Special Handling field. The functions of both characters have been"
  1.  S G=G+1,MSG(G)="replaced by the following new DRUG file (#50) fields to maintain consistency"
  1.  S G=G+1,MSG(G)="throughout the VA:"
  1.  S G=G+1,MSG(G)=""
  1.  S G=G+1,MSG(G)="     (Field #84)   ePharmacy Billable:"
  1.  S G=G+1,MSG(G)="     (Field #85)     ePharmacy Billable (TRICARE):"
  1.  S G=G+1,MSG(G)="     (Field #86)     ePharmacy Billable (CHAMPVA):"
  1.  S G=G+1,MSG(G)="     (Field #87)   Sensitive Diagnosis Drug:"
  1.  S G=G+1,MSG(G)=""
  1.  S G=G+1,MSG(G)="1.  The ePharmacy Billable field and the Sensitive Diagnosis Drug field have"
  1.  S G=G+1,MSG(G)="    been answered YES or NO based on the data in the DEA, Special Handling"
  1.  S G=G+1,MSG(G)="    field."
  1.  S G=G+1,MSG(G)=""
  1.  S G=G+1,MSG(G)="2.  Drug file entries without the E and U were also marked as ePharmacy"
  1.  S G=G+1,MSG(G)="    Billable Yes or No, depending on the existing DEA, Special Handling field"
  1.  S G=G+1,MSG(G)="    configuration at the time PSS*1*192 was loaded, using the following"
  1.  S G=G+1,MSG(G)="    criteria:"
  1.  S G=G+1,MSG(G)=""
  1.  S G=G+1,MSG(G)="        DEA, Special Handling"
  1.  S G=G+1,MSG(G)="        Field Criteria                      Billable"
  1.  S G=G+1,MSG(G)="        --------------------------------------------"
  1.  S G=G+1,MSG(G)="        Null                                   N"
  1.  S G=G+1,MSG(G)="        Contains ""M"" or ""0"" (Zero)             N"
  1.  S G=G+1,MSG(G)="        Contains ""I"" or ""S"" or ""N"" or ""9"""
  1.  S G=G+1,MSG(G)="           and DOES NOT contain ""E""            N"
  1.  S G=G+1,MSG(G)="        Contains ""I"" or ""S"" or ""N"" or ""9"""
  1.  S G=G+1,MSG(G)="           and DOES contain ""E""                Y"
  1.  S G=G+1,MSG(G)="        All Other Entries                      Y"
  1.  S G=G+1,MSG(G)=""
  1.  S G=G+1,MSG(G)="3.  It is an exception to have a Null DEA, Special Handling field for a Drug"
  1.  S G=G+1,MSG(G)="    file item.  If you have items on this list whose DEA, Special Handling"
  1.  S G=G+1,MSG(G)="    field was null, it is suggested that you populate the DEA, Special Handling"
  1.  S G=G+1,MSG(G)="    field and mark those items as billable, if appropriate."
  1.  S G=G+1,MSG(G)=""
  1.  S G=G+1,MSG(G)="    Here is a Legend for the existing DEA, Special Handling field values:"
  1.  S G=G+1,MSG(G)="         0          MANUFACTURED IN PHARMACY"
  1.  S G=G+1,MSG(G)="         1          SCHEDULE 1 ITEM"
  1.  S G=G+1,MSG(G)="         2          SCHEDULE 2 ITEM"
  1.  S G=G+1,MSG(G)="         3          SCHEDULE 3 ITEM"
  1.  S G=G+1,MSG(G)="         4          SCHEDULE 4 ITEM"
  1.  S G=G+1,MSG(G)="         5          SCHEDULE 5 ITEM"
  1.  S G=G+1,MSG(G)="         6          LEGEND ITEM"
  1.  S G=G+1,MSG(G)="         9          OVER-THE-COUNTER"
  1.  S G=G+1,MSG(G)="         L          DEPRESSANTS AND STIMULANTS"
  1.  S G=G+1,MSG(G)="         A          NARCOTICS AND ALCOHOLS"
  1.  S G=G+1,MSG(G)="         P          DATED DRUGS"
  1.  S G=G+1,MSG(G)="         I          INVESTIGATIONAL DRUGS"
  1.  S G=G+1,MSG(G)="         M          BULK COMPOUND ITEMS"
  1.  S G=G+1,MSG(G)="         C          CONTROLLED SUBSTANCES - NON NARCOTIC"
  1.  S G=G+1,MSG(G)="         R          RESTRICTED ITEMS"
  1.  S G=G+1,MSG(G)="         S          SUPPLY ITEMS"
  1.  S G=G+1,MSG(G)="         B          ALLOW REFILL (SCH. 3, 4, 5 ONLY)"
  1.  S G=G+1,MSG(G)="         W          NOT RENEWABLE"
  1.  S G=G+1,MSG(G)="         F          NON REFILLABLE"
  1.  S G=G+1,MSG(G)="         N          NUTRITIONAL SUPPLEMENT"
  1.  S G=G+1,MSG(G)=""
  1.  S G=G+1,MSG(G)=""
  1.  S G=G+1,MSG(G)="-------------------------------------------------------------------------------"
  1.  S G=G+1,MSG(G)="                                             DEA Special Handling Field"
  1.  S G=G+1,MSG(G)="GENERIC NAME                                OLD        NEW       REMOVED"
  1.  S G=G+1,MSG(G)="-------------------------------------------------------------------------------"
  1.  ;
  1.  ; loop through the 1 area of the scratch global and populate the message with the DEA changes
  1.  S DEACNT=0
  1.  S DRUGNM="" F  S DRUGNM=$O(^TMP(RTN,$J,1,DRUGNM)) Q:DRUGNM=""  S DRGIEN=0 F  S DRGIEN=$O(^TMP(RTN,$J,1,DRUGNM,DRGIEN)) Q:'DRGIEN  D
  1.  . N AB
  1.  . S AB=$G(^TMP(RTN,$J,1,DRUGNM,DRGIEN))
  1.  . I $P(AB,U,2)="" S $P(AB,U,2)="-"
  1.  . S G=G+1,MSG(G)=$$LJ^XLFSTR(DRUGNM,44)_$$LJ^XLFSTR($P(AB,U,1),11)_$$LJ^XLFSTR($P(AB,U,2),11)_$P(AB,U,3)
  1.  . S DEACNT=DEACNT+1
  1.  . Q
  1.  ;
  1.  S G=G+1,MSG(G)=""
  1.  S G=G+1,MSG(G)="Total Drugs Modified:  "_DEACNT
  1.  S G=G+1,MSG(G)=""
  1.  S G=G+1,MSG(G)="No other changes were made to the DEA, Special Handling field for any other"
  1.  S G=G+1,MSG(G)="Drug File entries."
  1.  S G=G+1,MSG(G)=""
  1.  S G=G+1,MSG(G)=""
  1.  S G=G+1,MSG(G)="The following drugs do not have any value in the DEA Special Handling Field."
  1.  S G=G+1,MSG(G)=""
  1.  S G=G+1,MSG(G)="----------------------------------------"
  1.  S G=G+1,MSG(G)="GENERIC NAME"
  1.  S G=G+1,MSG(G)="----------------------------------------"
  1.  ;
  1.  ; loop through the 2 area of the scratch global to display drugs with Blank DEA fields
  1.  S NILCNT=0
  1.  S DRUGNM="" F  S DRUGNM=$O(^TMP(RTN,$J,2,DRUGNM)) Q:DRUGNM=""  S DRGIEN=0 F  S DRGIEN=$O(^TMP(RTN,$J,2,DRUGNM,DRGIEN)) Q:'DRGIEN  D
  1.  . S G=G+1,MSG(G)=DRUGNM
  1.  . S NILCNT=NILCNT+1
  1.  . Q
  1.  ;
  1.  S G=G+1,MSG(G)=""
  1.  S G=G+1,MSG(G)="Total Drugs with Blank DEA Special Handling:  "_NILCNT
  1.  S G=G+1,MSG(G)=""
  1.  S G=G+1,MSG(G)=""
  1.  ;
  1.  ; Now we need to address the message
  1.  ;   - send it to holders of the PSO EPHARMACY SITE MANAGER key
  1.  ;   - send it to the installer (DUZ)
  1.  ;   - send it to Gregory Laird in VA Outlook (production only)
  1.  ;   - send it to selected project team members (production only)
  1.  S USR=0 F  S USR=$O(^XUSEC("PSO EPHARMACY SITE MANAGER",USR)) Q:'USR  S XMTO(USR)=""
  1.  S XMTO(DUZ)=""
  1.  I $$PROD^XUPROD(1) D
  1.  . S XMTO("Gregory.Laird@domain.ext")=""
  1.  . S XMTO("Eric.Gustafson@domain.ext")=""
  1.  . S XMTO("lucille.harmon@domain.ext")=""
  1.  . Q
  1.  ;
  1.  S XMINSTR("FROM")="PSS.1.192.POST"
  1.  ;
  1.  D SENDMSG^XMXAPI(DUZ,SUBJ,"MSG",.XMTO,.XMINSTR)
  1.  I '$D(^TMP("XMERR",$J)) G EMAILX    ; no email problems so get out
  1.  ;
  1.  D MES^XPDUTL("MailMan reported a problem trying to send the PSS patch install/Drug File report message.")
  1.  D MES^XPDUTL("  ")
  1.  S (GLO,GLB)="^TMP(""XMERR"","_$J
  1.  S GLO=GLO_")"
  1.  F  S GLO=$Q(@GLO) Q:GLO'[GLB  D MES^XPDUTL("   "_GLO_" = "_$G(@GLO))
  1.  D MES^XPDUTL("  ")
  1.  ;
  1. EMAILX ;
  1.  Q
  1.  ;