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

PSO746PI.m

Go to the documentation of this file. 
  1. PSO746PI ;BHAM/MFR - PSO*7*746 POST INSTALL; 10/01/2022 11:24Am
  1.  ;;7.0;OUTPATIENT PHARMACY;**746**;DEC 1997;Build 106
  1.  ;
  1.  ;Reference to $$CRDD^TIUCRDD in ICR #7179
  1.  ;
  1. EN ; Entry Point
  1.  N HOPIEN,RRPIEN,DONE,IEN,CHHOPIEN,XCODE,DIC,X
  1.  D BMES^XPDUTL("Starting post-install for PSO*7*746 at "_$$FMTE^XLFDT($$NOW^XLFDT()))
  1.  ;
  1.  ; New Hold codes
  1.  I '$D(^PS(52.45,"B","HFF")) D
  1.  . S X="HFF",DIC="^PS(52.45,",DIC(0)="",DIC("DR")=".02///HOLD FOR FUTURE FILL;.03///ERX"
  1.  . D FILE^DICN
  1.  ;
  1.  ; Adding template Change Reason Texts to file #52.45
  1.  S CODE="" F  S CODE=$O(^PS(52.45,"TYPE","REA",CODE)) Q:'CODE  D
  1.  . K TEXT,REATXT S XCODE=$$GET1^DIQ(52.45,CODE,.01)
  1.  . I ",DA,DD,HD,LD,MS,TD,AR,DI,DR,ID,UD,PS,SX,TP,"'[(","_XCODE_",") Q
  1.  . K ^PS(52.45,CODE,20)
  1.  . I XCODE="DA" D
  1.  . . S TEXT(1,0)="Pt has a listed allergy to medication/component of medication prescribed"
  1.  . . S TEXT(2,0)="[DRUG_NAME]. Please advise: To fill as is, send denial to this request with"
  1.  . . S TEXT(3,0)="note stating reason fill is acceptable. If med should not be filled, Cancel Rx"
  1.  . . S TEXT(4,0)="and send replacement."
  1.  . I XCODE="DD" D
  1.  . . S TEXT(1,0)="eRx drug interacts with [DRUG_NAME]. Please advise: To fill this medication,"
  1.  . . S TEXT(2,0)="send denial with note stating pt requires both medications or note that"
  1.  . . S TEXT(3,0)="[DRUG_NAME] should be canceled. If med should not be filled, Cancel RX and send"
  1.  . . S TEXT(4,0)="replacement."
  1.  . I XCODE="HD" D
  1.  . . S TEXT(1,0)="The prescribed dosage exceeds typical maximum. Please advise: To fill as is,"
  1.  . . S TEXT(2,0)="send denial to this request with note stating reason fill is acceptable. To"
  1.  . . S TEXT(3,0)="fill within manufacturer guidelines, approve recommendation below."
  1.  . I XCODE="LD" D
  1.  . . S TEXT(1,0)="The prescribed dosage is below typical minimum. Please advise: To fill as is,"
  1.  . . S TEXT(2,0)="send denial to this request with note stating reason fill is acceptable. To fill"
  1.  . . S TEXT(3,0)="within manufacturer guidelines, approve recommendation below."
  1.  . I XCODE="MS" D
  1.  . . S TEXT(1,0)="The eRx is missing or unclear on [ADD_TEXT_HERE], Please edit and respond or"
  1.  . . S TEXT(2,0)="cancel Rx and send a new prescription with the requested information."
  1.  . I XCODE="TD" D
  1.  . . S TEXT(1,0)="Pt has medication of the same class/indication/drug on file. To fill this Rx,"
  1.  . . S TEXT(2,0)="send denial with note stating pt requires both medications or note that"
  1.  . . S TEXT(3,0)="[DRUG_NAME] should be canceled. If this med should not be filled, Cancel RX and"
  1.  . . S TEXT(4,0)="send a replacement."
  1.  . I XCODE="AR" D
  1.  . . S TEXT(1,0)="Patient has an adverse drug reaction to medication/component of medication"
  1.  . . S TEXT(2,0)="prescribed. To fill as is, send denial to this request with note stating reason"
  1.  . . S TEXT(3,0)="fill is acceptable. If med should not be filled- Cancel RX and send a"
  1.  . . S TEXT(4,0)="replacement."
  1.  . I XCODE="DI" D
  1.  . . S TEXT(1,0)="eRx drug is incompatible with [DRUG_NAME]. To fill this Rx, send denial with"
  1.  . . S TEXT(2,0)="note stating pt requires both medications or note that [DRUG_NAME] should be"
  1.  . . S TEXT(3,0)="canceled. If med should not be filled, Cancel RX and send a replacement."
  1.  . I XCODE="DR" D
  1.  . . S TEXT(1,0)="The prescribed dosage does not align with manufacturer recommendations. Please"
  1.  . . S TEXT(2,0)="advise: To fill as is, send denial to this request with note stating reason fill"
  1.  . . S TEXT(3,0)="is acceptable. To fill within manufacturer guidelines, approve recommendation"
  1.  . . S TEXT(4,0)="below."
  1.  . I XCODE="ID" D
  1.  . . S TEXT(1,0)="Pt has medication containing the same ingredient on file. To fill this Rx, send"
  1.  . . S TEXT(2,0)="denial with note stating pt requires both medications or note that [DRUG_NAME]"
  1.  . . S TEXT(3,0)="should be canceled. If med should not be filled-Cancel RX and send a"
  1.  . . S TEXT(4,0)="replacement."
  1.  . I XCODE="UD" D
  1.  . . S TEXT(1,0)="Pt has multiple prescriptions for the same drug and strength on file. To fulfill"
  1.  . . S TEXT(2,0)="both Rx, send one Rx containing total qty/directions etc. To fill only this Rx,"
  1.  . . S TEXT(3,0)="send denial with note stating other should be canceled. If med should not be"
  1.  . . S TEXT(4,0)="filled, Cancel Rx."
  1.  . I XCODE="PS" D
  1.  . . S TEXT(1,0)="Pharmacy is unable to supply medication as prescribed; however, alternative"
  1.  . . S TEXT(2,0)="options may exist. Please approve an option below or Cancel Rx and send a"
  1.  . . S TEXT(3,0)="replacement."
  1.  . I XCODE="SX" D
  1.  . . S TEXT(1,0)="The prescribed medication does not align with manufacturer recommendations based"
  1.  . . S TEXT(2,0)="on patient sex assigned at birth. The pharmacy is unable to fill the medication"
  1.  . . S TEXT(3,0)="as prescribed. Pt may obtain locally at usual cash price."
  1.  . I XCODE="TP" D
  1.  . . S TEXT(1,0)="Prior to processing this medication/class the pharmacy is required to obtain a"
  1.  . . S TEXT(2,0)="diagnosis code. Please edit and respond or Cancel Rx and send a new prescription"
  1.  . . S TEXT(3,0)="with the requested information."
  1.  . S REATXT(52.45,CODE_",",20)="TEXT"
  1.  . K DIERR D UPDATE^DIE("","REATXT")
  1.  ;
  1.  S CODE=$O(^PS(52.45,"D","Script Clarification",0))
  1.  I CODE D
  1.  . K ^PS(52.45,CODE,20)
  1.  . K TEXT,REATXT
  1.  . S TEXT(1,0)="The eRx is missing or unclear on [ADD_TEXT_HERE], Please edit and respond or"
  1.  . S TEXT(2,0)="cancel Rx and send a new prescription with the requested information."
  1.  . S REATXT(52.45,CODE_",",20)="TEXT"
  1.  . K DIERR D UPDATE^DIE("","REATXT")
  1.  ; 
  1.  S CODE=$O(^PS(52.45,"D","Therapeutic Interchange/Substi",0))
  1.  I CODE D
  1.  . K ^PS(52.45,CODE,20)
  1.  . K TEXT,REATXT
  1.  . S TEXT(1,0)="Pharmacy is unable to supply medication as prescribed; however, alternative"
  1.  . S TEXT(2,0)="options may exist. Please approve an option below or Cancel Rx and send a"
  1.  . S TEXT(3,0)="replacement."
  1.  . S REATXT(52.45,CODE_",",20)="TEXT"
  1.  . K DIERR D UPDATE^DIE("","REATXT")
  1.  ;
  1.  S CODE=$O(^PS(52.45,"D","Generic Substitution",0))
  1.  I CODE D
  1.  . K ^PS(52.45,CODE,20)
  1.  . K TEXT,REATXT
  1.  . S TEXT(1,0)="Rx received was marked Dispense as Written however Brand Name product is not"
  1.  . S TEXT(2,0)="available to be dispensed. Please approve generic substitution option below or"
  1.  . S TEXT(3,0)="send replacement Rx."
  1.  . S REATXT(52.45,CODE_",",20)="TEXT"
  1.  . K DIERR D UPDATE^DIE("","REATXT")
  1.  ;
  1.  S CODE=$O(^PS(52.45,"D","Prescribed with acknowledgemen",0))
  1.  I CODE D
  1.  . N DIE S DIE="^PS(52.45,",DA=CODE,DR=".02///Prescribed w/ acknowledgements" D ^DIE
  1.  ;
  1.  S CODE=$O(^PS(52.45,"D","Out of Stock",0))
  1.  I CODE D
  1.  . K ^PS(52.45,CODE,20)
  1.  . K TEXT,REATXT
  1.  . S TEXT(1,0)="The medication prescribed is currently out of stock, if a substitutable product"
  1.  . S TEXT(2,0)="exists and is presented as an option below, it may be approved. Otherwise, pt"
  1.  . S TEXT(3,0)="may need to obtain locally or have replacement product prescribed."
  1.  . S REATXT(52.45,CODE_",",20)="TEXT"
  1.  . K DIERR D UPDATE^DIE("","REATXT")
  1.  ;
  1.  D CREATEPN("PHARMACY SERVICE","PHARMACY PROGRESS NOTE","ERX RX CHANGE REQUEST NOTE") ;create new eRx Progress Notes Title in File #8925.1
  1.  ;
  1.  ; Killing and Re-Building "ADRGVRX" x-reference
  1.  I $$GET1^DIQ(59.7,1,102,"I")'="MBM" D
  1.  . D BMES^XPDUTL("Re-building Drug Suggestion x-reference... "_$$FMTE^XLFDT($$NOW^XLFDT()))
  1.  . K ^PS(52.49,"ADRGVRX") S DIK="^PS(52.49,",DIK(1)=".13^ADRGVRX" D ENALL^DIK
  1.  ;
  1.  ; Updating Protocol Headers to display eRx Meds on File in Backdoor Pharmacy
  1.  N ORDIEN
  1.  S ORDIEN=$O(^ORD(101,"B","PSO LM PAT INFO MENU",0))
  1.  I ORDIEN S ^ORD(101,ORDIEN,26)="D SHOW^VALM,NVAERX^PSOORUT2"
  1.  S ORDIEN=$O(^ORD(101,"B","PSO LM MEDICATION PROFILE",0))
  1.  I ORDIEN S ^ORD(101,ORDIEN,26)="D A^PSOORUT3,SHOW^VALM S XQORM(""#"")=$O(^ORD(101,""B"",""PSO LM NEW SELECT ORDER"",0))_""^1:""_$S($G(PSORCNT):PSORCNT,1:PSOCNT) D NVAERX^PSOORUT2"
  1.  ;
  1.  D BMES^XPDUTL("Post-install for PSO*7*746 completed successfully at "_$$FMTE^XLFDT($$NOW^XLFDT()))
  1.  Q
  1.  ;
  1. CREATEPN(PARNTDOC,STDTITLE,TITLE) ;
  1.  ;Input: PARNTDOC - Name of the desired parent in File #8925.1
  1.  ;       STDTITLE - Name of the VHA Enterprise Standard Title in File #8926.1
  1.  ;       TITLE    - Name of the desired title in File #8925.1
  1.  ;Output: Create a new entry TIU NOTE Title in File #8925.1
  1.  ;
  1.  N FOUNDDOC,FOUNDSTD,MES,RESULT
  1.  ;check parent document class PHARMACY SERVICE
  1.  S FOUNDDOC=$$FIND1^DIC(8925.1,"","X",PARNTDOC,"B")
  1.  ;
  1.  ; check VHA Enterprise Standard Title PHARMACY PROGRESS NOTE
  1.  S FOUNDSTD=$$FIND1^DIC(8926.1,"","X",STDTITLE,"B")
  1.  ;
  1.  S MES(1)=""
  1.  ;if PHARMACY SERVICE and PHARMACY PROGRESS NOTE exist, attach and map the new ERX RX CHANGE REQUEST NOTE TIU Note Title
  1.  I +FOUNDDOC,+FOUNDSTD D  Q
  1.  . S RESULT=$$CRDD^TIUCRDD(TITLE,"DOC","ACTIVE",PARNTDOC,STDTITLE)
  1.  . I '+RESULT D  Q
  1.  . . S MES(2)=$S(RESULT["already exists":$P(RESULT,U,2)_" No action taken.",1:"Installation Error: "_$P(RESULT,U,2))
  1.  . . S MES(3)=""
  1.  . . D MES^XPDUTL(.MES)
  1.  . S MES(2)="Successfully created "_TITLE_" in File #8925.1."
  1.  . S MES(3)=""
  1.  . D MES^XPDUTL(.MES)
  1.  ;
  1.  ;Otherwise, do not attach and map the new ERX RX REQUEST NOTE TIU Note Title
  1.  S MES(2)="Installation Error:"
  1.  S MES(3)="    The creation of the ERX RX CHANGE REQUEST NOTE TIU Title failed."
  1.  ;
  1.  I '+FOUNDDOC,'+FOUNDSTD D  ;both parent doc class and std title does not exist at the site
  1.  . S MES(4)="       * "_PARNTDOC_" Document Class not found."
  1.  . S MES(5)="       * VHA Enterprise Standard Title "_STDTITLE_" not found."
  1.  . S MES(6)=""
  1.  ;
  1.  I '+FOUNDDOC,+FOUNDSTD D  ;std title exist but parent doc class does not exist at the site
  1.  . S MES(4)="       * "_PARNTDOC_" Document Class not found."
  1.  . S MES(5)=""
  1.  ;
  1.  I +FOUNDDOC,'+FOUNDSTD D  ;parent doc exist but std title does not exist at the site
  1.  . S MES(4)="       * VHA Enterprise Standard Title "_STDTITLE_" not found."
  1.  . S MES(5)=""
  1.  ;
  1.  D MES^XPDUTL(.MES)
  1.  Q