PSOERX1A ;ALB/BWF - eRx Utilities/RPC's ; 8/3/2016 5:14pm
;;7.0;OUTPATIENT PHARMACY;**467,527,508,551,581,617,669**;DEC 1997;Build 3
;
Q
; select an item
SI ;
N RESP,ERXIEN,ERXDAT,LINE,LINEVAR,ERXPAT,ERXLOCK,DIR,NEWRXIEN,REQIEN,MTYPE,Y
D FULL^VALM1
S DIR(0)="N^"_VALMBG_":"_VALMLST_":0" D ^DIR
I 'Y S VALMBCK="R" Q
S RESP=Y
S ERXIEN=$O(@VALMAR@("IDX",RESP,"")) Q:'ERXIEN
; Get the patient IEN
S ERXPAT=$$GETPAT^PSOERXU5(ERXIEN)
S MTYPE=$$GET1^DIQ(52.49,ERXIEN,.08,"I")
I 'ERXPAT,"IEOE"[MTYPE D EN^PSOERX1(ERXIEN) S VALMBCK="R" Q
I '$D(PCV) D Q
.S ERXLOCK=$$L(ERXPAT,1)
.I 'ERXLOCK S DIR(0)="E" D ^DIR K DIR S VALMBCK="R" Q
.D EN^PSOERX1(ERXIEN)
.D UL(ERXPAT)
.K % S VALMBCK="R"
D EN^PSOERX1(ERXIEN)
K %
S VALMBCK="R"
Q
SBN ;
N Y,ERXIEN,ERXPAT,DIR,MTYPE
D FULL^VALM1
S Y=+$P(XQORNOD(0),"=",2)
I 'Y S VALMBCK="R" Q
S ERXIEN=$O(@VALMAR@("IDX",Y,"")) Q:'ERXIEN
S ERXPAT=$$GETPAT^PSOERXU5(ERXIEN)
S MTYPE=$$GET1^DIQ(52.49,ERXIEN,.08,"I")
I 'ERXPAT,"IEOE"[MTYPE D EN^PSOERX1(ERXIEN) S VALMBCK="R" Q
I '$D(PCV) D Q
.S ERXLOCK=$$L(ERXPAT,1)
.I 'ERXLOCK S DIR(0)="E" D ^DIR K DIR S VALMBCK="R" Q
.D EN^PSOERX1(ERXIEN)
.D UL(ERXPAT)
.S VALMBCK="R" K %
D EN^PSOERX1(ERXIEN)
S VALMBCK="R"
K %
Q
L(DFN,DIS) ;
I $G(PSONOLCK) Q 1
N FLAG S ^XTMP("PSOERXLOCK",0)=$$PDATE
; if a lock is already established for this patient and is associated with the current user
I $P($G(^XTMP("PSOERXLOCK",DFN)),"^",1)=DUZ D Q FLAG
.L +^XTMP("PSOERXLOCK",DFN):$S($G(DILOCKTM)>0:DILOCKTM,1:3) S FLAG=$S($T=1:$T,1:0)
.I 'FLAG W !,"You have this patient locked in another open session"
I '$D(^XTMP("PSOERXLOCK",DFN)) D Q FLAG
. L +^XTMP("PSOERXLOCK",DFN):$S($G(DILOCKTM)>0:DILOCKTM,1:3) S FLAG=$S($T=1:$T,1:0)
. I FLAG D
. . D NOW^%DTC S ^XTMP("PSOERXLOCK",DFN)=DUZ_"^"_%
. . S FDA(52.46,DFN_",",6)=DUZ
. . D UPDATE^DIE(,"FDA") K FDA
I $D(^XTMP("PSOERXLOCK",DFN)) Q $$R
UL(DFN) ; unlock
I $G(PSONOLCK) Q
L -^XTMP("PSOERXLOCK",DFN) K ^XTMP("PSOERXLOCK",DFN)
Q
;
R() ; check lock on node
;if user has same patient already locked, Q 1, will only lock once
I $P($G(^XTMP("PSOERXLOCK",DFN)),"^")=DUZ Q 1
L +^XTMP("PSOERXLOCK",DFN):$S($G(DILOCKTM)>0:DILOCKTM,1:3)
I $T=1 D Q 1
.D NOW^%DTC S ^XTMP("PSOERXLOCK",DFN)=DUZ_"^"_%
.S FDA(52.46,DFN_",",6)=DUZ
.D UPDATE^DIE(,"FDA") K FDA
I $T=0 W:DIS=1 !,$$WHO(DFN) S Y=$P($G(^XTMP("PSOERXLOCK",DFN)),"^",2) X ^DD("DD") Q $S(DIS=0:0_"^"_$P($G(^VA(200,+$P($G(^XTMP("PSOERXLOCK",DFN)),"^"),0)),"^")_"^"_Y,1:0)
;
PDATE() ;
N X1,X2 S X1=DT,X2=+14 D C^%DTC
Q X_"^"_DT_"^eRx Pharmacy patient locks"
;
WHO(DFN) ;
S Y=$P($G(^XTMP("PSOERXLOCK",DFN)),"^",2) X ^DD("DD")
Q $P($G(^VA(200,+$P($G(^XTMP("PSOERXLOCK",DFN)),"^"),0)),"^")_" is editing orders for this patient ("_Y_")"
;
;
; TEXT - variable where text is stored (passed by reference)
; HDR - header text
; DATA - data associated with the header
; STRT - start location (column)
; LEN - total length for header and data
ADDITEM(TEXT,HDR,DATA,STRT,LEN) ;
N LLEN,FULLDAT,L
S FULLDAT=$G(HDR)_$G(DATA)
S TEXT=$G(TEXT,"") I STRT=1 S TEXT=TEXT_$E(FULLDAT,1,LEN) Q
S LLEN=$L(TEXT)
I LLEN<STRT D
.F L=$L(TEXT):1:STRT-1 D
..S TEXT=TEXT_" "
S TEXT=TEXT_$E(FULLDAT,1,LEN)
Q
; provider information display
PROV ;
D FULL^VALM1 I $$DONOTFIL^PSOERXUT(PSOIEN) S VALMBCK="R" Q
N STAT,RESVAL
S RESVAL=$$GET1^DIQ(52.49,PSOIEN,52.1,"I")
S STAT=$$GET1^DIQ(52.49,PSOIEN,1,"E")
I STAT="RXE",'$$RXEPRMT^PSOERXU7(PSOIEN) Q
I STAT="CXE",(RESVAL="A"!(RESVAL="AWC"))!(RESVAL="V"),'$$RXEPRMT^PSOERXU7(PSOIEN) Q
I '$$GET1^DIQ(52.49,PSOIEN,2.3,"I") S XQORM("B")="Edit"
D EN^PSOERXR1
Q
; patient information display
PAT ;
D FULL^VALM1 I $$DONOTFIL^PSOERXUT(PSOIEN) S VALMBCK="R" Q
N STAT,RESVAL
S RESVAL=$$GET1^DIQ(52.49,PSOIEN,52.1,"I")
S STAT=$$GET1^DIQ(52.49,PSOIEN,1,"E")
I STAT="RXE",'$$RXEPRMT^PSOERXU7(PSOIEN) Q
I STAT="CXE",(RESVAL="A"!(RESVAL="AWC"))!(RESVAL="V"),'$$RXEPRMT^PSOERXU7(PSOIEN) Q
I '$$GET1^DIQ(52.49,PSOIEN,.05,"I") S XQORM("B")="Edit"
D EN^PSOERXP1
Q
; drug information display
DRUG ;
D FULL^VALM1 I $$DONOTFIL^PSOERXUT(PSOIEN) S VALMBCK="R" Q
N STAT,RESVAL
S RESVAL=$$GET1^DIQ(52.49,PSOIEN,52.1,"I")
S STAT=$$GET1^DIQ(52.49,PSOIEN,1,"E")
I STAT="RXE",'$$RXEPRMT^PSOERXU7(PSOIEN) Q
I STAT="CXE",(RESVAL="A"!(RESVAL="AWC"))!(RESVAL="V"),'$$RXEPRMT^PSOERXU7(PSOIEN) Q
I '$$GET1^DIQ(52.49,PSOIEN,3.2,"I") S XQORM("B")="Edit"
D EN^PSOERXD1
Q
; edit validation
; EDTYPE - D=drug, P=patient, PR=provider
EDIT(EDTYP,SBN) ;
N DIR,Y,ITEM,RES,TAG,PQUIT,RXSTAT
D FULL^VALM1
S SBN=$G(SBN,"")
S VALMBCK="R"
Q:'$G(PSOIEN)
S RXSTAT=$$GET1^DIQ(52.49,PSOIEN,1,"E") I RXSTAT="RJ"!(RXSTAT="RM")!(RXSTAT="PR") D Q
.W !!,"Cannot edit a prescription with a status of 'Rejected', 'Removed',",!,"or 'Processed",!
.S DIR(0)="E" D ^DIR
S PSOIENS=PSOIEN_","
Q:'$D(EDTYP)
I EDTYP="D" D Q
.D PLSTRNG(1,10,.RES,SBN)
.I '$O(RES(0)) Q
.D DERX1^PSOERXD2(PSOIEN,PSOIENS)
.S (ITEM,PQUIT)=0 F S ITEM=$O(RES(ITEM)) Q:'ITEM!(PQUIT) D
..S TAG="VDRG"_ITEM_"^PSOERXD2(PSOIEN,PSOIENS)" D @TAG
.K @VALMAR D INIT^PSOERXD1
I EDTYP="P" D VPAT K @VALMAR D INIT^PSOERXP1 Q
I EDTYP="PR" D VPROV K @VALMAR D INIT^PSOERXR1 Q
Q
; edit provider
VPROV ;
N EXPRVIEN,VAPRVIEN,MANVAL,PRVDAT,EXPRNAME,EXPRLNAM,EXPRFNAM,PSOIENS,ERXMMFLG
N EXPRIENS,SELPRV,QUIT,VAPNM,NEWPIEN,VANPI,MTYPE,RESTYPE,ERXSTAT,NEWVAL,DONE
S PSOIENS=PSOIEN_","
S VAPNM=$$GET1^DIQ(52.49,PSOIEN,2.3,"E")
S EXPRVIEN=$$GET1^DIQ(52.49,PSOIEN,2.1,"I")
S EXPRIENS=EXPRVIEN_","
D GETS^DIQ(52.48,EXPRIENS,".01;.02;.03;1.5;1.6","E","PRVDAT")
S EXPRNAME=$G(PRVDAT(52.48,EXPRIENS,.01,"E"))
S EXPRLNAM=$G(PRVDAT(52.48,EXPRIENS,.02,"E"))
S EXPRFNAM=$G(PRVDAT(52.48,EXPRIENS,.03,"E"))
S MANVAL=$$GET1^DIQ(52.49,PSOIEN,1.3,"I")
S MTYPE=$$GET1^DIQ(52.49,PSOIEN,.08,"I")
S VAPIEN=$$GET1^DIQ(52.49,PSOIEN,2.3,"I")
S RESTYPE=$$GET1^DIQ(52.49,PSOIEN,52.1,"I")
S ERXSTAT=$$GET1^DIQ(52.49,PSOIEN,1,"E")
I VAPIEN D Q
.W !,"Current Vista provider: "_VAPNM,!
.S DIR(0)="YO",DIR("A")="Would you like to modify the current provider"
.I MANVAL S DIR("A",1)="This provider has already been validated."
.S DIR("B")="NO" D ^DIR
.Q:'Y
.S DONE=0
.F D Q:DONE Q:Y<1
..S DIC=200,DIC("A")="Select PROVIDER NAME: ",DIC(0)="AEMQ",DIC("S")="I $$CHKPRV2^PSOERX1A(Y)" D ^DIC
..Q:Y<1
..S NEWPIEN=$P(Y,U)
..L +^VA(200,NEWPIEN):1 I '$T D
...N ERXPRV S ERXPRV=$$GET1^DIQ(200,NEWPIEN,31)
...I ERXPRV'="" W $C(7),!!,"Provider is being edited by ",ERXPRV,! Q
...W $C(7),!!,"Provider is being edited by an unknown user or has been deleted"
..E S DONE=1 L -^VA(200,NEWPIEN)
.Q:Y<1
.S ERXMMFLG=$$PRVWARN("EP",PSOIEN,NEWPIEN) I 'ERXMMFLG D PAUSE^PSOERXUT Q
.S DIR(0)="Y",DIR("A")="Would you like to use this provider"
.S DIR("A",1)="You have selected provider: "_$$GET1^DIQ(200,NEWPIEN,.01,"E")
.S DIR("B")=$S(ERXMMFLG=2:"NO",1:"YES") D ^DIR
.I Y<1 S QUIT=1 Q
.; change existing entry
.S FDA(52.49,PSOIENS,2.3)=NEWPIEN
.; if the provider is different
.I VAPIEN'=NEWPIEN D Q
..;Setting the eRx Audit Log
..S NEWVAL(1)=$$GET1^DIQ(200,NEWPIEN,.01)_" (DEA#: "_$$DEA^XUSER(0,NEWPIEN)_")"
..D AUDLOG^PSOERXUT(+PSOIENS,"PROVIDER",DUZ,.NEWVAL)
..;Removing Manual Validation fields
..S FDA(52.49,PSOIENS,1.3)="",FDA(52.49,PSOIENS,1.8)="@",FDA(52.49,PSOIENS,1.9)="@"
..D FILE^DIE(,"FDA") K FDA
..I MTYPE="N" D UPDSTAT^PSOERXU1(PSOIEN,"I")
..I MTYPE="RE",RESTYPE="R" D UPDSTAT^PSOERXU1(PSOIEN,"RXI") Q
..I MTYPE="RE" D UPDSTAT^PSOERXU1(PSOIEN,"RXW")
..I MTYPE="CX" D UPDSTAT^PSOERXU1(PSOIEN,"CXI")
; for now, only list providers that are authorized to write med orders and whose dea is not expired
VPROV1 ;
S DIC=200,DIC("A")="Select PROVIDER NAME: ",DIC(0)="AEMQ",DIC("S")="I $$CHKPRV2^PSOERX1A(Y)" D ^DIC
Q:Y<1
S SELPRV=$P(Y,U)
L +^VA(200,SELPRV):1 I '$T D G VPROV1
.N ERXPRV S ERXPRV=$$GET1^DIQ(200,SELPRV,31)
.I ERXPRV'="" W $C(7),!!,"Provider is being edited by ",ERXPRV,! Q
.W $C(7),!!,"Provider is being edited by an unknown user or has been deleted"
L -^VA(200,SELPRV)
S ERXMMFLG=$$PRVWARN("EP",PSOIEN,SELPRV) I 'ERXMMFLG D PAUSE^PSOERXUT Q
S DIR(0)="Y",DIR("A")="Would you like to use this provider"
S DIR("A",1)="You have selected provider: "_$$GET1^DIQ(200,SELPRV,.01,"E")
S DIR("B")=$S(ERXMMFLG=2:"NO",1:"YES") D ^DIR
Q:Y<1
;Setting the eRx Audit Log
S NEWVAL(1)=$$GET1^DIQ(200,+SELPRV,.01)_" (DEA#: "_$$DEA^XUSER(0,+SELPRV)_")"
D AUDLOG^PSOERXUT(+PSOIENS,"PROVIDER",DUZ,.NEWVAL)
;Saving Provider
S FDA(52.49,PSOIENS,2.3)=$P(SELPRV,U)
D FILE^DIE(,"FDA","ERR") K FDA
I $$GET1^DIQ(52.49,PSOIEN,1,"E")="N" D UPDSTAT^PSOERXU1(PSOIEN,"I")
I MTYPE="RE",RESTYPE="R",ERXSTAT="RXR" D UPDSTAT^PSOERXU1(PSOIEN,"RXI") Q
I MTYPE="RE",ERXSTAT="RRN" D UPDSTAT^PSOERXU1(PSOIEN,"RXW")
I MTYPE="CX" D UPDSTAT^PSOERXU1(PSOIEN,"CXI")
Q
PRVWARN(ACTION,PSOIEN,VAPIEN) ; Check whether the Provider Select is valid or not
; Input:(r)ACTION - Ation being peformed ("EP": Edit Provider | "VP": Validate Provider)
; (r)PSOIEN - Pointer to the ERX HOLDING QUEUE file (#52.49)
; (r)VAPIEN - Provider -Pointer to the NEW PERSON file (#200)
;Output: 1 - No Issues Found with Provider Selected | 2 - Issues Found With Provider Select by Ok to to proceed | 0 - Invalid Provider Selection
N EXPRVNPI,VANPI,ERXDEA,VADEA,I,ERXMSG,ERXPIEN,EXPRVDEA,ERXDRIEN
S ERXPIEN=$$GET1^DIQ(52.49,PSOIEN,2.1,"I")
S ERXDRIEN=+$$GET1^DIQ(52.49,PSOIEN,3.2,"I")
I '$G(VAPIEN) S VAPIEN=$$GET1^DIQ(52.49,PSOIEN,2.3,"I") I '$G(VAPIEN) Q 0
D PRDRVAL^PSOERXUT(.ERXMSG,ACTION,PSOIEN,VAPIEN,ERXDRIEN)
I +ERXMSG Q 1
W !!,"*******************************",$S($P(ERXMSG,"^",2)="W":" WARNING(S) ",1:"INVALID PROVIDER"),"*********************************"
S I=0 F S I=$O(ERXMSG(I)) Q:'I W !,$P(ERXMSG(I),"^")
W !,"********************************************************************************"
I $P(ERXMSG,"^",2)="W" Q 2
Q 0
CHKPRV2(Y) ;
;Ref. to ^VA(200 supp. by IA 224
I '$P($G(^VA(200,Y,"PS")),U) Q 0
Q 1
; validate drug
; prompt list or range
; LOW - lowest number to prompt for
; HIGH - highest number to prompt for
; EDIT - returned list of selected values
; EDIT(n1)=""
; EDIT(n2)=""
; EDIT(n3)=""
PLSTRNG(LOW,HIGH,EDIT,SBN) ;
N DIR,DONE,DONE2,Y,NUMCHK,NUM,VAL,I,LIST
I '$G(LOW)!'$G(HIGH) S LIST=0 Q
S DONE=0
F D Q:DONE
.I $$GET1^DIQ(52.49,PSOIEN,3.2,"I")="" S Y="A"
.I '$D(Y),'$O(^PS(52.49,PSOIEN,21,0)) S Y="A"
.I SBN']"",'$D(Y)!($G(Y)[" ")!($G(Y)[".") D
..S DIR(0)="FO^",DIR("A")="Which field(s) would you like to edit? ("_LOW_"-"_HIGH_") or 'A'll"
..S DIR("?")="Enter a number, range, or a list of numbers (i.e. 3, 1-5, 3,7,9, or 'A'll)"
..S DIR("B")="A"
..D ^DIR K DIR
..I Y="^" S DONE=1 Q
.I SBN']"",Y["-",Y["," D Q
..W !!,"Invalid Response."
..W !,"Answer must be numeric (1-10), a series of numbers (3,5,7), 'A' or 'ALL'."
..S DIR(0)="E" D ^DIR K Y,DIR
.I SBN']"",(Y[".")!(Y[" ") D Q
..W !!,"Invalid Response."
..W !,"Answer must be numeric (1-10), a series of numbers (3,5,7), 'A' or 'ALL'."
..S DIR(0)="E" D ^DIR K DIR
..I Y'[" " K Y
.I SBN]"",'$D(Y) S Y=SBN
.Q:Y["."
.I Y="^" S DONE=1 Q
.S Y=$$UP^XLFSTR(Y)
.I Y="A"!(Y="ALL") D Q
..F I=LOW:1:HIGH D
...S EDIT(I)=""
..S DONE=1
.; check for a range or list of numbers
.I Y'["-",Y'[",",Y'<LOW,Y'>HIGH S EDIT(+Y)="" S DONE=1 Q
.I Y?1.2N1"-"1.2N D
..F I=$P(Y,"-"):1:$P(Y,"-",2) D
...Q:I<LOW!(I>HIGH)
...S EDIT(I)=""
.I $D(EDIT) S DONE=1 Q
.I Y["," D
..; check to see if there are alpha-numerics if there are, quit and reprompt
..S NUMCHK=$TR(Y,",","") I 'NUMCHK W !,"Invalid response." Q
..S DONE2=0
..F NUM=1:1 D Q:DONE2
...S VAL=$P(Y,",",NUM)
...I 'VAL S DONE2=1 Q
...I VAL<LOW!(VAL>HIGH) Q
...S EDIT(VAL)=""
.I $D(EDIT) S DONE=1 Q
.W !,"Invalid Response."
.W !,"Answer must be numeric (1-10), a series of numbers (3,5,7), 'A' or 'ALL'."
.S DIR(0)="E" D ^DIR K Y,DIR
Q
; validate patient
VPAT ;
N ERXPIEN,VAPIEN,MANVAL,ERXLNAME,ERXFNAME,DIR,Y,PSOIENS,VAPIEN,MANVAL,DIR,DIC,SELPAT,PDONE,DFN,I,VADM
N ERXSTAT,RESTYPE,MTYPE
S PSOIENS=PSOIEN_","
S ERXPIEN=$$GET1^DIQ(52.49,PSOIEN,.04,"I")
S ERXLNAME=$$GET1^DIQ(52.46,ERXPIEN,.02,"E")
S ERXFNAME=$$GET1^DIQ(52.46,ERXPIEN,.03,"E")
S VAPIEN=$$GET1^DIQ(52.49,PSOIEN,.05,"I")
S MANVAL=$$GET1^DIQ(52.49,PSOIEN,1.7,"I")
S RESTYPE=$$GET1^DIQ(52.49,PSOIEN,52.1)
S ERXSTAT=$$GET1^DIQ(52.49,PSOIEN,1,"E")
S MTYPE=$$GET1^DIQ(52.49,PSOIEN,.08,"I")
; if there is a patient currently defined
I VAPIEN D Q
.W !,"Current Vista patient: "_$$GET1^DIQ(2,VAPIEN,.01,"E"),!
.S DIR(0)="YO",DIR("A")="Would you like to edit the patient"
.S DIR("A",1)="A patient has already matched to a vista patient."
.S DIR("B")="NO" D ^DIR
.Q:Y'=1
.S DIC(0)="AEMQ",SELPAT=$$PATPRMT() K DUOUT Q:'SELPAT
.S DFN=SELPAT D DEM^VADPT
.I $P($G(VADM(6)),U)]"" W "[PATIENT DIED ON "_$P($G(VADM(6)),U,2)_"]" Q
.S ERXMMFLG=$$PATWARN("EP",PSOIEN,SELPAT)
.S DIR(0)="Y",DIR("A")="Would you like to use this patient"
.S DIR("A",1)="You have selected patient: "_$$GET1^DIQ(2,SELPAT,.01,"E")
.S DIR("B")=$S($G(ERXMMFLG):"NO",1:"YES") D ^DIR
.Q:Y'=1
.; change existing entry
.S FDA(52.49,PSOIENS,.05)=SELPAT
.I SELPAT'=VAPIEN D Q
..;Setting the eRx Audit Log
..N NEWVAL S NEWVAL(1)=$$GET1^DIQ(2,SELPAT,.01)_" (L4SSN: "_$P($P(VADM(2),"^",2),"-",3)_" | DOB: "_$P(VADM(3),"^",2)_")"
..D AUDLOG^PSOERXUT(PSOIENS,"PATIENT",DUZ,.NEWVAL)
..;Updating eRx Record w/ New Patient
..S FDA(52.49,PSOIENS,1.7)="",FDA(52.49,PSOIENS,1.13)="",FDA(52.49,PSOIENS,1.14)=""
..D FILE^DIE(,"FDA") K FDA
..;Updating eRx Status to In Progress
..I MTYPE="N" D UPDSTAT^PSOERXU1(PSOIEN,"I")
..I MTYPE="RE" D UPDSTAT^PSOERXU1(PSOIEN,"RXI")
..I MTYPE="CX" D UPDSTAT^PSOERXU1(PSOIEN,"CXI")
.I MTYPE="RE" D UPDSTAT^PSOERXU1(PSOIEN,"RXI")
.I MTYPE="CX" D UPDSTAT^PSOERXU1(PSOIEN,"CXI")
.I ERXSTAT="N" D UPDSTAT^PSOERXU1(PSOIEN,"I")
S DIC(0)="AEMQ",SELPAT=$$PATPRMT() K DUOUT I 'SELPAT S XQORM("B")="Edit" Q
S DFN=SELPAT D DEM^VADPT
I $P($G(VADM(6)),U)]"" W "[PATIENT DIED ON "_$P($G(VADM(6)),U,2)_"]" S DIR(0)="E" D ^DIR K DIR Q
S ERXMMFLG=$$PATWARN("EP",PSOIEN,SELPAT)
S DIR(0)="Y",DIR("A")="Would you like to use this patient"
S DIR("A",1)="You have selected patient: "_$$GET1^DIQ(2,SELPAT,.01,"E")
S DIR("B")=$S($G(ERXMMFLG):"NO",1:"YES") D ^DIR
I Y'=1 S XQORM("B")="Edit" Q
;Setting the eRx Audit Log
N NEWVAL S NEWVAL(1)=$$GET1^DIQ(2,SELPAT,.01)_" (L4SSN: "_$P($P(VADM(2),"^",2),"-",3)_" | DOB: "_$P(VADM(3),"^",2)_")"
D AUDLOG^PSOERXUT(PSOIEN,"PATIENT",DUZ,.NEWVAL)
;Saving Patient
S FDA(52.49,PSOIENS,.05)=SELPAT
D FILE^DIE(,"FDA") K FDA
;Updating eRx Status to In Progress
I MTYPE="CX" D UPDSTAT^PSOERXU1(PSOIEN,"CXI")
I MTYPE="RE" D UPDSTAT^PSOERXU1(PSOIEN,"RXI")
I ERXSTAT="N" D UPDSTAT^PSOERXU1(PSOIEN,"I")
Q
PATWARN(ACTION,PSOIEN,SELPAT) ; Check whether the Patient Select is valid or not
; Input:(r)ACTION - Ation being peformed ("EP": Edit Patient | "VP": Validate Patient)
; (r)PSOIEN - Pointer to the ERX HOLDING QUEUE file (#52.49)
; (r)SELPAT - Patient -Pointer to the PATIENT file (#2)
;Output: 1 - No Issues Found with Patient Selected | 2 - Issues Found With Patient selected but Ok to proceed | 0 - Invalid Patient Selection
N ERXPIEN,ERXSSN,ERXDOB,ERXGEN,ERXMMFLG,ERXMSG,EXPRVDEA,ERXCNT,I,VADM
S ERXCNT=0,ERXMMFLG=1
S ERXPIEN=$$GET1^DIQ(52.49,PSOIEN,.04,"I")
S ERXSSN=$$GET1^DIQ(52.46,ERXPIEN,1.4,"E"),ERXSSN=$TR(ERXSSN,"-","")
S ERXDOB=$$GET1^DIQ(52.46,ERXPIEN,.08,"I")
S ERXGEN=$$GET1^DIQ(52.46,ERXPIEN,.07,"I")
; if the selected patient is not defined, use the va matched patient because we are doing this check
; during accept validation
I '$G(SELPAT) S SELPAT=$$GET1^DIQ(52.49,PSOIEN,.05,"I") Q:'$G(SELPAT) 0
S DFN=SELPAT D DEM^VADPT
I ERXSSN,'$D(^DPT("SSN",ERXSSN,SELPAT)) S ERXMMFLG=2,ERXCNT=ERXCNT+1,ERXMSG(ERXCNT)="SSN mismatch."
I ERXDOB,'$D(^DPT("ADOB",ERXDOB,SELPAT)) S ERXMMFLG=2,ERXCNT=ERXCNT+1,ERXMSG(ERXCNT)="Date of Birth mismatch."
I ERXGEN]"",$P($G(VADM(5)),U)'=ERXGEN S ERXMMFLG=2,ERXCNT=ERXCNT+1,ERXMSG(ERXCNT)="Gender mismatch."
; Warning/Block for Patient w/out valid Address (CS prescriptions only)
I $$GET1^DIQ(52.49,ERXIEN,95.1,"I"),'$$VALPTADD^PSOERXUT(SELPAT) D
. S ERXMMFLG=1,ERXCNT=ERXCNT+1,ERXMSG(ERXCNT)="Patient does not have a current mailing or residential address on file."
. S ERXMMFLG=$S(ACTION="EP":2,1:0)
;
I $O(ERXMSG(0)) D
. W !!,"*******************************",$S(ERXMMFLG:" WARNING(S) ",1:"INVALID PATIENT"),"*******************************"
. S I=0 F S I=$O(ERXMSG(I)) Q:'I D
. . W !,$G(ERXMSG(I))
. W !,"*****************************************************************************"
;
Q ERXMMFLG
;
PATPRMT() ;
N Y
D ^DPTLK
I $P(Y,U)<1 Q 0
Q $P(Y,U)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOERX1A 17065 printed May 14, 2023@14:55:34 Page 2
PSOERX1A ;ALB/BWF - eRx Utilities/RPC's ; 8/3/2016 5:14pm
+1 ;;7.0;OUTPATIENT PHARMACY;**467,527,508,551,581,617,669**;DEC 1997;Build 3
+2 ;
+3 QUIT
+4 ; select an item
SI ;
+1 NEW RESP,ERXIEN,ERXDAT,LINE,LINEVAR,ERXPAT,ERXLOCK,DIR,NEWRXIEN,REQIEN,MTYPE,Y
+2 DO FULL^VALM1
+3 SET DIR(0)="N^"_VALMBG_":"_VALMLST_":0"
DO ^DIR
+4 IF 'Y
SET VALMBCK="R"
QUIT
+5 SET RESP=Y
+6 SET ERXIEN=$ORDER(@VALMAR@("IDX",RESP,""))
if 'ERXIEN
QUIT
+7 ; Get the patient IEN
+8 SET ERXPAT=$$GETPAT^PSOERXU5(ERXIEN)
+9 SET MTYPE=$$GET1^DIQ(52.49,ERXIEN,.08,"I")
+10 IF 'ERXPAT
IF "IEOE"[MTYPE
DO EN^PSOERX1(ERXIEN)
SET VALMBCK="R"
QUIT
+11 IF '$DATA(PCV)
Begin DoDot:1
+12 SET ERXLOCK=$$L(ERXPAT,1)
+13 IF 'ERXLOCK
SET DIR(0)="E"
DO ^DIR
KILL DIR
SET VALMBCK="R"
QUIT
+14 DO EN^PSOERX1(ERXIEN)
+15 DO UL(ERXPAT)
+16 KILL %
SET VALMBCK="R"
End DoDot:1
QUIT
+17 DO EN^PSOERX1(ERXIEN)
+18 KILL %
+19 SET VALMBCK="R"
+20 QUIT
SBN ;
+1 NEW Y,ERXIEN,ERXPAT,DIR,MTYPE
+2 DO FULL^VALM1
+3 SET Y=+$PIECE(XQORNOD(0),"=",2)
+4 IF 'Y
SET VALMBCK="R"
QUIT
+5 SET ERXIEN=$ORDER(@VALMAR@("IDX",Y,""))
if 'ERXIEN
QUIT
+6 SET ERXPAT=$$GETPAT^PSOERXU5(ERXIEN)
+7 SET MTYPE=$$GET1^DIQ(52.49,ERXIEN,.08,"I")
+8 IF 'ERXPAT
IF "IEOE"[MTYPE
DO EN^PSOERX1(ERXIEN)
SET VALMBCK="R"
QUIT
+9 IF '$DATA(PCV)
Begin DoDot:1
+10 SET ERXLOCK=$$L(ERXPAT,1)
+11 IF 'ERXLOCK
SET DIR(0)="E"
DO ^DIR
KILL DIR
SET VALMBCK="R"
QUIT
+12 DO EN^PSOERX1(ERXIEN)
+13 DO UL(ERXPAT)
+14 SET VALMBCK="R"
KILL %
End DoDot:1
QUIT
+15 DO EN^PSOERX1(ERXIEN)
+16 SET VALMBCK="R"
+17 KILL %
+18 QUIT
L(DFN,DIS) ;
+1 IF $GET(PSONOLCK)
QUIT 1
+2 NEW FLAG
SET ^XTMP("PSOERXLOCK",0)=$$PDATE
+3 ; if a lock is already established for this patient and is associated with the current user
+4 IF $PIECE($GET(^XTMP("PSOERXLOCK",DFN)),"^",1)=DUZ
Begin DoDot:1
+5 LOCK +^XTMP("PSOERXLOCK",DFN):$SELECT($GET(DILOCKTM)>0:DILOCKTM,1:3)
SET FLAG=$SELECT($TEST=1:$TEST,1:0)
+6 IF 'FLAG
WRITE !,"You have this patient locked in another open session"
End DoDot:1
QUIT FLAG
+7 IF '$DATA(^XTMP("PSOERXLOCK",DFN))
Begin DoDot:1
+8 LOCK +^XTMP("PSOERXLOCK",DFN):$SELECT($GET(DILOCKTM)>0:DILOCKTM,1:3)
SET FLAG=$SELECT($TEST=1:$TEST,1:0)
+9 IF FLAG
Begin DoDot:2
+10 DO NOW^%DTC
SET ^XTMP("PSOERXLOCK",DFN)=DUZ_"^"_%
+11 SET FDA(52.46,DFN_",",6)=DUZ
+12 DO UPDATE^DIE(,"FDA")
KILL FDA
End DoDot:2
End DoDot:1
QUIT FLAG
+13 IF $DATA(^XTMP("PSOERXLOCK",DFN))
QUIT $$R
UL(DFN) ; unlock
+1 IF $GET(PSONOLCK)
QUIT
+2 LOCK -^XTMP("PSOERXLOCK",DFN)
KILL ^XTMP("PSOERXLOCK",DFN)
+3 QUIT
+4 ;
R() ; check lock on node
+1 ;if user has same patient already locked, Q 1, will only lock once
+2 IF $PIECE($GET(^XTMP("PSOERXLOCK",DFN)),"^")=DUZ
QUIT 1
+3 LOCK +^XTMP("PSOERXLOCK",DFN):$SELECT($GET(DILOCKTM)>0:DILOCKTM,1:3)
+4 IF $TEST=1
Begin DoDot:1
+5 DO NOW^%DTC
SET ^XTMP("PSOERXLOCK",DFN)=DUZ_"^"_%
+6 SET FDA(52.46,DFN_",",6)=DUZ
+7 DO UPDATE^DIE(,"FDA")
KILL FDA
End DoDot:1
QUIT 1
+8 IF $TEST=0
if DIS=1
WRITE !,$$WHO(DFN)
SET Y=$PIECE($GET(^XTMP("PSOERXLOCK",DFN)),"^",2)
XECUTE ^DD("DD")
QUIT $SELECT(DIS=0:0_"^"_$PIECE($GET(^VA(200,+$PIECE($GET(^XTMP("PSOERXLOCK",DFN)),"^"),0)),"^")_"^"_Y,1:0)
+9 ;
PDATE() ;
+1 NEW X1,X2
SET X1=DT
SET X2=+14
DO C^%DTC
+2 QUIT X_"^"_DT_"^eRx Pharmacy patient locks"
+3 ;
WHO(DFN) ;
+1 SET Y=$PIECE($GET(^XTMP("PSOERXLOCK",DFN)),"^",2)
XECUTE ^DD("DD")
+2 QUIT $PIECE($GET(^VA(200,+$PIECE($GET(^XTMP("PSOERXLOCK",DFN)),"^"),0)),"^")_" is editing orders for this patient ("_Y_")"
+3 ;
+4 ;
+5 ; TEXT - variable where text is stored (passed by reference)
+6 ; HDR - header text
+7 ; DATA - data associated with the header
+8 ; STRT - start location (column)
+9 ; LEN - total length for header and data
ADDITEM(TEXT,HDR,DATA,STRT,LEN) ;
+1 NEW LLEN,FULLDAT,L
+2 SET FULLDAT=$GET(HDR)_$GET(DATA)
+3 SET TEXT=$GET(TEXT,"")
IF STRT=1
SET TEXT=TEXT_$EXTRACT(FULLDAT,1,LEN)
QUIT
+4 SET LLEN=$LENGTH(TEXT)
+5 IF LLEN<STRT
Begin DoDot:1
+6 FOR L=$LENGTH(TEXT):1:STRT-1
Begin DoDot:2
+7 SET TEXT=TEXT_" "
End DoDot:2
End DoDot:1
+8 SET TEXT=TEXT_$EXTRACT(FULLDAT,1,LEN)
+9 QUIT
+10 ; provider information display
PROV ;
+1 DO FULL^VALM1
IF $$DONOTFIL^PSOERXUT(PSOIEN)
SET VALMBCK="R"
QUIT
+2 NEW STAT,RESVAL
+3 SET RESVAL=$$GET1^DIQ(52.49,PSOIEN,52.1,"I")
+4 SET STAT=$$GET1^DIQ(52.49,PSOIEN,1,"E")
+5 IF STAT="RXE"
IF '$$RXEPRMT^PSOERXU7(PSOIEN)
QUIT
+6 IF STAT="CXE"
IF (RESVAL="A"!(RESVAL="AWC"))!(RESVAL="V")
IF '$$RXEPRMT^PSOERXU7(PSOIEN)
QUIT
+7 IF '$$GET1^DIQ(52.49,PSOIEN,2.3,"I")
SET XQORM("B")="Edit"
+8 DO EN^PSOERXR1
+9 QUIT
+10 ; patient information display
PAT ;
+1 DO FULL^VALM1
IF $$DONOTFIL^PSOERXUT(PSOIEN)
SET VALMBCK="R"
QUIT
+2 NEW STAT,RESVAL
+3 SET RESVAL=$$GET1^DIQ(52.49,PSOIEN,52.1,"I")
+4 SET STAT=$$GET1^DIQ(52.49,PSOIEN,1,"E")
+5 IF STAT="RXE"
IF '$$RXEPRMT^PSOERXU7(PSOIEN)
QUIT
+6 IF STAT="CXE"
IF (RESVAL="A"!(RESVAL="AWC"))!(RESVAL="V")
IF '$$RXEPRMT^PSOERXU7(PSOIEN)
QUIT
+7 IF '$$GET1^DIQ(52.49,PSOIEN,.05,"I")
SET XQORM("B")="Edit"
+8 DO EN^PSOERXP1
+9 QUIT
+10 ; drug information display
DRUG ;
+1 DO FULL^VALM1
IF $$DONOTFIL^PSOERXUT(PSOIEN)
SET VALMBCK="R"
QUIT
+2 NEW STAT,RESVAL
+3 SET RESVAL=$$GET1^DIQ(52.49,PSOIEN,52.1,"I")
+4 SET STAT=$$GET1^DIQ(52.49,PSOIEN,1,"E")
+5 IF STAT="RXE"
IF '$$RXEPRMT^PSOERXU7(PSOIEN)
QUIT
+6 IF STAT="CXE"
IF (RESVAL="A"!(RESVAL="AWC"))!(RESVAL="V")
IF '$$RXEPRMT^PSOERXU7(PSOIEN)
QUIT
+7 IF '$$GET1^DIQ(52.49,PSOIEN,3.2,"I")
SET XQORM("B")="Edit"
+8 DO EN^PSOERXD1
+9 QUIT
+10 ; edit validation
+11 ; EDTYPE - D=drug, P=patient, PR=provider
EDIT(EDTYP,SBN) ;
+1 NEW DIR,Y,ITEM,RES,TAG,PQUIT,RXSTAT
+2 DO FULL^VALM1
+3 SET SBN=$GET(SBN,"")
+4 SET VALMBCK="R"
+5 if '$GET(PSOIEN)
QUIT
+6 SET RXSTAT=$$GET1^DIQ(52.49,PSOIEN,1,"E")
IF RXSTAT="RJ"!(RXSTAT="RM")!(RXSTAT="PR")
Begin DoDot:1
+7 WRITE !!,"Cannot edit a prescription with a status of 'Rejected', 'Removed',",!,"or 'Processed",!
+8 SET DIR(0)="E"
DO ^DIR
End DoDot:1
QUIT
+9 SET PSOIENS=PSOIEN_","
+10 if '$DATA(EDTYP)
QUIT
+11 IF EDTYP="D"
Begin DoDot:1
+12 DO PLSTRNG(1,10,.RES,SBN)
+13 IF '$ORDER(RES(0))
QUIT
+14 DO DERX1^PSOERXD2(PSOIEN,PSOIENS)
+15 SET (ITEM,PQUIT)=0
FOR
SET ITEM=$ORDER(RES(ITEM))
if 'ITEM!(PQUIT)
QUIT
Begin DoDot:2
+16 SET TAG="VDRG"_ITEM_"^PSOERXD2(PSOIEN,PSOIENS)"
DO @TAG
End DoDot:2
+17 KILL @VALMAR
DO INIT^PSOERXD1
End DoDot:1
QUIT
+18 IF EDTYP="P"
DO VPAT
KILL @VALMAR
DO INIT^PSOERXP1
QUIT
+19 IF EDTYP="PR"
DO VPROV
KILL @VALMAR
DO INIT^PSOERXR1
QUIT
+20 QUIT
+21 ; edit provider
VPROV ;
+1 NEW EXPRVIEN,VAPRVIEN,MANVAL,PRVDAT,EXPRNAME,EXPRLNAM,EXPRFNAM,PSOIENS,ERXMMFLG
+2 NEW EXPRIENS,SELPRV,QUIT,VAPNM,NEWPIEN,VANPI,MTYPE,RESTYPE,ERXSTAT,NEWVAL,DONE
+3 SET PSOIENS=PSOIEN_","
+4 SET VAPNM=$$GET1^DIQ(52.49,PSOIEN,2.3,"E")
+5 SET EXPRVIEN=$$GET1^DIQ(52.49,PSOIEN,2.1,"I")
+6 SET EXPRIENS=EXPRVIEN_","
+7 DO GETS^DIQ(52.48,EXPRIENS,".01;.02;.03;1.5;1.6","E","PRVDAT")
+8 SET EXPRNAME=$GET(PRVDAT(52.48,EXPRIENS,.01,"E"))
+9 SET EXPRLNAM=$GET(PRVDAT(52.48,EXPRIENS,.02,"E"))
+10 SET EXPRFNAM=$GET(PRVDAT(52.48,EXPRIENS,.03,"E"))
+11 SET MANVAL=$$GET1^DIQ(52.49,PSOIEN,1.3,"I")
+12 SET MTYPE=$$GET1^DIQ(52.49,PSOIEN,.08,"I")
+13 SET VAPIEN=$$GET1^DIQ(52.49,PSOIEN,2.3,"I")
+14 SET RESTYPE=$$GET1^DIQ(52.49,PSOIEN,52.1,"I")
+15 SET ERXSTAT=$$GET1^DIQ(52.49,PSOIEN,1,"E")
+16 IF VAPIEN
Begin DoDot:1
+17 WRITE !,"Current Vista provider: "_VAPNM,!
+18 SET DIR(0)="YO"
SET DIR("A")="Would you like to modify the current provider"
+19 IF MANVAL
SET DIR("A",1)="This provider has already been validated."
+20 SET DIR("B")="NO"
DO ^DIR
+21 if 'Y
QUIT
+22 SET DONE=0
+23 FOR
Begin DoDot:2
+24 SET DIC=200
SET DIC("A")="Select PROVIDER NAME: "
SET DIC(0)="AEMQ"
SET DIC("S")="I $$CHKPRV2^PSOERX1A(Y)"
DO ^DIC
+25 if Y<1
QUIT
+26 SET NEWPIEN=$PIECE(Y,U)
+27 LOCK +^VA(200,NEWPIEN):1
IF '$TEST
Begin DoDot:3
+28 NEW ERXPRV
SET ERXPRV=$$GET1^DIQ(200,NEWPIEN,31)
+29 IF ERXPRV'=""
WRITE $CHAR(7),!!,"Provider is being edited by ",ERXPRV,!
QUIT
+30 WRITE $CHAR(7),!!,"Provider is being edited by an unknown user or has been deleted"
End DoDot:3
+31 IF '$TEST
SET DONE=1
LOCK -^VA(200,NEWPIEN)
End DoDot:2
if DONE
QUIT
if Y<1
QUIT
+32 if Y<1
QUIT
+33 SET ERXMMFLG=$$PRVWARN("EP",PSOIEN,NEWPIEN)
IF 'ERXMMFLG
DO PAUSE^PSOERXUT
QUIT
+34 SET DIR(0)="Y"
SET DIR("A")="Would you like to use this provider"
+35 SET DIR("A",1)="You have selected provider: "_$$GET1^DIQ(200,NEWPIEN,.01,"E")
+36 SET DIR("B")=$SELECT(ERXMMFLG=2:"NO",1:"YES")
DO ^DIR
+37 IF Y<1
SET QUIT=1
QUIT
+38 ; change existing entry
+39 SET FDA(52.49,PSOIENS,2.3)=NEWPIEN
+40 ; if the provider is different
+41 IF VAPIEN'=NEWPIEN
Begin DoDot:2
+42 ;Setting the eRx Audit Log
+43 SET NEWVAL(1)=$$GET1^DIQ(200,NEWPIEN,.01)_" (DEA#: "_$$DEA^XUSER(0,NEWPIEN)_")"
+44 DO AUDLOG^PSOERXUT(+PSOIENS,"PROVIDER",DUZ,.NEWVAL)
+45 ;Removing Manual Validation fields
+46 SET FDA(52.49,PSOIENS,1.3)=""
SET FDA(52.49,PSOIENS,1.8)="@"
SET FDA(52.49,PSOIENS,1.9)="@"
+47 DO FILE^DIE(,"FDA")
KILL FDA
+48 IF MTYPE="N"
DO UPDSTAT^PSOERXU1(PSOIEN,"I")
+49 IF MTYPE="RE"
IF RESTYPE="R"
DO UPDSTAT^PSOERXU1(PSOIEN,"RXI")
QUIT
+50 IF MTYPE="RE"
DO UPDSTAT^PSOERXU1(PSOIEN,"RXW")
+51 IF MTYPE="CX"
DO UPDSTAT^PSOERXU1(PSOIEN,"CXI")
End DoDot:2
QUIT
End DoDot:1
QUIT
+52 ; for now, only list providers that are authorized to write med orders and whose dea is not expired
VPROV1 ;
+1 SET DIC=200
SET DIC("A")="Select PROVIDER NAME: "
SET DIC(0)="AEMQ"
SET DIC("S")="I $$CHKPRV2^PSOERX1A(Y)"
DO ^DIC
+2 if Y<1
QUIT
+3 SET SELPRV=$PIECE(Y,U)
+4 LOCK +^VA(200,SELPRV):1
IF '$TEST
Begin DoDot:1
+5 NEW ERXPRV
SET ERXPRV=$$GET1^DIQ(200,SELPRV,31)
+6 IF ERXPRV'=""
WRITE $CHAR(7),!!,"Provider is being edited by ",ERXPRV,!
QUIT
+7 WRITE $CHAR(7),!!,"Provider is being edited by an unknown user or has been deleted"
End DoDot:1
GOTO VPROV1
+8 LOCK -^VA(200,SELPRV)
+9 SET ERXMMFLG=$$PRVWARN("EP",PSOIEN,SELPRV)
IF 'ERXMMFLG
DO PAUSE^PSOERXUT
QUIT
+10 SET DIR(0)="Y"
SET DIR("A")="Would you like to use this provider"
+11 SET DIR("A",1)="You have selected provider: "_$$GET1^DIQ(200,SELPRV,.01,"E")
+12 SET DIR("B")=$SELECT(ERXMMFLG=2:"NO",1:"YES")
DO ^DIR
+13 if Y<1
QUIT
+14 ;Setting the eRx Audit Log
+15 SET NEWVAL(1)=$$GET1^DIQ(200,+SELPRV,.01)_" (DEA#: "_$$DEA^XUSER(0,+SELPRV)_")"
+16 DO AUDLOG^PSOERXUT(+PSOIENS,"PROVIDER",DUZ,.NEWVAL)
+17 ;Saving Provider
+18 SET FDA(52.49,PSOIENS,2.3)=$PIECE(SELPRV,U)
+19 DO FILE^DIE(,"FDA","ERR")
KILL FDA
+20 IF $$GET1^DIQ(52.49,PSOIEN,1,"E")="N"
DO UPDSTAT^PSOERXU1(PSOIEN,"I")
+21 IF MTYPE="RE"
IF RESTYPE="R"
IF ERXSTAT="RXR"
DO UPDSTAT^PSOERXU1(PSOIEN,"RXI")
QUIT
+22 IF MTYPE="RE"
IF ERXSTAT="RRN"
DO UPDSTAT^PSOERXU1(PSOIEN,"RXW")
+23 IF MTYPE="CX"
DO UPDSTAT^PSOERXU1(PSOIEN,"CXI")
+24 QUIT
PRVWARN(ACTION,PSOIEN,VAPIEN) ; Check whether the Provider Select is valid or not
+1 ; Input:(r)ACTION - Ation being peformed ("EP": Edit Provider | "VP": Validate Provider)
+2 ; (r)PSOIEN - Pointer to the ERX HOLDING QUEUE file (#52.49)
+3 ; (r)VAPIEN - Provider -Pointer to the NEW PERSON file (#200)
+4 ;Output: 1 - No Issues Found with Provider Selected | 2 - Issues Found With Provider Select by Ok to to proceed | 0 - Invalid Provider Selection
+5 NEW EXPRVNPI,VANPI,ERXDEA,VADEA,I,ERXMSG,ERXPIEN,EXPRVDEA,ERXDRIEN
+6 SET ERXPIEN=$$GET1^DIQ(52.49,PSOIEN,2.1,"I")
+7 SET ERXDRIEN=+$$GET1^DIQ(52.49,PSOIEN,3.2,"I")
+8 IF '$GET(VAPIEN)
SET VAPIEN=$$GET1^DIQ(52.49,PSOIEN,2.3,"I")
IF '$GET(VAPIEN)
QUIT 0
+9 DO PRDRVAL^PSOERXUT(.ERXMSG,ACTION,PSOIEN,VAPIEN,ERXDRIEN)
+10 IF +ERXMSG
QUIT 1
+11 WRITE !!,"*******************************",$SELECT($PIECE(ERXMSG,"^",2)="W":" WARNING(S) ",1:"INVALID PROVIDER"),"*********************************"
+12 SET I=0
FOR
SET I=$ORDER(ERXMSG(I))
if 'I
QUIT
WRITE !,$PIECE(ERXMSG(I),"^")
+13 WRITE !,"********************************************************************************"
+14 IF $PIECE(ERXMSG,"^",2)="W"
QUIT 2
+15 QUIT 0
CHKPRV2(Y) ;
+1 ;Ref. to ^VA(200 supp. by IA 224
+2 IF '$PIECE($GET(^VA(200,Y,"PS")),U)
QUIT 0
+3 QUIT 1
+4 ; validate drug
+5 ; prompt list or range
+6 ; LOW - lowest number to prompt for
+7 ; HIGH - highest number to prompt for
+8 ; EDIT - returned list of selected values
+9 ; EDIT(n1)=""
+10 ; EDIT(n2)=""
+11 ; EDIT(n3)=""
PLSTRNG(LOW,HIGH,EDIT,SBN) ;
+1 NEW DIR,DONE,DONE2,Y,NUMCHK,NUM,VAL,I,LIST
+2 IF '$GET(LOW)!'$GET(HIGH)
SET LIST=0
QUIT
+3 SET DONE=0
+4 FOR
Begin DoDot:1
+5 IF $$GET1^DIQ(52.49,PSOIEN,3.2,"I")=""
SET Y="A"
+6 IF '$DATA(Y)
IF '$ORDER(^PS(52.49,PSOIEN,21,0))
SET Y="A"
+7 IF SBN']""
IF '$DATA(Y)!($GET(Y)[" ")!($GET(Y)[".")
Begin DoDot:2
+8 SET DIR(0)="FO^"
SET DIR("A")="Which field(s) would you like to edit? ("_LOW_"-"_HIGH_") or 'A'll"
+9 SET DIR("?")="Enter a number, range, or a list of numbers (i.e. 3, 1-5, 3,7,9, or 'A'll)"
+10 SET DIR("B")="A"
+11 DO ^DIR
KILL DIR
+12 IF Y="^"
SET DONE=1
QUIT
End DoDot:2
+13 IF SBN']""
IF Y["-"
IF Y[","
Begin DoDot:2
+14 WRITE !!,"Invalid Response."
+15 WRITE !,"Answer must be numeric (1-10), a series of numbers (3,5,7), 'A' or 'ALL'."
+16 SET DIR(0)="E"
DO ^DIR
KILL Y,DIR
End DoDot:2
QUIT
+17 IF SBN']""
IF (Y[".")!(Y[" ")
Begin DoDot:2
+18 WRITE !!,"Invalid Response."
+19 WRITE !,"Answer must be numeric (1-10), a series of numbers (3,5,7), 'A' or 'ALL'."
+20 SET DIR(0)="E"
DO ^DIR
KILL DIR
+21 IF Y'[" "
KILL Y
End DoDot:2
QUIT
+22 IF SBN]""
IF '$DATA(Y)
SET Y=SBN
+23 if Y["."
QUIT
+24 IF Y="^"
SET DONE=1
QUIT
+25 SET Y=$$UP^XLFSTR(Y)
+26 IF Y="A"!(Y="ALL")
Begin DoDot:2
+27 FOR I=LOW:1:HIGH
Begin DoDot:3
+28 SET EDIT(I)=""
End DoDot:3
+29 SET DONE=1
End DoDot:2
QUIT
+30 ; check for a range or list of numbers
+31 IF Y'["-"
IF Y'[","
IF Y'<LOW
IF Y'>HIGH
SET EDIT(+Y)=""
SET DONE=1
QUIT
+32 IF Y?1.2N1"-"1.2N
Begin DoDot:2
+33 FOR I=$PIECE(Y,"-"):1:$PIECE(Y,"-",2)
Begin DoDot:3
+34 if I<LOW!(I>HIGH)
QUIT
+35 SET EDIT(I)=""
End DoDot:3
End DoDot:2
+36 IF $DATA(EDIT)
SET DONE=1
QUIT
+37 IF Y[","
Begin DoDot:2
+38 ; check to see if there are alpha-numerics if there are, quit and reprompt
+39 SET NUMCHK=$TRANSLATE(Y,",","")
IF 'NUMCHK
WRITE !,"Invalid response."
QUIT
+40 SET DONE2=0
+41 FOR NUM=1:1
Begin DoDot:3
+42 SET VAL=$PIECE(Y,",",NUM)
+43 IF 'VAL
SET DONE2=1
QUIT
+44 IF VAL<LOW!(VAL>HIGH)
QUIT
+45 SET EDIT(VAL)=""
End DoDot:3
if DONE2
QUIT
End DoDot:2
+46 IF $DATA(EDIT)
SET DONE=1
QUIT
+47 WRITE !,"Invalid Response."
+48 WRITE !,"Answer must be numeric (1-10), a series of numbers (3,5,7), 'A' or 'ALL'."
+49 SET DIR(0)="E"
DO ^DIR
KILL Y,DIR
End DoDot:1
if DONE
QUIT
+50 QUIT
+51 ; validate patient
VPAT ;
+1 NEW ERXPIEN,VAPIEN,MANVAL,ERXLNAME,ERXFNAME,DIR,Y,PSOIENS,VAPIEN,MANVAL,DIR,DIC,SELPAT,PDONE,DFN,I,VADM
+2 NEW ERXSTAT,RESTYPE,MTYPE
+3 SET PSOIENS=PSOIEN_","
+4 SET ERXPIEN=$$GET1^DIQ(52.49,PSOIEN,.04,"I")
+5 SET ERXLNAME=$$GET1^DIQ(52.46,ERXPIEN,.02,"E")
+6 SET ERXFNAME=$$GET1^DIQ(52.46,ERXPIEN,.03,"E")
+7 SET VAPIEN=$$GET1^DIQ(52.49,PSOIEN,.05,"I")
+8 SET MANVAL=$$GET1^DIQ(52.49,PSOIEN,1.7,"I")
+9 SET RESTYPE=$$GET1^DIQ(52.49,PSOIEN,52.1)
+10 SET ERXSTAT=$$GET1^DIQ(52.49,PSOIEN,1,"E")
+11 SET MTYPE=$$GET1^DIQ(52.49,PSOIEN,.08,"I")
+12 ; if there is a patient currently defined
+13 IF VAPIEN
Begin DoDot:1
+14 WRITE !,"Current Vista patient: "_$$GET1^DIQ(2,VAPIEN,.01,"E"),!
+15 SET DIR(0)="YO"
SET DIR("A")="Would you like to edit the patient"
+16 SET DIR("A",1)="A patient has already matched to a vista patient."
+17 SET DIR("B")="NO"
DO ^DIR
+18 if Y'=1
QUIT
+19 SET DIC(0)="AEMQ"
SET SELPAT=$$PATPRMT()
KILL DUOUT
if 'SELPAT
QUIT
+20 SET DFN=SELPAT
DO DEM^VADPT
+21 IF $PIECE($GET(VADM(6)),U)]""
WRITE "[PATIENT DIED ON "_$PIECE($GET(VADM(6)),U,2)_"]"
QUIT
+22 SET ERXMMFLG=$$PATWARN("EP",PSOIEN,SELPAT)
+23 SET DIR(0)="Y"
SET DIR("A")="Would you like to use this patient"
+24 SET DIR("A",1)="You have selected patient: "_$$GET1^DIQ(2,SELPAT,.01,"E")
+25 SET DIR("B")=$SELECT($GET(ERXMMFLG):"NO",1:"YES")
DO ^DIR
+26 if Y'=1
QUIT
+27 ; change existing entry
+28 SET FDA(52.49,PSOIENS,.05)=SELPAT
+29 IF SELPAT'=VAPIEN
Begin DoDot:2
+30 ;Setting the eRx Audit Log
+31 NEW NEWVAL
SET NEWVAL(1)=$$GET1^DIQ(2,SELPAT,.01)_" (L4SSN: "_$PIECE($PIECE(VADM(2),"^",2),"-",3)_" | DOB: "_$PIECE(VADM(3),"^",2)_")"
+32 DO AUDLOG^PSOERXUT(PSOIENS,"PATIENT",DUZ,.NEWVAL)
+33 ;Updating eRx Record w/ New Patient
+34 SET FDA(52.49,PSOIENS,1.7)=""
SET FDA(52.49,PSOIENS,1.13)=""
SET FDA(52.49,PSOIENS,1.14)=""
+35 DO FILE^DIE(,"FDA")
KILL FDA
+36 ;Updating eRx Status to In Progress
+37 IF MTYPE="N"
DO UPDSTAT^PSOERXU1(PSOIEN,"I")
+38 IF MTYPE="RE"
DO UPDSTAT^PSOERXU1(PSOIEN,"RXI")
+39 IF MTYPE="CX"
DO UPDSTAT^PSOERXU1(PSOIEN,"CXI")
End DoDot:2
QUIT
+40 IF MTYPE="RE"
DO UPDSTAT^PSOERXU1(PSOIEN,"RXI")
+41 IF MTYPE="CX"
DO UPDSTAT^PSOERXU1(PSOIEN,"CXI")
+42 IF ERXSTAT="N"
DO UPDSTAT^PSOERXU1(PSOIEN,"I")
End DoDot:1
QUIT
+43 SET DIC(0)="AEMQ"
SET SELPAT=$$PATPRMT()
KILL DUOUT
IF 'SELPAT
SET XQORM("B")="Edit"
QUIT
+44 SET DFN=SELPAT
DO DEM^VADPT
+45 IF $PIECE($GET(VADM(6)),U)]""
WRITE "[PATIENT DIED ON "_$PIECE($GET(VADM(6)),U,2)_"]"
SET DIR(0)="E"
DO ^DIR
KILL DIR
QUIT
+46 SET ERXMMFLG=$$PATWARN("EP",PSOIEN,SELPAT)
+47 SET DIR(0)="Y"
SET DIR("A")="Would you like to use this patient"
+48 SET DIR("A",1)="You have selected patient: "_$$GET1^DIQ(2,SELPAT,.01,"E")
+49 SET DIR("B")=$SELECT($GET(ERXMMFLG):"NO",1:"YES")
DO ^DIR
+50 IF Y'=1
SET XQORM("B")="Edit"
QUIT
+51 ;Setting the eRx Audit Log
+52 NEW NEWVAL
SET NEWVAL(1)=$$GET1^DIQ(2,SELPAT,.01)_" (L4SSN: "_$PIECE($PIECE(VADM(2),"^",2),"-",3)_" | DOB: "_$PIECE(VADM(3),"^",2)_")"
+53 DO AUDLOG^PSOERXUT(PSOIEN,"PATIENT",DUZ,.NEWVAL)
+54 ;Saving Patient
+55 SET FDA(52.49,PSOIENS,.05)=SELPAT
+56 DO FILE^DIE(,"FDA")
KILL FDA
+57 ;Updating eRx Status to In Progress
+58 IF MTYPE="CX"
DO UPDSTAT^PSOERXU1(PSOIEN,"CXI")
+59 IF MTYPE="RE"
DO UPDSTAT^PSOERXU1(PSOIEN,"RXI")
+60 IF ERXSTAT="N"
DO UPDSTAT^PSOERXU1(PSOIEN,"I")
+61 QUIT
PATWARN(ACTION,PSOIEN,SELPAT) ; Check whether the Patient Select is valid or not
+1 ; Input:(r)ACTION - Ation being peformed ("EP": Edit Patient | "VP": Validate Patient)
+2 ; (r)PSOIEN - Pointer to the ERX HOLDING QUEUE file (#52.49)
+3 ; (r)SELPAT - Patient -Pointer to the PATIENT file (#2)
+4 ;Output: 1 - No Issues Found with Patient Selected | 2 - Issues Found With Patient selected but Ok to proceed | 0 - Invalid Patient Selection
+5 NEW ERXPIEN,ERXSSN,ERXDOB,ERXGEN,ERXMMFLG,ERXMSG,EXPRVDEA,ERXCNT,I,VADM
+6 SET ERXCNT=0
SET ERXMMFLG=1
+7 SET ERXPIEN=$$GET1^DIQ(52.49,PSOIEN,.04,"I")
+8 SET ERXSSN=$$GET1^DIQ(52.46,ERXPIEN,1.4,"E")
SET ERXSSN=$TRANSLATE(ERXSSN,"-","")
+9 SET ERXDOB=$$GET1^DIQ(52.46,ERXPIEN,.08,"I")
+10 SET ERXGEN=$$GET1^DIQ(52.46,ERXPIEN,.07,"I")
+11 ; if the selected patient is not defined, use the va matched patient because we are doing this check
+12 ; during accept validation
+13 IF '$GET(SELPAT)
SET SELPAT=$$GET1^DIQ(52.49,PSOIEN,.05,"I")
if '$GET(SELPAT)
QUIT 0
+14 SET DFN=SELPAT
DO DEM^VADPT
+15 IF ERXSSN
IF '$DATA(^DPT("SSN",ERXSSN,SELPAT))
SET ERXMMFLG=2
SET ERXCNT=ERXCNT+1
SET ERXMSG(ERXCNT)="SSN mismatch."
+16 IF ERXDOB
IF '$DATA(^DPT("ADOB",ERXDOB,SELPAT))
SET ERXMMFLG=2
SET ERXCNT=ERXCNT+1
SET ERXMSG(ERXCNT)="Date of Birth mismatch."
+17 IF ERXGEN]""
IF $PIECE($GET(VADM(5)),U)'=ERXGEN
SET ERXMMFLG=2
SET ERXCNT=ERXCNT+1
SET ERXMSG(ERXCNT)="Gender mismatch."
+18 ; Warning/Block for Patient w/out valid Address (CS prescriptions only)
+19 IF $$GET1^DIQ(52.49,ERXIEN,95.1,"I")
IF '$$VALPTADD^PSOERXUT(SELPAT)
Begin DoDot:1
+20 SET ERXMMFLG=1
SET ERXCNT=ERXCNT+1
SET ERXMSG(ERXCNT)="Patient does not have a current mailing or residential address on file."
+21 SET ERXMMFLG=$SELECT(ACTION="EP":2,1:0)
End DoDot:1
+22 ;
+23 IF $ORDER(ERXMSG(0))
Begin DoDot:1
+24 WRITE !!,"*******************************",$SELECT(ERXMMFLG:" WARNING(S) ",1:"INVALID PATIENT"),"*******************************"
+25 SET I=0
FOR
SET I=$ORDER(ERXMSG(I))
if 'I
QUIT
Begin DoDot:2
+26 WRITE !,$GET(ERXMSG(I))
End DoDot:2
+27 WRITE !,"*****************************************************************************"
End DoDot:1
+28 ;
+29 QUIT ERXMMFLG
+30 ;
PATPRMT() ;
+1 NEW Y
+2 DO ^DPTLK
+3 IF $PIECE(Y,U)<1
QUIT 0
+4 QUIT $PIECE(Y,U)
