PSOVER ;BIR/SAB-verify rx's by clerk ;09-Oct-2008 11:17;SM
;;7.0;OUTPATIENT PHARMACY;**16,21,27,117,131,146,1004,1007**;DEC 1997
;External references L, UL, PSOL, and PSOUL^PSSLOCK supported by DBIA 2789
;External reference to ^PS(56 supported by DBIA 2229
; Modified - IHS/CIA/PLS - 03/03/06 - Line PACK+2
; IHS/MSC/PLS - 07/02/08 - New EP PAT1
D:'$D(PSOPAR) ^PSOLSET I '$D(PSOPAR) W $C(7),!!,"Pharmacy Division Must be Selected!",! Q
Q:'$D(^XUSEC("PSORPH",DUZ)) S PSOZVER=1
PAT K PSOTT,PSOACT,PSOVER,PSOQUIT W !! S DIC("A")="Enter PATIENT NAME (or ^C to verify for a clerk): ",DIC="^DPT(",DIC("S")="I $D(^PS(52.4,""C"",+Y))",DIC(0)="QEAMZ" D ^DIC K DIC G CLERK:$E(X,1,2)="^C",END:Y'>0
S PSONV=0,(DFN,PSDFN,PSODFN)=+Y,PPL="",PSONAM=$P(^DPT(PSDFN,0),"^") D ^PSOBUILD
L1 D PID^VADPT S PSONV=$O(^PS(52.4,"C",PSDFN,PSONV)) I 'PSONV D PACK G PAT
F DGDG=0:0 S DGDG=$O(^PS(52.4,"C",PSDFN,DGDG)) S PSONV=DGDG K PSOSIG,PSOTHER Q:'DGDG!($D(PSOQUIT)) D
.I $D(^PS(52.4,"ADI",DGDG,1)) S PSONV=DGDG D DGDGI Q
.I $D(^PSRX(PSONV,"DRI")) S PSOSIG=1 D DGDGI Q
.D:'$D(^PS(52.4,"ADI",PSONV,1))&('$D(^PSRX(PSONV,"DRI"))) DSPL Q
G QUIT:$D(PSOSD)
Q
PAT1 ; EP - New IHS Patient processing
D:'$D(PSOPAR) ^PSOLSET I '$D(PSOPAR) W $C(7),!!,"Pharmacy Division Must be Selected!",! Q
Q:'$D(^XUSEC("PSORPH",DUZ)) ; User must hold the PSORPH security key
S PSOZVER=1
K PSOTT,PSOACT,PSOVER,PSOQUIT,PSOVERA
W !! S DIC("A")="Enter PATIENT NAME (or ^C to verify for a clerk): ",DIC="^DPT(",DIC("S")="I $D(^PS(52.4,""C"",+Y))",DIC(0)="QEAMZ" D ^DIC K DIC G CLERK:$E(X,1,2)="^C",END:Y'>0
S PSONV=0,(DFN,PSDFN,PSODFN)=+Y,PPL="",PSONAM=$P(^DPT(PSDFN,0),"^") D ^PSOBUILD
D PID^VADPT S PSONV=$O(^PS(52.4,"C",PSDFN,PSONV)) I 'PSONV D PACK G PAT
; Loop through prescriptions for the patient
; Lock patient
S PSOPLCK=$$L^PSSLOCK(PSDFN,0) I '$G(PSOPLCK) D LOCK^PSOORCPY Q
F DGDG=0:0 S DGDG=$O(^PS(52.4,"C",PSDFN,DGDG)) S PSONV=DGDG K PSOSIG,PSOTHER Q:'DGDG!($D(PSOQUIT)) D
.D LRX Q:'$G(PSOMSG) K PSOMSG
.I $D(^PS(52.4,"ADI",DGDG,1)) S PSONV=DGDG D DGDGI D PSOUL^PSSLOCK(PSONV) Q
.I $D(^PSRX(PSONV,"DRI")) S PSOSIG=1 D DGDGI D PSOUL^PSSLOCK(PSONV) Q
.D:'$D(^PS(52.4,"ADI",PSONV,1))&('$D(^PSRX(PSONV,"DRI"))) DSPL D PSOUL^PSSLOCK(PSONV) Q
D PACK
G QUIT:$D(PSOSD)
G PAT1
;
SHOW I '$D(PSOSD) W !,$C(7),"This patient has no prescriptions on file",!! Q
D ^PSODSPL Q
;
CLERK D:'$D(PSOPAR) ^PSOLSET I '$D(PSOPAR) W $C(7),!!,"Pharmacy Division Must be Selected!",! G END
K PSOVERPL,PSOVERPX,PSOVERPH,PSOVERLX
; IHS/MSC/PLS - 07/10/08
;K PSOQUIT,PSOCQ S PSOCLK=1 W ! S DIC="^VA(200,",DIC(0)="AEQM",DIC("S")="I $D(^PS(52.4,""D"",+Y))",DIC("A")="Enter Clerk Name: " D ^DIC K DIC K:Y'>0!($D(DTOUT)) PSORX G END:Y'>0!($D(DTOUT)) S PSOTT=+Y,(PSONV,PSDFN0)=0,PPL="" K PSOVER,PSONAM
K PSOQUIT,PSOCQ S PSOCLK=1
W ! S DIC="^VA(200,",DIC(0)="AEQM",DIC("S")="I $D(^PS(52.4,""D"",+Y))",DIC("A")="Enter Clerk Name: " D ^DIC
K DIC K:Y'>0!($D(DTOUT)) PSORX G END:Y'>0!($D(DTOUT)) S PSOTT=+Y,(PSONV,PSDFN0)=0,PPL="" K PSOVER,PSONAM,PSOVERA
CL1 F DGDG=0:0 S DGDG=$O(^PS(52.4,"D",PSOTT,DGDG)) Q:'DGDG!($D(PSOQUIT))!($G(PSOCQ)) S (DFN,PSOVERPX,PSDFN,PSODFN)=$P(^PS(52.4,DGDG,0),"^",2),PSONV=DGDG D PATCHK K PSOSIG,PSOTHER S CLFLAG=1 D STAT^PSODGDG2 K CLFLAG D:'$G(FLAGST)
.S PSONVXX=PSONV
.I $G(PSOVERPH)=$G(PSOVERPX),$G(PSOVERLX) Q
.I $G(PSOVERPH)'=$G(PSOVERPX) K PSOVERLX D:$G(PSOVERPH)&('$G(PSOVERPL)) ULP S PSOVERPH=PSOVERPX D LPAT I $G(PSOVERPL) Q
.S PSDFN0=PSDFN
.D LRX I '$G(PSOMSG) Q
.K PSOMSG I $D(^PS(52.4,"ADI",DGDG,1)) S PSONV=DGDG D DGDGI D PSOUL^PSSLOCK(PSONVXX) Q
.I $D(^PSRX(PSONV,"DRI")) S PSOSIG=1 D DGDGI D PSOUL^PSSLOCK(PSONVXX) Q
.D:'$D(^PS(52.4,"ADI",PSONV,1))&('$D(^PSRX(PSONV,"DRI"))) DSPL D PSOUL^PSSLOCK(PSONVXX) Q
D:$G(PSOVERPH)&('$G(PSOVERPL)) ULP
CL2 D PACK G CLERK
PATCHK ;I $D(PSOVER),PSDFN0,PSDFN0'=DFN S (DFN,PSDFN)=PSDFN0 D PACK S (DFN,PSDFN)=PSODFN D ^PSOBUILD,PID^VADPT S PSONAM=$P(^DPT(DFN,0),"^") Q
I $D(PSOVERA),PSDFN0,PSDFN0'=DFN S (DFN,PSDFN)=PSDFN0 D PACK S (DFN,PSDFN)=PSODFN D ^PSOBUILD,PID^VADPT S PSONAM=$P(^DPT(DFN,0),"^") Q ;IHS/MSC/PLS - 07/10/08
I PSDFN0'=DFN D ^PSOBUILD,PID^VADPT S PSONAM=$P(^DPT(DFN,0),"^")
Q
PACK ;S PPL="" F J=0:0 S J=$O(PSOVER(J)) Q:'J S PPL=PPL_J_"," ;IHS/MSC/PLS - 07/10/08
S PPL="" F J=0:0 S J=$O(PSOVERA(J)) Q:'J S PPL=PPL_J_","
; IHS/CIA/PLS - 03/03/06 - Added next line so that autorelease would support verification
N PSOFROM S PSOFROM="NEW"
I PPL]"" S PSOOPT=3,PSOTRVV=1 D ^PSORXL K PSOOPT,PSOTRVV
;IHS/MSC/PLS - 07/10/08
;K PSD,PSOVER S PPL="" Q
K PSD,PSOVERA S PPL="" Q
QUIT D PACK
END K CAN,CLS,DA,DEA1,DEA2,DIC,DIE,DR,DRG,DRGG,DUP,DUPRX,DUPRX0,FLDT,I,ISDT,ISSD,J,LSTFL,PHYS,PPL,PSC,PSD,PSDFN,PSDFN0,PSDNEW,PSDOLD,PSMSG,PSONV,PSOQUIT,PSOTT,PSOVER,PSREA,PSRFLS,PSRX,PSRX1,PSRX2,PSRXREF,PSVERFLG,RFLS,RX0,RX2,RX3,ST,ST0,STAR,X,Y
K D0,DQ,N,PHY,RFL,PSI,PSOTHER,PSS,PSOZVER,PI,PTST,SD,PSONAM,PSONULN,RFDATE,RFL1,RXF,Z,DRUG,II,RFLL,DRGX,DIPGM,PSOCNT,A1,C,ST00,FLAGST,STEXT,PSOCLK,PSOCQ,PSOVERPL,PSOVERPX,PSOVERPH,PSOVERLX,VERLFLAG,PSONVXX D KVA^VADPT
K PSOVERA ;IHS/MSC/PLS - 07/10/08
K PSONOOR,PSOSIG,DIR,DUOUT,DTOUT,DIRUT,DIROUT,INA,MED,SER1 K:'$G(POERR) PSOSD Q
DSPL Q:$P(^PSRX(PSONV,"STA"),"^")=13
S DA=PSONV I $P($G(^PSRX(DA,"PKI")),"^") N PKI,PKI1,PKIR,PKIE D CER^PSOPKIV1
D ^PSORXPR W !,"PATIENT STATUS : ",$P(^PS(53,$P(^PSRX(DA,0),"^",3),0),"^") W:+$P(^PSRX(DA,0),"^",18)'=0 ?42,"COPIES : ",$P(^(0),"^",18) W:$D(^PSRX(DA,"MP")) !,"METHOD OF PICKUP : ",^("MP"),!
S PSVFLAG=1 D ^PSOVER1 K PSVFLAG
Q
DGDGI ;process drug interaction for non verified rxs
S SER1=$S('$G(PSOSIG):$P(^PS(52.4,PSONV,0),"^",9),1:$P(^PSRX(PSONV,"DRI"),"^"))
S MED=$S('$G(PSOSIG):$P(^PS(52.4,PSONV,0),"^",10),1:$P(^PSRX(PSONV,"DRI"),"^",2))
K LOCKARRY,PSOVMSGX S VERLFLAG=0 I $G(MED) F LOCKINA=1:1 S PSOLKVRX=$P(MED,",",LOCKINA) Q:$G(PSOLKVRX)=""!($G(VERLFLAG)) D LK1
I $G(MED) I $G(VERLFLAG) D:$D(LOCKARRY) ULK1 W !!,"Cannot process this prescription, one of the interacting medications is",!,"being edited.",! D K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR,PSOVMSGX G DONEX
.I $G(PSOVMSGX)'="" W PSOVMSGX,!
K PSOVMSGX
S PSVERFLG=0,IFN=PSONV,INT=^PSRX(IFN,0) F INA=1:1 S PSODFN=DFN Q:$P(SER1,",",INA)=""!($G(MED)="") S SER=^PS(56,$P(SER1,",",INA),0),RX=^PSRX($P(MED,",",INA),0),STA=+$G(^("STA")),$P(RX,"^",15)=STA S PSOOPT=1 D:STA'=13 PROCESS^PSODGDG1
I 'PSVERFLG I $P(^PSRX(PSONV,"STA"),"^")=4!($P(^("STA"),"^")=1) S $P(^PSRX(PSONV,"STA"),"^")=1 D DSPL G DONE
I '$D(^PS(52.4,"ADI",PSONV,1)),$P(^PSRX(PSONV,"STA"),"^")=1 D DSPL G DONE
I 'PSVERFLG,$P(^PSRX(PSONV,"STA"),"^")=1 D DSPL
DONE I $P(^PSRX(PSONV,"STA"),"^")'=1,$P(^("STA"),"^")'=4 K ^PSRX(PSONV,"DRI")
S PSOTHER="" F S PSOTHER=$O(PSOTHER(PSOTHER)) Q:PSOTHER="" D
.I $G(PSOTHER),$P($G(^PSRX(PSOTHER,"STA")),"^")=1,$P($G(^PS(52.4,PSOTHER,0)),"^",10)="" S PSONV=PSOTHER D DSPL
D:$D(LOCKARRY) ULK1
DONEX K PSOOPT,SER,LOCKARRY,LOCKINA,PSOLKVRX Q
OERR ;K PSONOOR,PSOVER I $G(PSONACT) W $C(7),$C(7) S VALMSG="No Pharmacy Orderable Item!",VALMBCK="" Q
K PSONOOR,PSOVER,PSOVERA I $G(PSONACT) W $C(7),$C(7) S VALMSG="No Pharmacy Orderable Item!",VALMBCK="" Q ;IHS/MSC/PLS - 07/10/08
I $G(PSOTPBFG) N PSOTPPEN,PSOTPPEX,PSOTPPE9 S PSOTPPEN=$P(PSOLST($P(PSLST,",",ORD)),"^",2),PSOTPPEX=0,PSOTPPE9=1 D VOPN^PSOTPCAN I PSOTPPEX S VALMBCK="" K PSOTPPEN,PSOTPPEX,PSOTPPE9 Q
K PSOTPPEN,PSOTPPEX,PSOTPPE9
I $G(PSOBEDT) W $C(7),$C(7) S VALMSG="Invalid Action at this time !",VALMBCK="" Q
I '$D(^XUSEC("PSORPH",DUZ)) S VALMSG="Unauthorized Action!",VALMBCK="" Q
S PSOVRXN=$P(PSOLST($P(PSLST,",",ORD)),"^",2),PSOVDFN=$P($G(^PSRX(PSOVRXN,0)),"^",2)
S PSOPLCK=$$L^PSSLOCK(PSOVDFN,0) I '$G(PSOPLCK) S VALMSG=$S($P($G(PSOPLCK),"^",2)'="":$P($G(PSOPLCK),"^",2)_" is working on this patient.",1:"Another person is editing orders for this patient.") S VALMBCK="" K PSOPLCK Q
K PSOPLCK D PSOL^PSSLOCK(PSOVRXN) I '$G(PSOMSG) D UL^PSSLOCK(PSOVDFN) S VALMSG=$S($P($G(PSOMSG),"^",2)'="":$P($G(PSOMSG),"^",2),1:"Another person is editing this order.") K PSOMSG S VALMBCK="" Q
N PSODFN S (PSOZVER,PSLSTVER)=1
D FULL^VALM1 S (PSONV,X,DA)=$P(PSOLST($P(PSLST,",",ORD)),"^",2) K DIC S DIC(0)="NZ",DIC=52.4 D ^DIC K DIC I Y<1 D D:'$G(PSLSTVER) ULB Q:'$G(PSLSTVER)
.I $P($G(^PSRX(+PSONV,"STA")),"^")'=1,$P($G(^("STA")),"^")'=4 K PSONV,DA,X,Y,PSOZVER,PSLSTVER S VALMSG="Invalid Action Selection!",VALMBCK="" Q
.S PSLSTVER=2
.S DIC="^PS(52.4,",DLAYGO=52.4,(DINUM,X)=PSONV,DIC(0)="L" K DD,DO D FILE^DICN K DD,DO,DIC,DINUM,DLAYGO
.S ^PS(52.4,PSONV,0)=PSONV_"^"_$P(^PSRX(PSONV,0),"^",2)_"^"_+$P(^(0),"^",16)_"^^"_$E($P($G(^(2)),"^"),1,7)_"^"_PSONV_"^"_$E($P($G(^(2)),"^",6),1,7)
.S DIK="^PS(52.4,",DA=PSONV D IX^DIK K DIK S Y(0)=^PS(52.4,PSONV,0),(X,DA)=PSONV
D STAT^PSODGDG2 G:FLAGST EOJ
N LST S (DFN,PSDFN,PSODFN)=$P(Y(0),"^",2),PPL="",PSONAM=$P(^DPT(PSDFN,0),"^")
D PID^VADPT I $D(^PS(52.4,"ADI",PSONV,1)) D DGDGI G:$G(VERLFLAG) EOJ G PPL
I $D(^PSRX(PSONV,"DRI")) S PSOSIG=1 D DGDGI G:$G(VERLFLAG) EOJ G PPL
D:'$D(^PS(52.4,"ADI",PSONV,1))&('$D(^PSRX(PSONV,"DRI"))) DSPL
PPL I $G(PSLSTVER)=2,$D(^PS(52.4,PSONV,0)) S DA=PSONV,DIK="^PS(52.4," D ^DIK K DIK,DA
; IHS/MSC/PLS - 07/10/08 - NEXT FOUR LINES
;G EOJ:'$O(PSOVER(0))
G EOJ:'$O(PSOVERA(0))
;S PSONVLP="" F S PSONVLP=$O(PSOVER(PSONVLP)) Q:PSONVLP="" D
S PSONVLP="" F S PSONVLP=$O(PSOVERA(PSONVLP)) Q:PSONVLP="" D
.D MARKV^PSOTPCAN
.I $G(PSORX("PSOL",1))']"" S PSORX("PSOL",1)=PSONVLP_"," Q
.F PSOX1=0:0 S PSOX1=$O(PSORX("PSOL",PSOX1)) Q:'PSOX1 S PSOX2=PSOX1
.I $L(PSORX("PSOL",PSOX2))+$L(PSONVLP)<220 S PSORX("PSOL",PSOX2)=PSORX("PSOL",PSOX2)_PSONVLP_","
.E S PSORX("PSOL",PSOX2+1)=PSONVLP_","
EOJ D ULB,END K D,DGDG,MW,PSONVLP,P,PCOMX,PDA,PSPRXN,RX,PSD,PSOSTA,PSLSTVER
L -^PSRX($P(PSOLST(ORN),"^",2))
Q
LPAT ;
K PSOVERPL
I '$G(PSOVERPX) Q
S PSOPLCK=$$L^PSSLOCK(PSOVERPX,0) I '$G(PSOPLCK) D LOCK^PSOORCPY S (PSOVERPL,PSOVERLX)=1
K PSOPLCK
Q
ULP ;
I '$G(PSOVERPH) Q
D UL^PSSLOCK(PSOVERPH) K PSOVERPH
Q
LRX ;
K PSOMSG I '$G(PSONV) Q
D PSOL^PSSLOCK(PSONV) I '$G(PSOMSG) W !!,$S($P($G(PSOMSG),"^",2)'="":$P($G(PSOMSG),"^",2),1:"Another person is editing this order."),! D K DIR S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR K DIR
.I $G(PSDFN) W "for patient "_$P($G(^DPT(PSDFN,0)),"^")_".",!
Q
ULRX ;
I '$G(PSONV) Q
D PSOUL^PSSLOCK(PSONV)
Q
LK1 ;
I '$G(PSOLKVRX) Q
D PSOL^PSSLOCK(PSOLKVRX) I '$G(PSOMSG) S VERLFLAG=1,PSOVMSGX=$P($G(PSOMSG),"^",2) Q
S LOCKARRY(PSOLKVRX)=PSOLKVRX
Q
ULK1 ;
I '$D(LOCKARRY) Q
S PSOVOLK="" F S PSOVOLK=$O(LOCKARRY(PSOVOLK)) Q:$G(PSOVOLK)="" D PSOUL^PSSLOCK(PSOVOLK)
K PSOVOLK
Q
ULB ;
I $G(PSOVDFN) D UL^PSSLOCK(PSOVDFN)
I $G(PSOVRXN) D PSOUL^PSSLOCK(PSOVRXN)
K PSOVDFN,PSOVRXN
Q
PSOVER ;BIR/SAB-verify rx's by clerk ;09-Oct-2008 11:17;SM
+1 ;;7.0;OUTPATIENT PHARMACY;**16,21,27,117,131,146,1004,1007**;DEC 1997
+2 ;External references L, UL, PSOL, and PSOUL^PSSLOCK supported by DBIA 2789
+3 ;External reference to ^PS(56 supported by DBIA 2229
+4 ; Modified - IHS/CIA/PLS - 03/03/06 - Line PACK+2
+5 ; IHS/MSC/PLS - 07/02/08 - New EP PAT1
+6 IF '$DATA(PSOPAR)
DO ^PSOLSET
IF '$DATA(PSOPAR)
WRITE $CHAR(7),!!,"Pharmacy Division Must be Selected!",!
QUIT
+7 IF '$DATA(^XUSEC("PSORPH",DUZ))
QUIT
SET PSOZVER=1
PAT KILL PSOTT,PSOACT,PSOVER,PSOQUIT
WRITE !!
SET DIC("A")="Enter PATIENT NAME (or ^C to verify for a clerk): "
SET DIC="^DPT("
SET DIC("S")="I $D(^PS(52.4,""C"",+Y))"
SET DIC(0)="QEAMZ"
DO ^DIC
KILL DIC
IF $EXTRACT(X,1,2)="^C"
GOTO CLERK
IF Y'>0
GOTO END
+1 SET PSONV=0
SET (DFN,PSDFN,PSODFN)=+Y
SET PPL=""
SET PSONAM=$PIECE(^DPT(PSDFN,0),"^")
DO ^PSOBUILD
L1 DO PID^VADPT
SET PSONV=$ORDER(^PS(52.4,"C",PSDFN,PSONV))
IF 'PSONV
DO PACK
GOTO PAT
+1 FOR DGDG=0:0
SET DGDG=$ORDER(^PS(52.4,"C",PSDFN,DGDG))
SET PSONV=DGDG
KILL PSOSIG,PSOTHER
IF 'DGDG!($DATA(PSOQUIT))
QUIT
Begin DoDot:1
+2 IF $DATA(^PS(52.4,"ADI",DGDG,1))
SET PSONV=DGDG
DO DGDGI
QUIT
+3 IF $DATA(^PSRX(PSONV,"DRI"))
SET PSOSIG=1
DO DGDGI
QUIT
+4 IF '$DATA(^PS(52.4,"ADI",PSONV,1))&('$DATA(^PSRX(PSONV,"DRI")))
DO DSPL
QUIT
End DoDot:1
+5 IF $DATA(PSOSD)
GOTO QUIT
+6 QUIT
PAT1 ; EP - New IHS Patient processing
+1 IF '$DATA(PSOPAR)
DO ^PSOLSET
IF '$DATA(PSOPAR)
WRITE $CHAR(7),!!,"Pharmacy Division Must be Selected!",!
QUIT
+2 ; User must hold the PSORPH security key
IF '$DATA(^XUSEC("PSORPH",DUZ))
QUIT
+3 SET PSOZVER=1
+4 KILL PSOTT,PSOACT,PSOVER,PSOQUIT,PSOVERA
+5 WRITE !!
SET DIC("A")="Enter PATIENT NAME (or ^C to verify for a clerk): "
SET DIC="^DPT("
SET DIC("S")="I $D(^PS(52.4,""C"",+Y))"
SET DIC(0)="QEAMZ"
DO ^DIC
KILL DIC
IF $EXTRACT(X,1,2)="^C"
GOTO CLERK
IF Y'>0
GOTO END
+6 SET PSONV=0
SET (DFN,PSDFN,PSODFN)=+Y
SET PPL=""
SET PSONAM=$PIECE(^DPT(PSDFN,0),"^")
DO ^PSOBUILD
+7 DO PID^VADPT
SET PSONV=$ORDER(^PS(52.4,"C",PSDFN,PSONV))
IF 'PSONV
DO PACK
GOTO PAT
+8 ; Loop through prescriptions for the patient
+9 ; Lock patient
+10 SET PSOPLCK=$$L^PSSLOCK(PSDFN,0)
IF '$GET(PSOPLCK)
DO LOCK^PSOORCPY
QUIT
+11 FOR DGDG=0:0
SET DGDG=$ORDER(^PS(52.4,"C",PSDFN,DGDG))
SET PSONV=DGDG
KILL PSOSIG,PSOTHER
IF 'DGDG!($DATA(PSOQUIT))
QUIT
Begin DoDot:1
+12 DO LRX
IF '$GET(PSOMSG)
QUIT
KILL PSOMSG
+13 IF $DATA(^PS(52.4,"ADI",DGDG,1))
SET PSONV=DGDG
DO DGDGI
DO PSOUL^PSSLOCK(PSONV)
QUIT
+14 IF $DATA(^PSRX(PSONV,"DRI"))
SET PSOSIG=1
DO DGDGI
DO PSOUL^PSSLOCK(PSONV)
QUIT
+15 IF '$DATA(^PS(52.4,"ADI",PSONV,1))&('$DATA(^PSRX(PSONV,"DRI")))
DO DSPL
DO PSOUL^PSSLOCK(PSONV)
QUIT
End DoDot:1
+16 DO PACK
+17 IF $DATA(PSOSD)
GOTO QUIT
+18 GOTO PAT1
+19 ;
SHOW IF '$DATA(PSOSD)
WRITE !,$CHAR(7),"This patient has no prescriptions on file",!!
QUIT
+1 DO ^PSODSPL
QUIT
+2 ;
CLERK IF '$DATA(PSOPAR)
DO ^PSOLSET
IF '$DATA(PSOPAR)
WRITE $CHAR(7),!!,"Pharmacy Division Must be Selected!",!
GOTO END
+1 KILL PSOVERPL,PSOVERPX,PSOVERPH,PSOVERLX
+2 ; IHS/MSC/PLS - 07/10/08
+3 ;K PSOQUIT,PSOCQ S PSOCLK=1 W ! S DIC="^VA(200,",DIC(0)="AEQM",DIC("S")="I $D(^PS(52.4,""D"",+Y))",DIC("A")="Enter Clerk Name: " D ^DIC K DIC K:Y'>0!($D(DTOUT)) PSORX G END:Y'>0!($D(DTOUT)) S PSOTT=+Y,(PSONV,PSDFN0)=0,PPL="" K PSOVER,PSONAM
+4 KILL PSOQUIT,PSOCQ
SET PSOCLK=1
+5 WRITE !
SET DIC="^VA(200,"
SET DIC(0)="AEQM"
SET DIC("S")="I $D(^PS(52.4,""D"",+Y))"
SET DIC("A")="Enter Clerk Name: "
DO ^DIC
+6 KILL DIC
IF Y'>0!($DATA(DTOUT))
KILL PSORX
IF Y'>0!($DATA(DTOUT))
GOTO END
SET PSOTT=+Y
SET (PSONV,PSDFN0)=0
SET PPL=""
KILL PSOVER,PSONAM,PSOVERA
CL1 FOR DGDG=0:0
SET DGDG=$ORDER(^PS(52.4,"D",PSOTT,DGDG))
IF 'DGDG!($DATA(PSOQUIT))!($GET(PSOCQ))
QUIT
SET (DFN,PSOVERPX,PSDFN,PSODFN)=$PIECE(^PS(52.4,DGDG,0),"^",2)
SET PSONV=DGDG
DO PATCHK
KILL PSOSIG,PSOTHER
SET CLFLAG=1
DO STAT^PSODGDG2
KILL CLFLAG
IF '$GET(FLAGST)
Begin DoDot:1
+1 SET PSONVXX=PSONV
+2 IF $GET(PSOVERPH)=$GET(PSOVERPX)
IF $GET(PSOVERLX)
QUIT
+3 IF $GET(PSOVERPH)'=$GET(PSOVERPX)
KILL PSOVERLX
IF $GET(PSOVERPH)&('$GET(PSOVERPL))
DO ULP
SET PSOVERPH=PSOVERPX
DO LPAT
IF $GET(PSOVERPL)
QUIT
+4 SET PSDFN0=PSDFN
+5 DO LRX
IF '$GET(PSOMSG)
QUIT
+6 KILL PSOMSG
IF $DATA(^PS(52.4,"ADI",DGDG,1))
SET PSONV=DGDG
DO DGDGI
DO PSOUL^PSSLOCK(PSONVXX)
QUIT
+7 IF $DATA(^PSRX(PSONV,"DRI"))
SET PSOSIG=1
DO DGDGI
DO PSOUL^PSSLOCK(PSONVXX)
QUIT
+8 IF '$DATA(^PS(52.4,"ADI",PSONV,1))&('$DATA(^PSRX(PSONV,"DRI")))
DO DSPL
DO PSOUL^PSSLOCK(PSONVXX)
QUIT
End DoDot:1
+9 IF $GET(PSOVERPH)&('$GET(PSOVERPL))
DO ULP
CL2 DO PACK
GOTO CLERK
PATCHK ;I $D(PSOVER),PSDFN0,PSDFN0'=DFN S (DFN,PSDFN)=PSDFN0 D PACK S (DFN,PSDFN)=PSODFN D ^PSOBUILD,PID^VADPT S PSONAM=$P(^DPT(DFN,0),"^") Q
+1 ;IHS/MSC/PLS - 07/10/08
IF $DATA(PSOVERA)
IF PSDFN0
IF PSDFN0'=DFN
SET (DFN,PSDFN)=PSDFN0
DO PACK
SET (DFN,PSDFN)=PSODFN
DO ^PSOBUILD
DO PID^VADPT
SET PSONAM=$PIECE(^DPT(DFN,0),"^")
QUIT
+2 IF PSDFN0'=DFN
DO ^PSOBUILD
DO PID^VADPT
SET PSONAM=$PIECE(^DPT(DFN,0),"^")
+3 QUIT
PACK ;S PPL="" F J=0:0 S J=$O(PSOVER(J)) Q:'J S PPL=PPL_J_"," ;IHS/MSC/PLS - 07/10/08
+1 SET PPL=""
FOR J=0:0
SET J=$ORDER(PSOVERA(J))
IF 'J
QUIT
SET PPL=PPL_J_","
+2 ; IHS/CIA/PLS - 03/03/06 - Added next line so that autorelease would support verification
+3 NEW PSOFROM
SET PSOFROM="NEW"
+4 IF PPL]""
SET PSOOPT=3
SET PSOTRVV=1
DO ^PSORXL
KILL PSOOPT,PSOTRVV
+5 ;IHS/MSC/PLS - 07/10/08
+6 ;K PSD,PSOVER S PPL="" Q
+7 KILL PSD,PSOVERA
SET PPL=""
QUIT
QUIT DO PACK
END KILL CAN,CLS,DA,DEA1,DEA2,DIC,DIE,DR,DRG,DRGG,DUP,DUPRX,DUPRX0,FLDT,I,ISDT,ISSD,J,LSTFL,PHYS,PPL,PSC,PSD,PSDFN,PSDFN0,PSDNEW,PSDOLD,PSMSG,PSONV,PSOQUIT,PSOTT,PSOVER,PSREA,PSRFLS,PSRX,PSRX1,PSRX2,PSRXREF,PSVERFLG,RFLS,RX0,RX2,RX3,ST,ST0,STAR,X,Y
+1 KILL D0,DQ,N,PHY,RFL,PSI,PSOTHER,PSS,PSOZVER,PI,PTST,SD,PSONAM,PSONULN,RFDATE,RFL1,RXF,Z,DRUG,II,RFLL,DRGX,DIPGM,PSOCNT,A1,C,ST00,FLAGST,STEXT,PSOCLK,PSOCQ,PSOVERPL,PSOVERPX,PSOVERPH,PSOVERLX,VERLFLAG,PSONVXX
DO KVA^VADPT
+2 ;IHS/MSC/PLS - 07/10/08
KILL PSOVERA
+3 KILL PSONOOR,PSOSIG,DIR,DUOUT,DTOUT,DIRUT,DIROUT,INA,MED,SER1
IF '$GET(POERR)
KILL PSOSD
QUIT
DSPL IF $PIECE(^PSRX(PSONV,"STA"),"^")=13
QUIT
+1 SET DA=PSONV
IF $PIECE($GET(^PSRX(DA,"PKI")),"^")
NEW PKI,PKI1,PKIR,PKIE
DO CER^PSOPKIV1
+2 DO ^PSORXPR
WRITE !,"PATIENT STATUS : ",$PIECE(^PS(53,$PIECE(^PSRX(DA,0),"^",3),0),"^")
IF +$PIECE(^PSRX(DA,0),"^",18)'=0
WRITE ?42,"COPIES : ",$PIECE(^(0),"^",18)
IF $DATA(^PSRX(DA,"MP"))
WRITE !,"METHOD OF PICKUP : ",^("MP"),!
+3 SET PSVFLAG=1
DO ^PSOVER1
KILL PSVFLAG
+4 QUIT
DGDGI ;process drug interaction for non verified rxs
+1 SET SER1=$SELECT('$GET(PSOSIG):$PIECE(^PS(52.4,PSONV,0),"^",9),1:$PIECE(^PSRX(PSONV,"DRI"),"^"))
+2 SET MED=$SELECT('$GET(PSOSIG):$PIECE(^PS(52.4,PSONV,0),"^",10),1:$PIECE(^PSRX(PSONV,"DRI"),"^",2))
+3 KILL LOCKARRY,PSOVMSGX
SET VERLFLAG=0
IF $GET(MED)
FOR LOCKINA=1:1
SET PSOLKVRX=$PIECE(MED,",",LOCKINA)
IF $GET(PSOLKVRX)=""!($GET(VERLFLAG))
QUIT
DO LK1
+4 IF $GET(MED)
IF $GET(VERLFLAG)
IF $DATA(LOCKARRY)
DO ULK1
WRITE !!,"Cannot process this prescription, one of the interacting medications is",!,"being edited.",!
Begin DoDot:1
+5 IF $GET(PSOVMSGX)'=""
WRITE PSOVMSGX,!
End DoDot:1
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to continue"
DO ^DIR
KILL DIR,PSOVMSGX
GOTO DONEX
+6 KILL PSOVMSGX
+7 SET PSVERFLG=0
SET IFN=PSONV
SET INT=^PSRX(IFN,0)
FOR INA=1:1
SET PSODFN=DFN
IF $PIECE(SER1,",",INA)=""!($GET(MED)="")
QUIT
SET SER=^PS(56,$PIECE(SER1,",",INA),0)
SET RX=^PSRX($PIECE(MED,",",INA),0)
SET STA=+$GET(^("STA"))
SET $PIECE(RX,"^",15)=STA
SET PSOOPT=1
IF STA'=13
DO PROCESS^PSODGDG1
+8 IF 'PSVERFLG
IF $PIECE(^PSRX(PSONV,"STA"),"^")=4!($PIECE(^("STA"),"^")=1)
SET $PIECE(^PSRX(PSONV,"STA"),"^")=1
DO DSPL
GOTO DONE
+9 IF '$DATA(^PS(52.4,"ADI",PSONV,1))
IF $PIECE(^PSRX(PSONV,"STA"),"^")=1
DO DSPL
GOTO DONE
+10 IF 'PSVERFLG
IF $PIECE(^PSRX(PSONV,"STA"),"^")=1
DO DSPL
DONE IF $PIECE(^PSRX(PSONV,"STA"),"^")'=1
IF $PIECE(^("STA"),"^")'=4
KILL ^PSRX(PSONV,"DRI")
+1 SET PSOTHER=""
FOR
SET PSOTHER=$ORDER(PSOTHER(PSOTHER))
IF PSOTHER=""
QUIT
Begin DoDot:1
+2 IF $GET(PSOTHER)
IF $PIECE($GET(^PSRX(PSOTHER,"STA")),"^")=1
IF $PIECE($GET(^PS(52.4,PSOTHER,0)),"^",10)=""
SET PSONV=PSOTHER
DO DSPL
End DoDot:1
+3 IF $DATA(LOCKARRY)
DO ULK1
DONEX KILL PSOOPT,SER,LOCKARRY,LOCKINA,PSOLKVRX
QUIT
OERR ;K PSONOOR,PSOVER I $G(PSONACT) W $C(7),$C(7) S VALMSG="No Pharmacy Orderable Item!",VALMBCK="" Q
+1 ;IHS/MSC/PLS - 07/10/08
KILL PSONOOR,PSOVER,PSOVERA
IF $GET(PSONACT)
WRITE $CHAR(7),$CHAR(7)
SET VALMSG="No Pharmacy Orderable Item!"
SET VALMBCK=""
QUIT
+2 IF $GET(PSOTPBFG)
NEW PSOTPPEN,PSOTPPEX,PSOTPPE9
SET PSOTPPEN=$PIECE(PSOLST($PIECE(PSLST,",",ORD)),"^",2)
SET PSOTPPEX=0
SET PSOTPPE9=1
DO VOPN^PSOTPCAN
IF PSOTPPEX
SET VALMBCK=""
KILL PSOTPPEN,PSOTPPEX,PSOTPPE9
QUIT
+3 KILL PSOTPPEN,PSOTPPEX,PSOTPPE9
+4 IF $GET(PSOBEDT)
WRITE $CHAR(7),$CHAR(7)
SET VALMSG="Invalid Action at this time !"
SET VALMBCK=""
QUIT
+5 IF '$DATA(^XUSEC("PSORPH",DUZ))
SET VALMSG="Unauthorized Action!"
SET VALMBCK=""
QUIT
+6 SET PSOVRXN=$PIECE(PSOLST($PIECE(PSLST,",",ORD)),"^",2)
SET PSOVDFN=$PIECE($GET(^PSRX(PSOVRXN,0)),"^",2)
+7 SET PSOPLCK=$$L^PSSLOCK(PSOVDFN,0)
IF '$GET(PSOPLCK)
SET VALMSG=$SELECT($PIECE($GET(PSOPLCK),"^",2)'="":$PIECE($GET(PSOPLCK),"^",2)_" is working on this patient.",1:"Another person is editing orders for this patient.")
SET VALMBCK=""
KILL PSOPLCK
QUIT
+8 KILL PSOPLCK
DO PSOL^PSSLOCK(PSOVRXN)
IF '$GET(PSOMSG)
DO UL^PSSLOCK(PSOVDFN)
SET VALMSG=$SELECT($PIECE($GET(PSOMSG),"^",2)'="":$PIECE($GET(PSOMSG),"^",2),1:"Another person is editing this order.")
KILL PSOMSG
SET VALMBCK=""
QUIT
+9 NEW PSODFN
SET (PSOZVER,PSLSTVER)=1
+10 DO FULL^VALM1
SET (PSONV,X,DA)=$PIECE(PSOLST($PIECE(PSLST,",",ORD)),"^",2)
KILL DIC
SET DIC(0)="NZ"
SET DIC=52.4
DO ^DIC
KILL DIC
IF Y<1
Begin DoDot:1
+11 IF $PIECE($GET(^PSRX(+PSONV,"STA")),"^")'=1
IF $PIECE($GET(^("STA")),"^")'=4
KILL PSONV,DA,X,Y,PSOZVER,PSLSTVER
SET VALMSG="Invalid Action Selection!"
SET VALMBCK=""
QUIT
+12 SET PSLSTVER=2
+13 SET DIC="^PS(52.4,"
SET DLAYGO=52.4
SET (DINUM,X)=PSONV
SET DIC(0)="L"
KILL DD,DO
DO FILE^DICN
KILL DD,DO,DIC,DINUM,DLAYGO
+14 SET ^PS(52.4,PSONV,0)=PSONV_"^"_$PIECE(^PSRX(PSONV,0),"^",2)_"^"_+$PIECE(^(0),"^",16)_"^^"_$EXTRACT($PIECE($GET(^(2)),"^"),1,7)_"^"_PSONV_"^"_$EXTRACT($PIECE($GET(^(2)),"^",6),1,7)
+15 SET DIK="^PS(52.4,"
SET DA=PSONV
DO IX^DIK
KILL DIK
SET Y(0)=^PS(52.4,PSONV,0)
SET (X,DA)=PSONV
End DoDot:1
IF '$GET(PSLSTVER)
DO ULB
IF '$GET(PSLSTVER)
QUIT
+16 DO STAT^PSODGDG2
IF FLAGST
GOTO EOJ
+17 NEW LST
SET (DFN,PSDFN,PSODFN)=$PIECE(Y(0),"^",2)
SET PPL=""
SET PSONAM=$PIECE(^DPT(PSDFN,0),"^")
+18 DO PID^VADPT
IF $DATA(^PS(52.4,"ADI",PSONV,1))
DO DGDGI
IF $GET(VERLFLAG)
GOTO EOJ
GOTO PPL
+19 IF $DATA(^PSRX(PSONV,"DRI"))
SET PSOSIG=1
DO DGDGI
IF $GET(VERLFLAG)
GOTO EOJ
GOTO PPL
+20 IF '$DATA(^PS(52.4,"ADI",PSONV,1))&('$DATA(^PSRX(PSONV,"DRI")))
DO DSPL
PPL IF $GET(PSLSTVER)=2
IF $DATA(^PS(52.4,PSONV,0))
SET DA=PSONV
SET DIK="^PS(52.4,"
DO ^DIK
KILL DIK,DA
+1 ; IHS/MSC/PLS - 07/10/08 - NEXT FOUR LINES
+2 ;G EOJ:'$O(PSOVER(0))
+3 IF '$ORDER(PSOVERA(0))
GOTO EOJ
+4 ;S PSONVLP="" F S PSONVLP=$O(PSOVER(PSONVLP)) Q:PSONVLP="" D
+5 SET PSONVLP=""
FOR
SET PSONVLP=$ORDER(PSOVERA(PSONVLP))
IF PSONVLP=""
QUIT
Begin DoDot:1
+6 DO MARKV^PSOTPCAN
+7 IF $GET(PSORX("PSOL",1))']""
SET PSORX("PSOL",1)=PSONVLP_","
QUIT
+8 FOR PSOX1=0:0
SET PSOX1=$ORDER(PSORX("PSOL",PSOX1))
IF 'PSOX1
QUIT
SET PSOX2=PSOX1
+9 IF $LENGTH(PSORX("PSOL",PSOX2))+$LENGTH(PSONVLP)<220
SET PSORX("PSOL",PSOX2)=PSORX("PSOL",PSOX2)_PSONVLP_","
+10 IF '$TEST
SET PSORX("PSOL",PSOX2+1)=PSONVLP_","
End DoDot:1
EOJ DO ULB
DO END
KILL D,DGDG,MW,PSONVLP,P,PCOMX,PDA,PSPRXN,RX,PSD,PSOSTA,PSLSTVER
+1 LOCK -^PSRX($PIECE(PSOLST(ORN),"^",2))
+2 QUIT
LPAT ;
+1 KILL PSOVERPL
+2 IF '$GET(PSOVERPX)
QUIT
+3 SET PSOPLCK=$$L^PSSLOCK(PSOVERPX,0)
IF '$GET(PSOPLCK)
DO LOCK^PSOORCPY
SET (PSOVERPL,PSOVERLX)=1
+4 KILL PSOPLCK
+5 QUIT
ULP ;
+1 IF '$GET(PSOVERPH)
QUIT
+2 DO UL^PSSLOCK(PSOVERPH)
KILL PSOVERPH
+3 QUIT
LRX ;
+1 KILL PSOMSG
IF '$GET(PSONV)
QUIT
+2 DO PSOL^PSSLOCK(PSONV)
IF '$GET(PSOMSG)
WRITE !!,$SELECT($PIECE($GET(PSOMSG),"^",2)'="":$PIECE($GET(PSOMSG),"^",2),1:"Another person is editing this order."),!
Begin DoDot:1
+3 IF $GET(PSDFN)
WRITE "for patient "_$PIECE($GET(^DPT(PSDFN,0)),"^")_".",!
End DoDot:1
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to Continue"
DO ^DIR
KILL DIR
+4 QUIT
ULRX ;
+1 IF '$GET(PSONV)
QUIT
+2 DO PSOUL^PSSLOCK(PSONV)
+3 QUIT
LK1 ;
+1 IF '$GET(PSOLKVRX)
QUIT
+2 DO PSOL^PSSLOCK(PSOLKVRX)
IF '$GET(PSOMSG)
SET VERLFLAG=1
SET PSOVMSGX=$PIECE($GET(PSOMSG),"^",2)
QUIT
+3 SET LOCKARRY(PSOLKVRX)=PSOLKVRX
+4 QUIT
ULK1 ;
+1 IF '$DATA(LOCKARRY)
QUIT
+2 SET PSOVOLK=""
FOR
SET PSOVOLK=$ORDER(LOCKARRY(PSOVOLK))
IF $GET(PSOVOLK)=""
QUIT
DO PSOUL^PSSLOCK(PSOVOLK)
+3 KILL PSOVOLK
+4 QUIT
ULB ;
+1 IF $GET(PSOVDFN)
DO UL^PSSLOCK(PSOVDFN)
+2 IF $GET(PSOVRXN)
DO PSOUL^PSSLOCK(PSOVRXN)
+3 KILL PSOVDFN,PSOVRXN
+4 QUIT
