PSS192PO ; ALB/ESG - ePharmacy Compliance Phase 3 PSS patch post install ;10/9/2015
;;1.0;PHARMACY DATA MANAGEMENT;**192**;9/30/97;Build 25
;
D BMES^XPDUTL("Starting post-install for PSS*1*192 ... ")
D DRUGS
D MES^XPDUTL("Finished with post-install for PSS*1*192.")
Q
;
DRUGS ; loop through DRUG file and make changes
;
; Examine all drugs and build a scratch global:
; ^TMP(RTN,$J,1,DRUGNAME,DRUGIEN) = OLD DEA ^ NEW DEA ^ CHARACTERS REMOVED
; ^TMP(RTN,$J,2,DRUGNAME,DRUGIEN) = "" <--- For drugs with BLANK DEA fields
; ^TMP(RTN,$J,3,DRUGIEN)="" <--- For Billable Drugs
; ^TMP(RTN,$J,4,DRUGIEN)="" <--- For Non-Billable Drugs
; ^TMP(RTN,$J,5,DRUGIEN)="" <--- For Sensitive Diagnosis Drugs
;
D MES^XPDUTL(" Examining all Drugs in the Drug file (#50) ... ")
;
N RTN,DRGIEN,DRUGNM,OLDDEA,NEWDEA,STOP,G,EPHBL
S RTN="PSS192PO"
K ^TMP(RTN,$J)
;
; check the drug file data to see if this patch post-install has already been run
S STOP=0
S DRGIEN=0 F G=1:1:100 S DRGIEN=$O(^PSDRUG(DRGIEN)) Q:'DRGIEN D Q:STOP
. S EPHBL=$P($G(^PSDRUG(DRGIEN,"EPH")),U,4)
. I EPHBL'="" S STOP=1 Q ; already been run, get out
. Q
I STOP D MES^XPDUTL(" Patch post-install has already been run. No Changes Made.") G DRGX
;
S DRGIEN=0 F S DRGIEN=$O(^PSDRUG(DRGIEN)) Q:'DRGIEN D
. S DRUGNM=$P($G(^PSDRUG(DRGIEN,0)),U,1) S:DRUGNM="" DRUGNM="~missing drug name"
. S OLDDEA=$$TRIM^XLFSTR($P($G(^PSDRUG(DRGIEN,0)),U,3))
. ;
. ; check for missing DEA, SPECIAL HDLG field
. I OLDDEA="" D Q
.. S ^TMP(RTN,$J,2,DRUGNM,DRGIEN)="" ; save in scratch for later display
.. S ^TMP(RTN,$J,4,DRGIEN)="" ; save drug in non-billable list
.. Q
. ;
. ; Do this block of code for billable/non-billable determination for each drug
. D
.. ; Contains M or 0: Non-Billable
.. I OLDDEA["M"!(OLDDEA["0") S ^TMP(RTN,$J,4,DRGIEN)="" Q
.. ;
.. ; Contains any of these and does not contain "E": Non-Billable
.. I (OLDDEA["I"!(OLDDEA["S")!(OLDDEA["9"))!(OLDDEA["N"),OLDDEA'["E" S ^TMP(RTN,$J,4,DRGIEN)="" Q
.. ;
.. ; otherwise, drug is billable
.. S ^TMP(RTN,$J,3,DRGIEN)=""
.. Q
. ;
. ; now work on removing the "E" and the "U" characters
. I OLDDEA["E",OLDDEA["U" D DEA("EU") ; DEA indicates both billable and sensitive dx
. I OLDDEA["E",OLDDEA'["U" D DEA("E") ; DEA indicates billable only
. I OLDDEA'["E",OLDDEA["U" D DEA("U") ; DEA indicates sensitive dx only
. Q
;
; Now loop through the Scratch global areas and make changes to the database
D MES^XPDUTL(" Updating the values of the DEA, SPECIAL HDLG field ... ")
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
. N DIE,DA,DR
. S NEWDEA=$P($G(^TMP(RTN,$J,1,DRUGNM,DRGIEN)),U,2) S:NEWDEA="" NEWDEA="@"
. S DIE=50,DA=DRGIEN,DR="3////"_NEWDEA D ^DIE
. Q
;
D MES^XPDUTL(" Updating the values of the ePharmacy Billable field ... ")
; Billable area
S DRGIEN=0 F S DRGIEN=$O(^TMP(RTN,$J,3,DRGIEN)) Q:'DRGIEN D
. N DIE,DA,DR
. S DIE=50,DA=DRGIEN,DR="84////1" D ^DIE ; billable
;
; Non-Billable area
S DRGIEN=0 F S DRGIEN=$O(^TMP(RTN,$J,4,DRGIEN)) Q:'DRGIEN D
. N DIE,DA,DR
. S DIE=50,DA=DRGIEN,DR="84////0" D ^DIE ; non-billable
. Q
;
D MES^XPDUTL(" Updating the values of the Sensitive Diagnosis Drug field ... ")
S DRGIEN=0 F S DRGIEN=$O(^TMP(RTN,$J,5,DRGIEN)) Q:'DRGIEN D
. N DIE,DA,DR
. S DIE=50,DA=DRGIEN,DR="87////1" D ^DIE ; sensitive diagnosis drug
. Q
;
D MES^XPDUTL(" Generating and sending the ePharmacy Drug File Changes report ... ")
D EMAIL
;
DRGX ;
D MES^XPDUTL(" Done with ePharmacy Drug File Changes.")
K ^TMP(RTN,$J)
Q
;
DEA(CHAR) ; remove characters from DEA and save new DEA and drug action to be taken
S NEWDEA=$TR(OLDDEA,CHAR) ; remove characters from DEA value
S ^TMP(RTN,$J,1,DRUGNM,DRGIEN)=OLDDEA_U_NEWDEA_U_CHAR ; save drug for DEA changes
I CHAR["U" S ^TMP(RTN,$J,5,DRGIEN)="" ; add drug to sensitive dx list if "U"
I NEWDEA="" S ^TMP(RTN,$J,2,DRUGNM,DRGIEN)="" ; if the new DEA field is now blank, save it for display
Q
;
EMAIL ; send email when patch is installed and this post-install message is run
N SUBJ,MSG,XMTO,GLO,GLB,XMINSTR,NOTIF,SITE,G,DEACNT,DRUGNM,DRGIEN,NILCNT,USR
S SITE=$$SITE^VASITE
S SUBJ="ePharmacy Drug File Changes: PSS*1*192 #"_$P(SITE,U,3)_" #"_$P(SITE,U,2)
S SUBJ=$E(SUBJ,1,65)
S G=0
S G=G+1,MSG(G)="VistA patch PSS*1*192 was successfully installed at your site."
S G=G+1,MSG(G)=""
S G=G+1,MSG(G)=" Name: "_$P(SITE,U,2)
S G=G+1,MSG(G)=" Station#: "_$P(SITE,U,3)
S G=G+1,MSG(G)=" Date/Time: "_$$FMTE^XLFDT($$NOW^XLFDT,"5ZPM")
S G=G+1,MSG(G)=" By: "_$P($G(^VA(200,DUZ,0)),U,1)
S G=G+1,MSG(G)=""
S G=G+1,MSG(G)="The following entries in your DRUG file (#50) have been modified to remove"
S G=G+1,MSG(G)="characters ""E"" Electronically Billable and ""U"" Sensitive Diagnosis from the"
S G=G+1,MSG(G)="DEA, Special Handling field. The functions of both characters have been"
S G=G+1,MSG(G)="replaced by the following new DRUG file (#50) fields to maintain consistency"
S G=G+1,MSG(G)="throughout the VA:"
S G=G+1,MSG(G)=""
S G=G+1,MSG(G)=" (Field #84) ePharmacy Billable:"
S G=G+1,MSG(G)=" (Field #85) ePharmacy Billable (TRICARE):"
S G=G+1,MSG(G)=" (Field #86) ePharmacy Billable (CHAMPVA):"
S G=G+1,MSG(G)=" (Field #87) Sensitive Diagnosis Drug:"
S G=G+1,MSG(G)=""
S G=G+1,MSG(G)="1. The ePharmacy Billable field and the Sensitive Diagnosis Drug field have"
S G=G+1,MSG(G)=" been answered YES or NO based on the data in the DEA, Special Handling"
S G=G+1,MSG(G)=" field."
S G=G+1,MSG(G)=""
S G=G+1,MSG(G)="2. Drug file entries without the E and U were also marked as ePharmacy"
S G=G+1,MSG(G)=" Billable Yes or No, depending on the existing DEA, Special Handling field"
S G=G+1,MSG(G)=" configuration at the time PSS*1*192 was loaded, using the following"
S G=G+1,MSG(G)=" criteria:"
S G=G+1,MSG(G)=""
S G=G+1,MSG(G)=" DEA, Special Handling"
S G=G+1,MSG(G)=" Field Criteria Billable"
S G=G+1,MSG(G)=" --------------------------------------------"
S G=G+1,MSG(G)=" Null N"
S G=G+1,MSG(G)=" Contains ""M"" or ""0"" (Zero) N"
S G=G+1,MSG(G)=" Contains ""I"" or ""S"" or ""N"" or ""9"""
S G=G+1,MSG(G)=" and DOES NOT contain ""E"" N"
S G=G+1,MSG(G)=" Contains ""I"" or ""S"" or ""N"" or ""9"""
S G=G+1,MSG(G)=" and DOES contain ""E"" Y"
S G=G+1,MSG(G)=" All Other Entries Y"
S G=G+1,MSG(G)=""
S G=G+1,MSG(G)="3. It is an exception to have a Null DEA, Special Handling field for a Drug"
S G=G+1,MSG(G)=" file item. If you have items on this list whose DEA, Special Handling"
S G=G+1,MSG(G)=" field was null, it is suggested that you populate the DEA, Special Handling"
S G=G+1,MSG(G)=" field and mark those items as billable, if appropriate."
S G=G+1,MSG(G)=""
S G=G+1,MSG(G)=" Here is a Legend for the existing DEA, Special Handling field values:"
S G=G+1,MSG(G)=" 0 MANUFACTURED IN PHARMACY"
S G=G+1,MSG(G)=" 1 SCHEDULE 1 ITEM"
S G=G+1,MSG(G)=" 2 SCHEDULE 2 ITEM"
S G=G+1,MSG(G)=" 3 SCHEDULE 3 ITEM"
S G=G+1,MSG(G)=" 4 SCHEDULE 4 ITEM"
S G=G+1,MSG(G)=" 5 SCHEDULE 5 ITEM"
S G=G+1,MSG(G)=" 6 LEGEND ITEM"
S G=G+1,MSG(G)=" 9 OVER-THE-COUNTER"
S G=G+1,MSG(G)=" L DEPRESSANTS AND STIMULANTS"
S G=G+1,MSG(G)=" A NARCOTICS AND ALCOHOLS"
S G=G+1,MSG(G)=" P DATED DRUGS"
S G=G+1,MSG(G)=" I INVESTIGATIONAL DRUGS"
S G=G+1,MSG(G)=" M BULK COMPOUND ITEMS"
S G=G+1,MSG(G)=" C CONTROLLED SUBSTANCES - NON NARCOTIC"
S G=G+1,MSG(G)=" R RESTRICTED ITEMS"
S G=G+1,MSG(G)=" S SUPPLY ITEMS"
S G=G+1,MSG(G)=" B ALLOW REFILL (SCH. 3, 4, 5 ONLY)"
S G=G+1,MSG(G)=" W NOT RENEWABLE"
S G=G+1,MSG(G)=" F NON REFILLABLE"
S G=G+1,MSG(G)=" N NUTRITIONAL SUPPLEMENT"
S G=G+1,MSG(G)=""
S G=G+1,MSG(G)=""
S G=G+1,MSG(G)="-------------------------------------------------------------------------------"
S G=G+1,MSG(G)=" DEA Special Handling Field"
S G=G+1,MSG(G)="GENERIC NAME OLD NEW REMOVED"
S G=G+1,MSG(G)="-------------------------------------------------------------------------------"
;
; loop through the 1 area of the scratch global and populate the message with the DEA changes
S DEACNT=0
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
. N AB
. S AB=$G(^TMP(RTN,$J,1,DRUGNM,DRGIEN))
. I $P(AB,U,2)="" S $P(AB,U,2)="-"
. 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)
. S DEACNT=DEACNT+1
. Q
;
S G=G+1,MSG(G)=""
S G=G+1,MSG(G)="Total Drugs Modified: "_DEACNT
S G=G+1,MSG(G)=""
S G=G+1,MSG(G)="No other changes were made to the DEA, Special Handling field for any other"
S G=G+1,MSG(G)="Drug File entries."
S G=G+1,MSG(G)=""
S G=G+1,MSG(G)=""
S G=G+1,MSG(G)="The following drugs do not have any value in the DEA Special Handling Field."
S G=G+1,MSG(G)=""
S G=G+1,MSG(G)="----------------------------------------"
S G=G+1,MSG(G)="GENERIC NAME"
S G=G+1,MSG(G)="----------------------------------------"
;
; loop through the 2 area of the scratch global to display drugs with Blank DEA fields
S NILCNT=0
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
. S G=G+1,MSG(G)=DRUGNM
. S NILCNT=NILCNT+1
. Q
;
S G=G+1,MSG(G)=""
S G=G+1,MSG(G)="Total Drugs with Blank DEA Special Handling: "_NILCNT
S G=G+1,MSG(G)=""
S G=G+1,MSG(G)=""
;
; Now we need to address the message
; - send it to holders of the PSO EPHARMACY SITE MANAGER key
; - send it to the installer (DUZ)
; - send it to Gregory Laird in VA Outlook (production only)
; - send it to selected project team members (production only)
S USR=0 F S USR=$O(^XUSEC("PSO EPHARMACY SITE MANAGER",USR)) Q:'USR S XMTO(USR)=""
S XMTO(DUZ)=""
I $$PROD^XUPROD(1) D
. S XMTO("Gregory.Laird@domain.ext")=""
. S XMTO("Eric.Gustafson@domain.ext")=""
. S XMTO("lucille.harmon@domain.ext")=""
. Q
;
S XMINSTR("FROM")="PSS.1.192.POST"
;
D SENDMSG^XMXAPI(DUZ,SUBJ,"MSG",.XMTO,.XMINSTR)
I '$D(^TMP("XMERR",$J)) G EMAILX ; no email problems so get out
;
D MES^XPDUTL("MailMan reported a problem trying to send the PSS patch install/Drug File report message.")
D MES^XPDUTL(" ")
S (GLO,GLB)="^TMP(""XMERR"","_$J
S GLO=GLO_")"
F S GLO=$Q(@GLO) Q:GLO'[GLB D MES^XPDUTL(" "_GLO_" = "_$G(@GLO))
D MES^XPDUTL(" ")
;
EMAILX ;
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSS192PO 11457 printed Apr 09, 2024@21:36:51 Page 2
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
+2 ;
+3 DO BMES^XPDUTL("Starting post-install for PSS*1*192 ... ")
+4 DO DRUGS
+5 DO MES^XPDUTL("Finished with post-install for PSS*1*192.")
+6 QUIT
+7 ;
DRUGS ; loop through DRUG file and make changes
+1 ;
+2 ; Examine all drugs and build a scratch global:
+3 ; ^TMP(RTN,$J,1,DRUGNAME,DRUGIEN) = OLD DEA ^ NEW DEA ^ CHARACTERS REMOVED
+4 ; ^TMP(RTN,$J,2,DRUGNAME,DRUGIEN) = "" <--- For drugs with BLANK DEA fields
+5 ; ^TMP(RTN,$J,3,DRUGIEN)="" <--- For Billable Drugs
+6 ; ^TMP(RTN,$J,4,DRUGIEN)="" <--- For Non-Billable Drugs
+7 ; ^TMP(RTN,$J,5,DRUGIEN)="" <--- For Sensitive Diagnosis Drugs
+8 ;
+9 DO MES^XPDUTL(" Examining all Drugs in the Drug file (#50) ... ")
+10 ;
+11 NEW RTN,DRGIEN,DRUGNM,OLDDEA,NEWDEA,STOP,G,EPHBL
+12 SET RTN="PSS192PO"
+13 KILL ^TMP(RTN,$JOB)
+14 ;
+15 ; check the drug file data to see if this patch post-install has already been run
+16 SET STOP=0
+17 SET DRGIEN=0
FOR G=1:1:100
SET DRGIEN=$ORDER(^PSDRUG(DRGIEN))
if 'DRGIEN
QUIT
Begin DoDot:1
+18 SET EPHBL=$PIECE($GET(^PSDRUG(DRGIEN,"EPH")),U,4)
+19 ; already been run, get out
IF EPHBL'=""
SET STOP=1
QUIT
+20 QUIT
End DoDot:1
if STOP
QUIT
+21 IF STOP
DO MES^XPDUTL(" Patch post-install has already been run. No Changes Made.")
GOTO DRGX
+22 ;
+23 SET DRGIEN=0
FOR
SET DRGIEN=$ORDER(^PSDRUG(DRGIEN))
if 'DRGIEN
QUIT
Begin DoDot:1
+24 SET DRUGNM=$PIECE($GET(^PSDRUG(DRGIEN,0)),U,1)
if DRUGNM=""
SET DRUGNM="~missing drug name"
+25 SET OLDDEA=$$TRIM^XLFSTR($PIECE($GET(^PSDRUG(DRGIEN,0)),U,3))
+26 ;
+27 ; check for missing DEA, SPECIAL HDLG field
+28 IF OLDDEA=""
Begin DoDot:2
+29 ; save in scratch for later display
SET ^TMP(RTN,$JOB,2,DRUGNM,DRGIEN)=""
+30 ; save drug in non-billable list
SET ^TMP(RTN,$JOB,4,DRGIEN)=""
+31 QUIT
End DoDot:2
QUIT
+32 ;
+33 ; Do this block of code for billable/non-billable determination for each drug
+34 Begin DoDot:2
+35 ; Contains M or 0: Non-Billable
+36 IF OLDDEA["M"!(OLDDEA["0")
SET ^TMP(RTN,$JOB,4,DRGIEN)=""
QUIT
+37 ;
+38 ; Contains any of these and does not contain "E": Non-Billable
+39 IF (OLDDEA["I"!(OLDDEA["S")!(OLDDEA["9"))!(OLDDEA["N")
IF OLDDEA'["E"
SET ^TMP(RTN,$JOB,4,DRGIEN)=""
QUIT
+40 ;
+41 ; otherwise, drug is billable
+42 SET ^TMP(RTN,$JOB,3,DRGIEN)=""
+43 QUIT
End DoDot:2
+44 ;
+45 ; now work on removing the "E" and the "U" characters
+46 ; DEA indicates both billable and sensitive dx
IF OLDDEA["E"
IF OLDDEA["U"
DO DEA("EU")
+47 ; DEA indicates billable only
IF OLDDEA["E"
IF OLDDEA'["U"
DO DEA("E")
+48 ; DEA indicates sensitive dx only
IF OLDDEA'["E"
IF OLDDEA["U"
DO DEA("U")
+49 QUIT
End DoDot:1
+50 ;
+51 ; Now loop through the Scratch global areas and make changes to the database
+52 DO MES^XPDUTL(" Updating the values of the DEA, SPECIAL HDLG field ... ")
+53 SET DRUGNM=""
FOR
SET DRUGNM=$ORDER(^TMP(RTN,$JOB,1,DRUGNM))
if DRUGNM=""
QUIT
SET DRGIEN=0
FOR
SET DRGIEN=$ORDER(^TMP(RTN,$JOB,1,DRUGNM,DRGIEN))
if 'DRGIEN
QUIT
Begin DoDot:1
+54 NEW DIE,DA,DR
+55 SET NEWDEA=$PIECE($GET(^TMP(RTN,$JOB,1,DRUGNM,DRGIEN)),U,2)
if NEWDEA=""
SET NEWDEA="@"
+56 SET DIE=50
SET DA=DRGIEN
SET DR="3////"_NEWDEA
DO ^DIE
+57 QUIT
End DoDot:1
+58 ;
+59 DO MES^XPDUTL(" Updating the values of the ePharmacy Billable field ... ")
+60 ; Billable area
+61 SET DRGIEN=0
FOR
SET DRGIEN=$ORDER(^TMP(RTN,$JOB,3,DRGIEN))
if 'DRGIEN
QUIT
Begin DoDot:1
+62 NEW DIE,DA,DR
+63 ; billable
SET DIE=50
SET DA=DRGIEN
SET DR="84////1"
DO ^DIE
End DoDot:1
+64 ;
+65 ; Non-Billable area
+66 SET DRGIEN=0
FOR
SET DRGIEN=$ORDER(^TMP(RTN,$JOB,4,DRGIEN))
if 'DRGIEN
QUIT
Begin DoDot:1
+67 NEW DIE,DA,DR
+68 ; non-billable
SET DIE=50
SET DA=DRGIEN
SET DR="84////0"
DO ^DIE
+69 QUIT
End DoDot:1
+70 ;
+71 DO MES^XPDUTL(" Updating the values of the Sensitive Diagnosis Drug field ... ")
+72 SET DRGIEN=0
FOR
SET DRGIEN=$ORDER(^TMP(RTN,$JOB,5,DRGIEN))
if 'DRGIEN
QUIT
Begin DoDot:1
+73 NEW DIE,DA,DR
+74 ; sensitive diagnosis drug
SET DIE=50
SET DA=DRGIEN
SET DR="87////1"
DO ^DIE
+75 QUIT
End DoDot:1
+76 ;
+77 DO MES^XPDUTL(" Generating and sending the ePharmacy Drug File Changes report ... ")
+78 DO EMAIL
+79 ;
DRGX ;
+1 DO MES^XPDUTL(" Done with ePharmacy Drug File Changes.")
+2 KILL ^TMP(RTN,$JOB)
+3 QUIT
+4 ;
DEA(CHAR) ; remove characters from DEA and save new DEA and drug action to be taken
+1 ; remove characters from DEA value
SET NEWDEA=$TRANSLATE(OLDDEA,CHAR)
+2 ; save drug for DEA changes
SET ^TMP(RTN,$JOB,1,DRUGNM,DRGIEN)=OLDDEA_U_NEWDEA_U_CHAR
+3 ; add drug to sensitive dx list if "U"
IF CHAR["U"
SET ^TMP(RTN,$JOB,5,DRGIEN)=""
+4 ; if the new DEA field is now blank, save it for display
IF NEWDEA=""
SET ^TMP(RTN,$JOB,2,DRUGNM,DRGIEN)=""
+5 QUIT
+6 ;
EMAIL ; send email when patch is installed and this post-install message is run
+1 NEW SUBJ,MSG,XMTO,GLO,GLB,XMINSTR,NOTIF,SITE,G,DEACNT,DRUGNM,DRGIEN,NILCNT,USR
+2 SET SITE=$$SITE^VASITE
+3 SET SUBJ="ePharmacy Drug File Changes: PSS*1*192 #"_$PIECE(SITE,U,3)_" #"_$PIECE(SITE,U,2)
+4 SET SUBJ=$EXTRACT(SUBJ,1,65)
+5 SET G=0
+6 SET G=G+1
SET MSG(G)="VistA patch PSS*1*192 was successfully installed at your site."
+7 SET G=G+1
SET MSG(G)=""
+8 SET G=G+1
SET MSG(G)=" Name: "_$PIECE(SITE,U,2)
+9 SET G=G+1
SET MSG(G)=" Station#: "_$PIECE(SITE,U,3)
+10 SET G=G+1
SET MSG(G)=" Date/Time: "_$$FMTE^XLFDT($$NOW^XLFDT,"5ZPM")
+11 SET G=G+1
SET MSG(G)=" By: "_$PIECE($GET(^VA(200,DUZ,0)),U,1)
+12 SET G=G+1
SET MSG(G)=""
+13 SET G=G+1
SET MSG(G)="The following entries in your DRUG file (#50) have been modified to remove"
+14 SET G=G+1
SET MSG(G)="characters ""E"" Electronically Billable and ""U"" Sensitive Diagnosis from the"
+15 SET G=G+1
SET MSG(G)="DEA, Special Handling field. The functions of both characters have been"
+16 SET G=G+1
SET MSG(G)="replaced by the following new DRUG file (#50) fields to maintain consistency"
+17 SET G=G+1
SET MSG(G)="throughout the VA:"
+18 SET G=G+1
SET MSG(G)=""
+19 SET G=G+1
SET MSG(G)=" (Field #84) ePharmacy Billable:"
+20 SET G=G+1
SET MSG(G)=" (Field #85) ePharmacy Billable (TRICARE):"
+21 SET G=G+1
SET MSG(G)=" (Field #86) ePharmacy Billable (CHAMPVA):"
+22 SET G=G+1
SET MSG(G)=" (Field #87) Sensitive Diagnosis Drug:"
+23 SET G=G+1
SET MSG(G)=""
+24 SET G=G+1
SET MSG(G)="1. The ePharmacy Billable field and the Sensitive Diagnosis Drug field have"
+25 SET G=G+1
SET MSG(G)=" been answered YES or NO based on the data in the DEA, Special Handling"
+26 SET G=G+1
SET MSG(G)=" field."
+27 SET G=G+1
SET MSG(G)=""
+28 SET G=G+1
SET MSG(G)="2. Drug file entries without the E and U were also marked as ePharmacy"
+29 SET G=G+1
SET MSG(G)=" Billable Yes or No, depending on the existing DEA, Special Handling field"
+30 SET G=G+1
SET MSG(G)=" configuration at the time PSS*1*192 was loaded, using the following"
+31 SET G=G+1
SET MSG(G)=" criteria:"
+32 SET G=G+1
SET MSG(G)=""
+33 SET G=G+1
SET MSG(G)=" DEA, Special Handling"
+34 SET G=G+1
SET MSG(G)=" Field Criteria Billable"
+35 SET G=G+1
SET MSG(G)=" --------------------------------------------"
+36 SET G=G+1
SET MSG(G)=" Null N"
+37 SET G=G+1
SET MSG(G)=" Contains ""M"" or ""0"" (Zero) N"
+38 SET G=G+1
SET MSG(G)=" Contains ""I"" or ""S"" or ""N"" or ""9"""
+39 SET G=G+1
SET MSG(G)=" and DOES NOT contain ""E"" N"
+40 SET G=G+1
SET MSG(G)=" Contains ""I"" or ""S"" or ""N"" or ""9"""
+41 SET G=G+1
SET MSG(G)=" and DOES contain ""E"" Y"
+42 SET G=G+1
SET MSG(G)=" All Other Entries Y"
+43 SET G=G+1
SET MSG(G)=""
+44 SET G=G+1
SET MSG(G)="3. It is an exception to have a Null DEA, Special Handling field for a Drug"
+45 SET G=G+1
SET MSG(G)=" file item. If you have items on this list whose DEA, Special Handling"
+46 SET G=G+1
SET MSG(G)=" field was null, it is suggested that you populate the DEA, Special Handling"
+47 SET G=G+1
SET MSG(G)=" field and mark those items as billable, if appropriate."
+48 SET G=G+1
SET MSG(G)=""
+49 SET G=G+1
SET MSG(G)=" Here is a Legend for the existing DEA, Special Handling field values:"
+50 SET G=G+1
SET MSG(G)=" 0 MANUFACTURED IN PHARMACY"
+51 SET G=G+1
SET MSG(G)=" 1 SCHEDULE 1 ITEM"
+52 SET G=G+1
SET MSG(G)=" 2 SCHEDULE 2 ITEM"
+53 SET G=G+1
SET MSG(G)=" 3 SCHEDULE 3 ITEM"
+54 SET G=G+1
SET MSG(G)=" 4 SCHEDULE 4 ITEM"
+55 SET G=G+1
SET MSG(G)=" 5 SCHEDULE 5 ITEM"
+56 SET G=G+1
SET MSG(G)=" 6 LEGEND ITEM"
+57 SET G=G+1
SET MSG(G)=" 9 OVER-THE-COUNTER"
+58 SET G=G+1
SET MSG(G)=" L DEPRESSANTS AND STIMULANTS"
+59 SET G=G+1
SET MSG(G)=" A NARCOTICS AND ALCOHOLS"
+60 SET G=G+1
SET MSG(G)=" P DATED DRUGS"
+61 SET G=G+1
SET MSG(G)=" I INVESTIGATIONAL DRUGS"
+62 SET G=G+1
SET MSG(G)=" M BULK COMPOUND ITEMS"
+63 SET G=G+1
SET MSG(G)=" C CONTROLLED SUBSTANCES - NON NARCOTIC"
+64 SET G=G+1
SET MSG(G)=" R RESTRICTED ITEMS"
+65 SET G=G+1
SET MSG(G)=" S SUPPLY ITEMS"
+66 SET G=G+1
SET MSG(G)=" B ALLOW REFILL (SCH. 3, 4, 5 ONLY)"
+67 SET G=G+1
SET MSG(G)=" W NOT RENEWABLE"
+68 SET G=G+1
SET MSG(G)=" F NON REFILLABLE"
+69 SET G=G+1
SET MSG(G)=" N NUTRITIONAL SUPPLEMENT"
+70 SET G=G+1
SET MSG(G)=""
+71 SET G=G+1
SET MSG(G)=""
+72 SET G=G+1
SET MSG(G)="-------------------------------------------------------------------------------"
+73 SET G=G+1
SET MSG(G)=" DEA Special Handling Field"
+74 SET G=G+1
SET MSG(G)="GENERIC NAME OLD NEW REMOVED"
+75 SET G=G+1
SET MSG(G)="-------------------------------------------------------------------------------"
+76 ;
+77 ; loop through the 1 area of the scratch global and populate the message with the DEA changes
+78 SET DEACNT=0
+79 SET DRUGNM=""
FOR
SET DRUGNM=$ORDER(^TMP(RTN,$JOB,1,DRUGNM))
if DRUGNM=""
QUIT
SET DRGIEN=0
FOR
SET DRGIEN=$ORDER(^TMP(RTN,$JOB,1,DRUGNM,DRGIEN))
if 'DRGIEN
QUIT
Begin DoDot:1
+80 NEW AB
+81 SET AB=$GET(^TMP(RTN,$JOB,1,DRUGNM,DRGIEN))
+82 IF $PIECE(AB,U,2)=""
SET $PIECE(AB,U,2)="-"
+83 SET G=G+1
SET MSG(G)=$$LJ^XLFSTR(DRUGNM,44)_$$LJ^XLFSTR($PIECE(AB,U,1),11)_$$LJ^XLFSTR($PIECE(AB,U,2),11)_$PIECE(AB,U,3)
+84 SET DEACNT=DEACNT+1
+85 QUIT
End DoDot:1
+86 ;
+87 SET G=G+1
SET MSG(G)=""
+88 SET G=G+1
SET MSG(G)="Total Drugs Modified: "_DEACNT
+89 SET G=G+1
SET MSG(G)=""
+90 SET G=G+1
SET MSG(G)="No other changes were made to the DEA, Special Handling field for any other"
+91 SET G=G+1
SET MSG(G)="Drug File entries."
+92 SET G=G+1
SET MSG(G)=""
+93 SET G=G+1
SET MSG(G)=""
+94 SET G=G+1
SET MSG(G)="The following drugs do not have any value in the DEA Special Handling Field."
+95 SET G=G+1
SET MSG(G)=""
+96 SET G=G+1
SET MSG(G)="----------------------------------------"
+97 SET G=G+1
SET MSG(G)="GENERIC NAME"
+98 SET G=G+1
SET MSG(G)="----------------------------------------"
+99 ;
+100 ; loop through the 2 area of the scratch global to display drugs with Blank DEA fields
+101 SET NILCNT=0
+102 SET DRUGNM=""
FOR
SET DRUGNM=$ORDER(^TMP(RTN,$JOB,2,DRUGNM))
if DRUGNM=""
QUIT
SET DRGIEN=0
FOR
SET DRGIEN=$ORDER(^TMP(RTN,$JOB,2,DRUGNM,DRGIEN))
if 'DRGIEN
QUIT
Begin DoDot:1
+103 SET G=G+1
SET MSG(G)=DRUGNM
+104 SET NILCNT=NILCNT+1
+105 QUIT
End DoDot:1
+106 ;
+107 SET G=G+1
SET MSG(G)=""
+108 SET G=G+1
SET MSG(G)="Total Drugs with Blank DEA Special Handling: "_NILCNT
+109 SET G=G+1
SET MSG(G)=""
+110 SET G=G+1
SET MSG(G)=""
+111 ;
+112 ; Now we need to address the message
+113 ; - send it to holders of the PSO EPHARMACY SITE MANAGER key
+114 ; - send it to the installer (DUZ)
+115 ; - send it to Gregory Laird in VA Outlook (production only)
+116 ; - send it to selected project team members (production only)
+117 SET USR=0
FOR
SET USR=$ORDER(^XUSEC("PSO EPHARMACY SITE MANAGER",USR))
if 'USR
QUIT
SET XMTO(USR)=""
+118 SET XMTO(DUZ)=""
+119 IF $$PROD^XUPROD(1)
Begin DoDot:1
+120 SET XMTO("Gregory.Laird@domain.ext")=""
+121 SET XMTO("Eric.Gustafson@domain.ext")=""
+122 SET XMTO("lucille.harmon@domain.ext")=""
+123 QUIT
End DoDot:1
+124 ;
+125 SET XMINSTR("FROM")="PSS.1.192.POST"
+126 ;
+127 DO SENDMSG^XMXAPI(DUZ,SUBJ,"MSG",.XMTO,.XMINSTR)
+128 ; no email problems so get out
IF '$DATA(^TMP("XMERR",$JOB))
GOTO EMAILX
+129 ;
+130 DO MES^XPDUTL("MailMan reported a problem trying to send the PSS patch install/Drug File report message.")
+131 DO MES^XPDUTL(" ")
+132 SET (GLO,GLB)="^TMP(""XMERR"","_$JOB
+133 SET GLO=GLO_")"
+134 FOR
SET GLO=$QUERY(@GLO)
if GLO'[GLB
QUIT
DO MES^XPDUTL(" "_GLO_" = "_$GET(@GLO))
+135 DO MES^XPDUTL(" ")
+136 ;
EMAILX ;
+1 QUIT
+2 ;
