PSO617PI ;ALB/ASF - eRx 617 POST INSTALL; 10/01/2020 11:24Am
;;7.0;OUTPATIENT PHARMACY;**617**;DEC 1997;Build 110
;
EN ;add/replace eRX reason codes - File 52.45
N CKIEN,BRIEF,DA,DIE,DIC,DR,PSDUP,TYPE,X,Y
D BMES^XPDUTL("Starting post-install for PSO*7*617")
S DIC="^PS(52.45,",DIC(0)=""
;Hold codes
S X="HCR",BRIEF="PRESCRIBER'S CS CREDENTIAL IS NOT APPROPRIATE",TYPE="ERX" D ADD
S X="HWR",BRIEF="CS PRESCRIPTION WRITTEN/ISSUE DATE HAS PROBLEMS",TYPE="ERX" D ADD
S X="HIS",BRIEF="PROVIDER DEA# ISSUE",TYPE="ERX" D ADD
S X="HRX",BRIEF="HOLD FOR RX EDIT",TYPE="ERX" D ADD
S X="HDE",BRIEF="DRUG USE EVALUATION",TYPE="ERX" D ADD
S X="HTI",BRIEF="THERAPUTIC INTERCHANGE",TYPE="ERX" D ADD
S X="HSC",BRIEF="SCRIPT CLARIFICATION",TYPE="ERX" D ADD
S X="HGS",BRIEF="GENERIC SUBSTITUTION",TYPE="ERX" D ADD
; Remove codes
S X="REM09",BRIEF="ERX Issue not resolved-Provider contacted",TYPE="REM" D ADD
;Reject codes
S X="PVD03",BRIEF="Missing/bad digital signature on inbound CS ERX",TYPE="REJ" D ADD
S X="PVD04",BRIEF="Prescriber's CS credential is not appropriate",TYPE="REJ" D ADD
S X="PTT03",BRIEF="Patient's mailing address is missing/mismatched",TYPE="REJ" D ADD
S X="ERR99",BRIEF="Other",TYPE="REJ" D ADD
; Repurpose DRU06
S X="DRU06" D ^DIC I +Y>0 S DA=+Y,DIE=DIC,DR=".02///CS prescription written/issue date has problems" D ^DIE
;
D BMES^XPDUTL("Post-install for PSO*7*617 completed successfully")
Q
CK(X) ;Check if already entered
S PSDUP=0
I $D(^PS(52.45,"B",X)) S PSDUP=1
Q PSDUP
ADD ;add entry
S PSDUP=$$CK(X) Q:PSDUP
S DIC("DR")=".02///"_BRIEF_";.03///"_TYPE
D FILE^DICN
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSO617PI 1644 printed Nov 22, 2024@17:33:24 Page 2
PSO617PI ;ALB/ASF - eRx 617 POST INSTALL; 10/01/2020 11:24Am
+1 ;;7.0;OUTPATIENT PHARMACY;**617**;DEC 1997;Build 110
+2 ;
EN ;add/replace eRX reason codes - File 52.45
+1 NEW CKIEN,BRIEF,DA,DIE,DIC,DR,PSDUP,TYPE,X,Y
+2 DO BMES^XPDUTL("Starting post-install for PSO*7*617")
+3 SET DIC="^PS(52.45,"
SET DIC(0)=""
+4 ;Hold codes
+5 SET X="HCR"
SET BRIEF="PRESCRIBER'S CS CREDENTIAL IS NOT APPROPRIATE"
SET TYPE="ERX"
DO ADD
+6 SET X="HWR"
SET BRIEF="CS PRESCRIPTION WRITTEN/ISSUE DATE HAS PROBLEMS"
SET TYPE="ERX"
DO ADD
+7 SET X="HIS"
SET BRIEF="PROVIDER DEA# ISSUE"
SET TYPE="ERX"
DO ADD
+8 SET X="HRX"
SET BRIEF="HOLD FOR RX EDIT"
SET TYPE="ERX"
DO ADD
+9 SET X="HDE"
SET BRIEF="DRUG USE EVALUATION"
SET TYPE="ERX"
DO ADD
+10 SET X="HTI"
SET BRIEF="THERAPUTIC INTERCHANGE"
SET TYPE="ERX"
DO ADD
+11 SET X="HSC"
SET BRIEF="SCRIPT CLARIFICATION"
SET TYPE="ERX"
DO ADD
+12 SET X="HGS"
SET BRIEF="GENERIC SUBSTITUTION"
SET TYPE="ERX"
DO ADD
+13 ; Remove codes
+14 SET X="REM09"
SET BRIEF="ERX Issue not resolved-Provider contacted"
SET TYPE="REM"
DO ADD
+15 ;Reject codes
+16 SET X="PVD03"
SET BRIEF="Missing/bad digital signature on inbound CS ERX"
SET TYPE="REJ"
DO ADD
+17 SET X="PVD04"
SET BRIEF="Prescriber's CS credential is not appropriate"
SET TYPE="REJ"
DO ADD
+18 SET X="PTT03"
SET BRIEF="Patient's mailing address is missing/mismatched"
SET TYPE="REJ"
DO ADD
+19 SET X="ERR99"
SET BRIEF="Other"
SET TYPE="REJ"
DO ADD
+20 ; Repurpose DRU06
+21 SET X="DRU06"
DO ^DIC
IF +Y>0
SET DA=+Y
SET DIE=DIC
SET DR=".02///CS prescription written/issue date has problems"
DO ^DIE
+22 ;
+23 DO BMES^XPDUTL("Post-install for PSO*7*617 completed successfully")
+24 QUIT
CK(X) ;Check if already entered
+1 SET PSDUP=0
+2 IF $DATA(^PS(52.45,"B",X))
SET PSDUP=1
+3 QUIT PSDUP
ADD ;add entry
+1 SET PSDUP=$$CK(X)
if PSDUP
QUIT
+2 SET DIC("DR")=".02///"_BRIEF_";.03///"_TYPE
+3 DO FILE^DICN
+4 QUIT
