PSOERX1B ;ALB/BWF - Accept eRx function ; 8/3/2016 5:14pm
;;7.0;OUTPATIENT PHARMACY;**467,506,520,527,508,551,591,606,581,617,700,770**;DEC 1997;Build 145
;
Q
ACVAL(PSOIEN,TYPE,VAMMODE) ; NEW MTYPE, GET IT OFF FIELD .08, IF NOT DEFINED,
;Input: PSOIEN - eRx IEN (Pointer to #52.49)
; TYPE - Validation Type (P: Patient, PR: Provider, D: Drug)
; VAMMODE - Validate All Matches Mode (optional)
N MBMSITE,F,VBFLD,VBDTTMF,DIR,TAG,VALPAR,VAL,CURVAL,MVFLD,VBFLD,VBDTTMF,PSOIENS,RXSTAT,QFLG,VDTTM,ERXMMFLG,MTYPE,Y
N RESTYPE,GMRA,GMRAL,ERXPTIEN,DFN
S MBMSITE=$S($$GET1^DIQ(59.7,1,102,"I")="MBM":1,1:0)
S F=52.49,PSOIENS=PSOIEN_","
D FULL^VALM1
S VALMBCK="R"
; first check to see if the entry exists. cannot validate something that has no value
S MTYPE=$$GET1^DIQ(52.49,PSOIEN,.08,"I") ;mtype
S RXSTAT=$$GET1^DIQ(52.49,PSOIEN,1,"E") I RXSTAT="RJ"!(RXSTAT="RM")!($E(RXSTAT,1,3)="REM")!(RXSTAT="PR")!(RXSTAT="CRP")!(RXSTAT="CXP")!(RXSTAT="RRP") D Q
. W !!,"Cannot accept validation for a prescription with a status of 'Rejected',",!,"'Removed',or 'Processed",!
. S DIR(0)="E" D ^DIR
Q:TYPE']""
S TAG=$S(TYPE="P":"patient",TYPE="PR":"provider",TYPE="D":"drug",1:"")
S VALPAR=$S(TYPE="P":.05,TYPE="PR":2.3,TYPE="D":3.2,1:"") Q:VALPAR=""
S VAL=$$GET1^DIQ(F,PSOIEN,VALPAR,"I") I 'VAL D Q
. W !,"Vista "_TAG_" has not been matched. Cannot manually validate."
. S DIR(0)="E" D ^DIR
S MVFLD=$S(TYPE="P":1.7,TYPE="PR":1.3,TYPE="D":1.5,1:"")
S VBFLD=$S(TYPE="P":1.13,TYPE="PR":1.8,TYPE="D":1.11,1:"")
S VBDTTMF=$S(TYPE="P":1.14,TYPE="PR":1.9,TYPE="D":1.12,1:"")
; check if Patient has a valid adress - CS prescriptions only
I TYPE="P",$$GET1^DIQ(52.49,PSOIEN,95.1,"I"),'$$VALPTADD^PSOERXUT(+$G(VAL)) D Q
. W !!,"Unable to validate - VistA Patient does not have a current mailing"
. W !,"or residential address on file.",$C(7),!
. S DIR(0)="E" D ^DIR
; check to see if this is already validated
I MVFLD S CURVAL=$$GET1^DIQ(F,PSOIEN,MVFLD,"I")
I CURVAL D Q
. W !!,"This "_TAG_" has already been "_$S(TYPE="PR"&$$GET1^DIQ(52.49,PSOIEN,2.7,"I"):"automatically",1:"manually")_" validated."
. W !,"Validated By: "_$$GET1^DIQ(F,PSOIEN,VBFLD,"E")
. W !,"Validated Date/Time: "_$$GET1^DIQ(F,PSOIEN,VBDTTMF,"E"),!
. S DIR(0)="E" D ^DIR
S QFLG=0
I TYPE="D" D
. W !
. I '$O(^PS(52.49,PSOIEN,21,0)) W !,"Dosing information missing.",$C(7) S QFLG=1
. I $$GET1^DIQ(52.49,PSOIEN,20.1,"E")="" W !,"Quantity missing.",$C(7) S QFLG=1
. I $$GET1^DIQ(52.49,PSOIEN,20.2,"E")="" W !,"Days supply missing.",$C(7) S QFLG=1
I $G(QFLG) W ! S DIR(0)="E" D ^DIR K DIR Q
I TYPE="D" D
. N ERXMSG,I
. D PRDRVAL^PSOERXUT(.ERXMSG,"VD",PSOIEN) I $P(ERXMSG,"^",2)="B" S QFLG=1
. I $O(ERXMSG(0)) D
. . W !!,"*********************************",$S($P(ERXMSG,"^",2)="W":" WARNING(S) ",1:"INVALID DRUG"),"***********************************"
. . S I=0 F S I=$O(ERXMSG(I)) Q:'I W !,$P(ERXMSG(I),"^")
. . W !,"********************************************************************************",$C(7)
I $G(QFLG) W ! S DIR(0)="E" D ^DIR K DIR Q
;
I TYPE="P" D I '$G(ERXMMFLG) S DIR(0)="E" D ^DIR K DIR
. S ERXMMFLG=$$PATWARN^PSOERX1E("VP",PSOIEN)
;
S DFN=$$GET1^DIQ(52.49,PSOIEN,.05,"I")
; VistA Patient ChampVA Eligibility Check (MbM Only)
I $G(MBMSITE),TYPE="P",'$$CHVAELIG^PSOERXU9(DFN) D Q
. I ",N,I,W,RXI,RXN,RXW,RXR,CXI,CXN,CXW,"[(","_$G(RXSTAT)_",") D
. . D UPDSTAT^PSOERXU1(PSOIEN,"HEL","Hold due to Eligibility Issue")
. . W !!,"This eRx has been put on Hold (HEL) because the VistA Patient ("_$$GET1^DIQ(2,DFN,.01)_") is not Eligible for ChampVA Rx Benefit."
. . K DIR D PAUSE^VALM1
. D AUTOHOLD^PSOERX1E("E",PSOIEN,DFN)
;
; VistA Patient Allergy Check (MbM Only)
I $G(MBMSITE),TYPE="P" D I $G(GMRAL)="" Q
. S GMRA="0^0^111" D EN1^GMRADPT I $G(GMRAL)'="" Q
. I ",N,I,W,RXI,RXN,RXW,RXR,CXI,CXN,CXW,"[(","_$G(RXSTAT)_",") D
. . D UPDSTAT^PSOERXU1(PSOIEN,"HAL","Hold for Allergy Assessment")
. . W !!,"This eRx has been put on Hold (HAL) because the VistA Patient ("_$$GET1^DIQ(2,DFN,.01)_") does not have an Allergy Assessment.."
. . K DIR D PAUSE^VALM1
. D AUTOHOLD^PSOERX1E("A",PSOIEN,DFN)
;
I TYPE="P",'$G(ERXMMFLG) Q
;
I TYPE="PR" S ERXMMFLG=$$PRVWARN^PSOERX1A("VP",PSOIEN) I 'ERXMMFLG S DIR(0)="E" D ^DIR K DIR Q
I '$G(VAMMODE) W !,"Would you like to mark this "_TAG_" as VALIDATED?" S DIR(0)="Y",DIR("B")=$S($G(ERXMMFLG):"NO",1:"YES") D ^DIR Q:Y'=1
K FDA,DIR
S VDTTM=$$NOW^XLFDT I MVFLD S FDA(F,PSOIENS,MVFLD)=1
I VBFLD S FDA(F,PSOIENS,VBFLD)=$G(DUZ)
I VBDTTMF S FDA(F,PSOIENS,VBDTTMF)=VDTTM
I $D(FDA) D FILE^DIE(,"FDA") K FDA
W !,$S(TYPE="P":"Patient",TYPE="PR":"Provider",1:"Drug/SIG")_" Match Validated!!"
; check validations and update status to 'wait' if all validations have occured.
I MTYPE="N",$E(RXSTAT)'="H" D
. I $$GET1^DIQ(52.49,PSOIEN,1.3,"I"),$$GET1^DIQ(52.49,PSOIEN,1.5,"I"),$$GET1^DIQ(52.49,PSOIEN,1.7,"I") D UPDSTAT^PSOERXU1(PSOIEN,"W") Q
. D UPDSTAT^PSOERXU1(PSOIEN,"I")
I MTYPE="RE",$E(RXSTAT)'="H" D
. S RESTYPE=$$GET1^DIQ(52.49,PSOIEN,52.1,"I")
. I RESTYPE'="R" D UPDSTAT^PSOERXU1(PSOIEN,"RXW") Q
. I $$GET1^DIQ(52.49,PSOIEN,1.3,"I"),$$GET1^DIQ(52.49,PSOIEN,1.5,"I"),$$GET1^DIQ(52.49,PSOIEN,1.7,"I") D UPDSTAT^PSOERXU1(PSOIEN,"RXW") Q
. D UPDSTAT^PSOERXU1(PSOIEN,"RXI")
I MTYPE="CX",$E(RXSTAT)'="H" D
. I $$GET1^DIQ(52.49,PSOIEN,1.3,"I"),$$GET1^DIQ(52.49,PSOIEN,1.5,"I"),$$GET1^DIQ(52.49,PSOIEN,1.7,"I") D UPDSTAT^PSOERXU1(PSOIEN,"CXW") Q
. D UPDSTAT^PSOERXU1(PSOIEN,"CXI")
I TYPE="P" D BPROC^PSOERXU8(PSOIEN,"PA",MVFLD,VBFLD,VBDTTMF,VDTTM) I '$G(VAMMODE),'$G(MBMSITE) K @VALMAR
I TYPE="PR" D BPROC^PSOERXU8(PSOIEN,"PR",MVFLD,VBFLD,VBDTTMF,VDTTM) I '$G(VAMMODE),'$G(MBMSITE) K @VALMAR
I TYPE="D" D
. ; Setting Clinic (if not already set)
. I '$$GET1^DIQ(52.49,+PSOIEN,20.6,"I") d
. . S $P(^PS(52.49,+PSOIEN,20),"^",6)=$S($G(PSOCLNC):PSOCLNC,1:$$GET1^DIQ(59,+$G(PSOSITE),10,"I"))
. I '$G(VAMMODE),'$G(MBMSITE) K @VALMAR
I '$G(MBMSITE) S VALMBCK="Q"
Q
; remove eRx from holding queue
REM ;
D REM^PSOERXU4
Q
; unremove eRx from holding queue
UNREM ;
D UNREM^PSOERXU4
Q
; reject eRx
REJ ;
D REJ^PSOERXU4
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERX1B 6227 printed Sep 23, 2025@20:04:35 Page 2
PSOERX1B ;ALB/BWF - Accept eRx function ; 8/3/2016 5:14pm
+1 ;;7.0;OUTPATIENT PHARMACY;**467,506,520,527,508,551,591,606,581,617,700,770**;DEC 1997;Build 145
+2 ;
+3 QUIT
ACVAL(PSOIEN,TYPE,VAMMODE) ; NEW MTYPE, GET IT OFF FIELD .08, IF NOT DEFINED,
+1 ;Input: PSOIEN - eRx IEN (Pointer to #52.49)
+2 ; TYPE - Validation Type (P: Patient, PR: Provider, D: Drug)
+3 ; VAMMODE - Validate All Matches Mode (optional)
+4 NEW MBMSITE,F,VBFLD,VBDTTMF,DIR,TAG,VALPAR,VAL,CURVAL,MVFLD,VBFLD,VBDTTMF,PSOIENS,RXSTAT,QFLG,VDTTM,ERXMMFLG,MTYPE,Y
+5 NEW RESTYPE,GMRA,GMRAL,ERXPTIEN,DFN
+6 SET MBMSITE=$SELECT($$GET1^DIQ(59.7,1,102,"I")="MBM":1,1:0)
+7 SET F=52.49
SET PSOIENS=PSOIEN_","
+8 DO FULL^VALM1
+9 SET VALMBCK="R"
+10 ; first check to see if the entry exists. cannot validate something that has no value
+11 ;mtype
SET MTYPE=$$GET1^DIQ(52.49,PSOIEN,.08,"I")
+12 SET RXSTAT=$$GET1^DIQ(52.49,PSOIEN,1,"E")
IF RXSTAT="RJ"!(RXSTAT="RM")!($EXTRACT(RXSTAT,1,3)="REM")!(RXSTAT="PR")!(RXSTAT="CRP")!(RXSTAT="CXP")!(RXSTAT="RRP")
Begin DoDot:1
+13 WRITE !!,"Cannot accept validation for a prescription with a status of 'Rejected',",!,"'Removed',or 'Processed",!
+14 SET DIR(0)="E"
DO ^DIR
End DoDot:1
QUIT
+15 if TYPE']""
QUIT
+16 SET TAG=$SELECT(TYPE="P":"patient",TYPE="PR":"provider",TYPE="D":"drug",1:"")
+17 SET VALPAR=$SELECT(TYPE="P":.05,TYPE="PR":2.3,TYPE="D":3.2,1:"")
if VALPAR=""
QUIT
+18 SET VAL=$$GET1^DIQ(F,PSOIEN,VALPAR,"I")
IF 'VAL
Begin DoDot:1
+19 WRITE !,"Vista "_TAG_" has not been matched. Cannot manually validate."
+20 SET DIR(0)="E"
DO ^DIR
End DoDot:1
QUIT
+21 SET MVFLD=$SELECT(TYPE="P":1.7,TYPE="PR":1.3,TYPE="D":1.5,1:"")
+22 SET VBFLD=$SELECT(TYPE="P":1.13,TYPE="PR":1.8,TYPE="D":1.11,1:"")
+23 SET VBDTTMF=$SELECT(TYPE="P":1.14,TYPE="PR":1.9,TYPE="D":1.12,1:"")
+24 ; check if Patient has a valid adress - CS prescriptions only
+25 IF TYPE="P"
IF $$GET1^DIQ(52.49,PSOIEN,95.1,"I")
IF '$$VALPTADD^PSOERXUT(+$GET(VAL))
Begin DoDot:1
+26 WRITE !!,"Unable to validate - VistA Patient does not have a current mailing"
+27 WRITE !,"or residential address on file.",$CHAR(7),!
+28 SET DIR(0)="E"
DO ^DIR
End DoDot:1
QUIT
+29 ; check to see if this is already validated
+30 IF MVFLD
SET CURVAL=$$GET1^DIQ(F,PSOIEN,MVFLD,"I")
+31 IF CURVAL
Begin DoDot:1
+32 WRITE !!,"This "_TAG_" has already been "_$SELECT(TYPE="PR"&$$GET1^DIQ(52.49,PSOIEN,2.7,"I"):"automatically",1:"manually")_" validated."
+33 WRITE !,"Validated By: "_$$GET1^DIQ(F,PSOIEN,VBFLD,"E")
+34 WRITE !,"Validated Date/Time: "_$$GET1^DIQ(F,PSOIEN,VBDTTMF,"E"),!
+35 SET DIR(0)="E"
DO ^DIR
End DoDot:1
QUIT
+36 SET QFLG=0
+37 IF TYPE="D"
Begin DoDot:1
+38 WRITE !
+39 IF '$ORDER(^PS(52.49,PSOIEN,21,0))
WRITE !,"Dosing information missing.",$CHAR(7)
SET QFLG=1
+40 IF $$GET1^DIQ(52.49,PSOIEN,20.1,"E")=""
WRITE !,"Quantity missing.",$CHAR(7)
SET QFLG=1
+41 IF $$GET1^DIQ(52.49,PSOIEN,20.2,"E")=""
WRITE !,"Days supply missing.",$CHAR(7)
SET QFLG=1
End DoDot:1
+42 IF $GET(QFLG)
WRITE !
SET DIR(0)="E"
DO ^DIR
KILL DIR
QUIT
+43 IF TYPE="D"
Begin DoDot:1
+44 NEW ERXMSG,I
+45 DO PRDRVAL^PSOERXUT(.ERXMSG,"VD",PSOIEN)
IF $PIECE(ERXMSG,"^",2)="B"
SET QFLG=1
+46 IF $ORDER(ERXMSG(0))
Begin DoDot:2
+47 WRITE !!,"*********************************",$SELECT($PIECE(ERXMSG,"^",2)="W":" WARNING(S) ",1:"INVALID DRUG"),"***********************************"
+48 SET I=0
FOR
SET I=$ORDER(ERXMSG(I))
if 'I
QUIT
WRITE !,$PIECE(ERXMSG(I),"^")
+49 WRITE !,"********************************************************************************",$CHAR(7)
End DoDot:2
End DoDot:1
+50 IF $GET(QFLG)
WRITE !
SET DIR(0)="E"
DO ^DIR
KILL DIR
QUIT
+51 ;
+52 IF TYPE="P"
Begin DoDot:1
+53 SET ERXMMFLG=$$PATWARN^PSOERX1E("VP",PSOIEN)
End DoDot:1
IF '$GET(ERXMMFLG)
SET DIR(0)="E"
DO ^DIR
KILL DIR
+54 ;
+55 SET DFN=$$GET1^DIQ(52.49,PSOIEN,.05,"I")
+56 ; VistA Patient ChampVA Eligibility Check (MbM Only)
+57 IF $GET(MBMSITE)
IF TYPE="P"
IF '$$CHVAELIG^PSOERXU9(DFN)
Begin DoDot:1
+58 IF ",N,I,W,RXI,RXN,RXW,RXR,CXI,CXN,CXW,"[(","_$GET(RXSTAT)_",")
Begin DoDot:2
+59 DO UPDSTAT^PSOERXU1(PSOIEN,"HEL","Hold due to Eligibility Issue")
+60 WRITE !!,"This eRx has been put on Hold (HEL) because the VistA Patient ("_$$GET1^DIQ(2,DFN,.01)_") is not Eligible for ChampVA Rx Benefit."
+61 KILL DIR
DO PAUSE^VALM1
End DoDot:2
+62 DO AUTOHOLD^PSOERX1E("E",PSOIEN,DFN)
End DoDot:1
QUIT
+63 ;
+64 ; VistA Patient Allergy Check (MbM Only)
+65 IF $GET(MBMSITE)
IF TYPE="P"
Begin DoDot:1
+66 SET GMRA="0^0^111"
DO EN1^GMRADPT
IF $GET(GMRAL)'=""
QUIT
+67 IF ",N,I,W,RXI,RXN,RXW,RXR,CXI,CXN,CXW,"[(","_$GET(RXSTAT)_",")
Begin DoDot:2
+68 DO UPDSTAT^PSOERXU1(PSOIEN,"HAL","Hold for Allergy Assessment")
+69 WRITE !!,"This eRx has been put on Hold (HAL) because the VistA Patient ("_$$GET1^DIQ(2,DFN,.01)_") does not have an Allergy Assessment.."
+70 KILL DIR
DO PAUSE^VALM1
End DoDot:2
+71 DO AUTOHOLD^PSOERX1E("A",PSOIEN,DFN)
End DoDot:1
IF $GET(GMRAL)=""
QUIT
+72 ;
+73 IF TYPE="P"
IF '$GET(ERXMMFLG)
QUIT
+74 ;
+75 IF TYPE="PR"
SET ERXMMFLG=$$PRVWARN^PSOERX1A("VP",PSOIEN)
IF 'ERXMMFLG
SET DIR(0)="E"
DO ^DIR
KILL DIR
QUIT
+76 IF '$GET(VAMMODE)
WRITE !,"Would you like to mark this "_TAG_" as VALIDATED?"
SET DIR(0)="Y"
SET DIR("B")=$SELECT($GET(ERXMMFLG):"NO",1:"YES")
DO ^DIR
if Y'=1
QUIT
+77 KILL FDA,DIR
+78 SET VDTTM=$$NOW^XLFDT
IF MVFLD
SET FDA(F,PSOIENS,MVFLD)=1
+79 IF VBFLD
SET FDA(F,PSOIENS,VBFLD)=$GET(DUZ)
+80 IF VBDTTMF
SET FDA(F,PSOIENS,VBDTTMF)=VDTTM
+81 IF $DATA(FDA)
DO FILE^DIE(,"FDA")
KILL FDA
+82 WRITE !,$SELECT(TYPE="P":"Patient",TYPE="PR":"Provider",1:"Drug/SIG")_" Match Validated!!"
+83 ; check validations and update status to 'wait' if all validations have occured.
+84 IF MTYPE="N"
IF $EXTRACT(RXSTAT)'="H"
Begin DoDot:1
+85 IF $$GET1^DIQ(52.49,PSOIEN,1.3,"I")
IF $$GET1^DIQ(52.49,PSOIEN,1.5,"I")
IF $$GET1^DIQ(52.49,PSOIEN,1.7,"I")
DO UPDSTAT^PSOERXU1(PSOIEN,"W")
QUIT
+86 DO UPDSTAT^PSOERXU1(PSOIEN,"I")
End DoDot:1
+87 IF MTYPE="RE"
IF $EXTRACT(RXSTAT)'="H"
Begin DoDot:1
+88 SET RESTYPE=$$GET1^DIQ(52.49,PSOIEN,52.1,"I")
+89 IF RESTYPE'="R"
DO UPDSTAT^PSOERXU1(PSOIEN,"RXW")
QUIT
+90 IF $$GET1^DIQ(52.49,PSOIEN,1.3,"I")
IF $$GET1^DIQ(52.49,PSOIEN,1.5,"I")
IF $$GET1^DIQ(52.49,PSOIEN,1.7,"I")
DO UPDSTAT^PSOERXU1(PSOIEN,"RXW")
QUIT
+91 DO UPDSTAT^PSOERXU1(PSOIEN,"RXI")
End DoDot:1
+92 IF MTYPE="CX"
IF $EXTRACT(RXSTAT)'="H"
Begin DoDot:1
+93 IF $$GET1^DIQ(52.49,PSOIEN,1.3,"I")
IF $$GET1^DIQ(52.49,PSOIEN,1.5,"I")
IF $$GET1^DIQ(52.49,PSOIEN,1.7,"I")
DO UPDSTAT^PSOERXU1(PSOIEN,"CXW")
QUIT
+94 DO UPDSTAT^PSOERXU1(PSOIEN,"CXI")
End DoDot:1
+95 IF TYPE="P"
DO BPROC^PSOERXU8(PSOIEN,"PA",MVFLD,VBFLD,VBDTTMF,VDTTM)
IF '$GET(VAMMODE)
IF '$GET(MBMSITE)
KILL @VALMAR
+96 IF TYPE="PR"
DO BPROC^PSOERXU8(PSOIEN,"PR",MVFLD,VBFLD,VBDTTMF,VDTTM)
IF '$GET(VAMMODE)
IF '$GET(MBMSITE)
KILL @VALMAR
+97 IF TYPE="D"
Begin DoDot:1
+98 ; Setting Clinic (if not already set)
+99 IF '$$GET1^DIQ(52.49,+PSOIEN,20.6,"I")
Begin DoDot:2
+100 SET $PIECE(^PS(52.49,+PSOIEN,20),"^",6)=$SELECT($GET(PSOCLNC):PSOCLNC,1:$$GET1^DIQ(59,+$GET(PSOSITE),10,"I"))
End DoDot:2
+101 IF '$GET(VAMMODE)
IF '$GET(MBMSITE)
KILL @VALMAR
End DoDot:1
+102 IF '$GET(MBMSITE)
SET VALMBCK="Q"
+103 QUIT
+104 ; remove eRx from holding queue
REM ;
+1 DO REM^PSOERXU4
+2 QUIT
+3 ; unremove eRx from holding queue
UNREM ;
+1 DO UNREM^PSOERXU4
+2 QUIT
+3 ; reject eRx
REJ ;
+1 DO REJ^PSOERXU4
