- PSOVER ;BIR/SAB - verify rx's by clerk ;07/03/95
- ;;7.0;OUTPATIENT PHARMACY;**16,21,27,117,131,146,251,375,387,379,391,372,416,597,617**;DEC 1997;Build 110
- ;External references L, UL, PSOL, and PSOUL^PSSLOCK supported by DBIA 2789
- ;External reference to ^PS(56 supported by DBIA 2229
- 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,PSORX("DFLG"),DTOUT,DIRUT,PSOVQUIT 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:$$GET1^DIQ(52,PSONV,100,"I")'=13 PACK G PAT
- F DGDG=0:0 S DGDG=$O(^PS(52.4,"C",PSDFN,DGDG)) S PSONV=DGDG K PSOSIG,PSOTHER Q:'DGDG!($G(PSOQUIT)) D Q:$G(DIRUT)
- .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)
- ;
- SHOW I '$D(PSOSD) W !,$C(7),"This patient has no prescriptions on file",!! Q
- I ($Y+5)>IOSL D HD^PSODDPR2(5) Q:$G(PSODLQT)
- W !,$P(^DPT(DFN,0),"^"),?40,"ID#:"_VA("PID") W:$D(INT)!$D(PSONV) " RX#: "_$S($D(INT):$P(INT,"^"),$D(^PSRX(PSONV)):$P(^PSRX(PSONV,0),"^"),1:"")
- D ^PSODSPL
- SHOW2 ;
- I ($Y+5)>IOSL D HD^PSODDPR2() Q
- Q:$Y<5
- N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
- K DIR W ! S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
- W @IOF
- Q
- ;
- CLERK D:'$D(PSOPAR) ^PSOLSET I '$D(PSOPAR) W $C(7),!!,"Pharmacy Division Must be Selected!",! G END
- K PSOVERPL,PSOVERPX,PSOVERPH,PSOVERLX,PSOVERQ,PSORX("DFLG"),DIRUT,DTOUT,PSOVQUIT
- K PSOQUIT,PSOCQ,PSOVORD,PSOINTV 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))
- N PSOODOSP S PSOTT=+Y,(PSONV,PSDFN0)=0,PPL="" K PSOVER,PSONAM
- CL1 F DGDG=0:0 S DGDG=$O(^PS(52.4,"D",PSOTT,DGDG)) Q:'DGDG!($G(PSOQUIT))!($G(PSOCQ)) D Q:$D(DIRUT)
- .S PSOVQUIT=0,(DFN,PSOVERPX,PSDFN,PSODFN)=$P(^PS(52.4,DGDG,0),"^",2),PSONV=DGDG D D PATCHK K PSOSIG,PSOTHER
- ..I $G(PSOODOSP)'=DFN S PSOODOSP=DFN K PSORX("DOSING OFF")
- .S CLFLAG=1 D STAT^PSODGDG2 K CLFLAG D:'$G(FLAGST) Q:$D(DIRUT)
- ..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 DSPL D PSOUL^PSSLOCK(PSONVXX) Q
- ..I $D(^PSRX(PSONV,"DRI")) S PSOSIG=1 D DSPL 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:$$GET1^DIQ(52,PSONV,100,"I")'=13 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 PSDFN0'=DFN D ^PSOBUILD,PID^VADPT S PSONAM=$P(^DPT(DFN,0),"^")
- Q
- PACK Q:$$GET1^DIQ(52,PSONV,100,"I")=13 S PPL="" F J=0:0 S J=$O(PSOVER(J)) Q:'J S PPL=PPL_J_","
- I PPL]"" S PSOOPT=3,PSOTRVV=1 D ^PSORXL K PSOOPT,PSOTRVV
- K PSD,PSOVER 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,PSOQUIT,PSOTT,PSOVER,PSREA,PSRFLS,PSRX,PSRX1,PSRX2,PSRXREF,PSVERFLG,RFLS,RX0,RX2,RX3,ST,ST0,STAR,X
- 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 PSONOOR,PSOSIG,DIR,DUOUT,DTOUT,DIRUT,DIROUT,INA,MED,SER1,PSOVORD,PSOINTV,PSOVQUIT,PSVFLAG,PSOOVNOD,PSOOVSTA
- Q
- DSPL ;
- Q:$P(^PSRX(PSONV,"STA"),"^")=13
- S DA=PSONV
- D SAVE
- S PSVFLAG=1 D ^PSOVER1 I $G(PSORX("DFLG")) K PSVFLAG
- Q
- DGDGI ;process drug interaction for non verified rxs
- K DIRUT,DTOUT,PSORX("DFLG")
- S SER1=$S('$G(PSOSIG):$P(^PS(52.4,PSONV,0),"^",9),1:$P(^PSRX(PSONV,"DRI"),"^")),PSVFLAG=1
- 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
- K PSOVMSGX
- S PSVERFLG=0,IFN=PSONV,INT=^PSRX(IFN,0) N PSOOLDFN S PSOOLDFN=DFN
- F INA=1:1 S PSODFN=DFN Q:$P(SER1,",",INA)=""!($G(MED)="") D Q:$G(PSOVQUIT)!$G(PSORX("DFLG"))
- .I $P(SER1,",",INA) S SER=^PS(56,$P(SER1,",",INA),0)
- .E S $P(SER,"^",4)=$S($P(SER1,",",INA)="Critical":1,1:2)
- .S RX=^PSRX(PSONV,0),STA=+$G(^("STA")),$P(RX,"^",15)=STA,PSOOPT=1
- .W !!!,$P(^DPT(DFN,0),"^"),?39,"ID#: ",$E($P(^(0),"^",9),1,3)_"-"_$E($P(^(0),"^",9),4,5)_"-"_$E($P(^(0),"^",9),6,9),?57,"RX: ",$P(^PSRX(PSONV,0),"^")
- .I STA'=13 D FULL^VALM1 D SAVE,^PSOVER1 S:'$G(DFN) DFN=PSOOLDFN
- Q:$G(PSORX("DFLG")) Q:$G(DIRUT)!($G(DTOUT))
- I '$G(PSVERFLG),$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 DONEX:$G(DIRUT)!($G(DTOUT)) G DONE
- DONE ;
- I $P(^PSRX(PSONV,"STA"),"^")=4 S ^PS(52.4,"ADI",PSONV,1)=""
- K PSOVORD 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,DTOUT,DIRUT,PSORX("DFLG"),PSOOVNOD,PSOOVSTA
- Q
- OERR ;
- N PSOEDITF,PSOVEDIT,PSOOORN,XQORNOD,Y,PSOVBCK,INT,PSORXIEN S PSOVEDIT=0
- K PSONOOR,PSODLQT,PSOVER,PSVERFLG,PSOVORD,PSOSIG I $G(PSONACT) W $C(7),$C(7) S VALMSG="No Pharmacy Orderable Item!",VALMBCK="" Q
- 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,PSORX("DFLG")
- I $G(PSOBEDT) W $C(7),$C(7) S VALMSG="Invalid Action at this time !",VALMBCK="" Q
- S PSORXIEN=+$P(PSOLST($P(PSLST,",",ORD)),"^",2)
- I '$D(^PSRX(PSORXIEN,"PKI")),'$D(^XUSEC("PSORPH",DUZ)) S VALMSG="Unauthorized Action!",VALMBCK="" Q
- I $G(^PSRX(PSORXIEN,"PKI"))'="" N FL S FL=0 D I FL Q
- .I $P(^PSRX(PSORXIEN,"PKI"),"^")!$P(^PSRX(PSORXIEN,"PKI"),"^",3),'$D(^XUSEC("PSDRPH",DUZ)) D Q
- ..S VALMSG="Digitally Signed "_$S($P(^PSRX(PSORXIEN,"PKI"),"^",3):"eRx ",1:"")_" Order - PSDRPH key required",VALMBCK="",FL=1
- .I $P($G(^PSRX(PSORXIEN,"PKI")),"^",2),'$D(^XUSEC("PSDRPH",DUZ)) S VALMSG="CS Order - PSDRPH key is required",VALMBCK="",FL=1 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)
- I '$D(^PS(52.4,PSONV,0)) S VALMSG="Invalid Action Selection!",VALMBCK="" Q
- S PSOOVNOD=^PS(52.4,PSONV,0),PSOOVSTA=$P(^PSRX(PSONV,"STA"),"^")
- 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(^PSRX(PSONV,0),"^",2),PPL="",PSONAM=$P(^DPT(PSDFN,0),"^")
- D PID^VADPT S PSOVORD=PSONV
- I $D(^PS(52.4,"ADI",PSONV,1)) D DGDGI G:$G(PSOVQUIT)!$G(PSORX("DFLG")) EOJ G PPL
- I $D(^PSRX(PSONV,"DRI")) S PSOSIG=1 D DGDGI G:$G(PSOVQUIT)!$G(PSORX("DFLG")) EOJ G PPL
- G:$G(PSORX("DFLG")) EOJ D DSPL
- PPL I $G(PSLSTVER)=2,$D(^PS(52.4,PSONV,0)) S DA=PSONV,DIK="^PS(52.4," D ^DIK K DIK,DA
- G EOJ:'$O(PSOVER(0))
- S PSONVLP="" F S PSONVLP=$O(PSOVER(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,PSOVORD,PSVFLAG
- I $G(PSOCLK),$G(PSLST) K PSLST
- I $G(PSOCLK)!($G(PSOPOCK)) D FULL^VALM1 K VALMBCK D ^PSOBUILD,BLD^PSOORUT1 S Y=0 F S Y=$O(PSOLST(Y)) Q:Y="" I $P(PSOLST(Y),"^",2)=PSONV S PSLST=","_Y Q
- I $G(^PSRX(PSONV,"STA"))'=1&($G(^PSRX(PSONV,"STA"))'=4) S VALMBCK="Q" G EOJ2
- I '$G(PSOCLK)!('$G(PSOPOCK)) S VALMBCK="R" S:$G(PSOVBCK) VALMBCK="Q"
- EOJ2 ;
- K PSONV,Y
- 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("?")="Press Return to continue",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
- SAVE ;
- K PSOOVNOD,PSOOVSTA S (PSOOVNOD,PSOOVSTA)="",PSOOVNOD=^PS(52.4,PSONV,0),PSOOVSTA=$P(^PSRX(PSONV,"STA"),"^")
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOVER 10753 printed Jan 18, 2025@03:37:27 Page 2
- PSOVER ;BIR/SAB - verify rx's by clerk ;07/03/95
- +1 ;;7.0;OUTPATIENT PHARMACY;**16,21,27,117,131,146,251,375,387,379,391,372,416,597,617**;DEC 1997;Build 110
- +2 ;External references L, UL, PSOL, and PSOUL^PSSLOCK supported by DBIA 2789
- +3 ;External reference to ^PS(56 supported by DBIA 2229
- +4 if '$DATA(PSOPAR)
- DO ^PSOLSET
- IF '$DATA(PSOPAR)
- WRITE $CHAR(7),!!,"Pharmacy Division Must be Selected!",!
- QUIT
- +5 if '$DATA(^XUSEC("PSORPH",DUZ))
- QUIT
- SET PSOZVER=1
- PAT KILL PSOTT,PSOACT,PSOVER,PSOQUIT,PSORX("DFLG"),DTOUT,DIRUT,PSOVQUIT
- 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
- if $$GET1^DIQ(52,PSONV,100,"I")'=13
- 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!($GET(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
- if $GET(DIRUT)
- QUIT
- +5 if $DATA(PSOSD)
- GOTO QUIT
- +6 ;
- SHOW IF '$DATA(PSOSD)
- WRITE !,$CHAR(7),"This patient has no prescriptions on file",!!
- QUIT
- +1 IF ($Y+5)>IOSL
- DO HD^PSODDPR2(5)
- if $GET(PSODLQT)
- QUIT
- +2 WRITE !,$PIECE(^DPT(DFN,0),"^"),?40,"ID#:"_VA("PID")
- if $DATA(INT)!$DATA(PSONV)
- WRITE " RX#: "_$SELECT($DATA(INT):$PIECE(INT,"^"),$DATA(^PSRX(PSONV)):$PIECE(^PSRX(PSONV,0),"^"),1:"")
- +3 DO ^PSODSPL
- SHOW2 ;
- +1 IF ($Y+5)>IOSL
- DO HD^PSODDPR2()
- QUIT
- +2 if $Y<5
- QUIT
- +3 NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
- +4 KILL DIR
- WRITE !
- SET DIR(0)="E"
- SET DIR("A")="Press Return to continue"
- DO ^DIR
- KILL DIR
- +5 WRITE @IOF
- +6 QUIT
- +7 ;
- 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,PSOVERQ,PSORX("DFLG"),DIRUT,DTOUT,PSOVQUIT
- +2 KILL PSOQUIT,PSOCQ,PSOVORD,PSOINTV
- SET PSOCLK=1
- 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: "
- +3 DO ^DIC
- KILL DIC
- if Y'>0!($DATA(DTOUT))
- KILL PSORX
- if Y'>0!($DATA(DTOUT))
- GOTO END
- +4 NEW PSOODOSP
- SET PSOTT=+Y
- SET (PSONV,PSDFN0)=0
- SET PPL=""
- KILL PSOVER,PSONAM
- CL1 FOR DGDG=0:0
- SET DGDG=$ORDER(^PS(52.4,"D",PSOTT,DGDG))
- if 'DGDG!($GET(PSOQUIT))!($GET(PSOCQ))
- QUIT
- Begin DoDot:1
- +1 SET PSOVQUIT=0
- SET (DFN,PSOVERPX,PSDFN,PSODFN)=$PIECE(^PS(52.4,DGDG,0),"^",2)
- SET PSONV=DGDG
- Begin DoDot:2
- +2 IF $GET(PSOODOSP)'=DFN
- SET PSOODOSP=DFN
- KILL PSORX("DOSING OFF")
- End DoDot:2
- DO PATCHK
- KILL PSOSIG,PSOTHER
- +3 SET CLFLAG=1
- DO STAT^PSODGDG2
- KILL CLFLAG
- if '$GET(FLAGST)
- Begin DoDot:2
- +4 SET PSONVXX=PSONV
- IF $GET(PSOVERPH)=$GET(PSOVERPX)
- IF $GET(PSOVERLX)
- QUIT
- +5 IF $GET(PSOVERPH)'=$GET(PSOVERPX)
- KILL PSOVERLX
- if $GET(PSOVERPH)&('$GET(PSOVERPL))
- DO ULP
- SET PSOVERPH=PSOVERPX
- DO LPAT
- IF $GET(PSOVERPL)
- QUIT
- +6 SET PSDFN0=PSDFN
- DO LRX
- IF '$GET(PSOMSG)
- QUIT
- +7 KILL PSOMSG
- IF $DATA(^PS(52.4,"ADI",DGDG,1))
- SET PSONV=DGDG
- DO DSPL
- DO PSOUL^PSSLOCK(PSONVXX)
- QUIT
- +8 IF $DATA(^PSRX(PSONV,"DRI"))
- SET PSOSIG=1
- DO DSPL
- DO PSOUL^PSSLOCK(PSONVXX)
- QUIT
- +9 if '$DATA(^PS(52.4,"ADI",PSONV,1))&('$DATA(^PSRX(PSONV,"DRI")))
- DO DSPL
- DO PSOUL^PSSLOCK(PSONVXX)
- QUIT
- End DoDot:2
- if $DATA(DIRUT)
- QUIT
- End DoDot:1
- if $DATA(DIRUT)
- QUIT
- +10 if $GET(PSOVERPH)&('$GET(PSOVERPL))
- DO ULP
- CL2 if $$GET1^DIQ(52,PSONV,100,"I")'=13
- DO PACK
- GOTO CLERK
- PATCHK IF $DATA(PSOVER)
- 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
- +1 IF PSDFN0'=DFN
- DO ^PSOBUILD
- DO PID^VADPT
- SET PSONAM=$PIECE(^DPT(DFN,0),"^")
- +2 QUIT
- PACK if $$GET1^DIQ(52,PSONV,100,"I")=13
- QUIT
- SET PPL=""
- FOR J=0:0
- SET J=$ORDER(PSOVER(J))
- if 'J
- QUIT
- SET PPL=PPL_J_","
- +1 IF PPL]""
- SET PSOOPT=3
- SET PSOTRVV=1
- DO ^PSORXL
- KILL PSOOPT,PSOTRVV
- +2 KILL PSD,PSOVER
- 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,PSOQUIT,PSOTT,PSOVER,PSREA,PSRFLS,PSRX,PSRX1,PSRX2,PSRXREF,PSVERFLG,RFLS,RX0,RX2,RX3,ST,ST0,STAR,X
- +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 KILL PSONOOR,PSOSIG,DIR,DUOUT,DTOUT,DIRUT,DIROUT,INA,MED,SER1,PSOVORD,PSOINTV,PSOVQUIT,PSVFLAG,PSOOVNOD,PSOOVSTA
- +3 QUIT
- DSPL ;
- +1 if $PIECE(^PSRX(PSONV,"STA"),"^")=13
- QUIT
- +2 SET DA=PSONV
- +3 DO SAVE
- +4 SET PSVFLAG=1
- DO ^PSOVER1
- IF $GET(PSORX("DFLG"))
- KILL PSVFLAG
- +5 QUIT
- DGDGI ;process drug interaction for non verified rxs
- +1 KILL DIRUT,DTOUT,PSORX("DFLG")
- +2 SET SER1=$SELECT('$GET(PSOSIG):$PIECE(^PS(52.4,PSONV,0),"^",9),1:$PIECE(^PSRX(PSONV,"DRI"),"^"))
- SET PSVFLAG=1
- +3 SET MED=$SELECT('$GET(PSOSIG):$PIECE(^PS(52.4,PSONV,0),"^",10),1:$PIECE(^PSRX(PSONV,"DRI"),"^",2))
- +4 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
- +5 KILL PSOVMSGX
- +6 SET PSVERFLG=0
- SET IFN=PSONV
- SET INT=^PSRX(IFN,0)
- NEW PSOOLDFN
- SET PSOOLDFN=DFN
- +7 FOR INA=1:1
- SET PSODFN=DFN
- if $PIECE(SER1,",",INA)=""!($GET(MED)="")
- QUIT
- Begin DoDot:1
- +8 IF $PIECE(SER1,",",INA)
- SET SER=^PS(56,$PIECE(SER1,",",INA),0)
- +9 IF '$TEST
- SET $PIECE(SER,"^",4)=$SELECT($PIECE(SER1,",",INA)="Critical":1,1:2)
- +10 SET RX=^PSRX(PSONV,0)
- SET STA=+$GET(^("STA"))
- SET $PIECE(RX,"^",15)=STA
- SET PSOOPT=1
- +11 WRITE !!!,$PIECE(^DPT(DFN,0),"^"),?39,"ID#: ",$EXTRACT($PIECE(^(0),"^",9),1,3)_"-"_$EXTRACT($PIECE(^(0),"^",9),4,5)_"-"_$EXTRACT($PIECE(^(0),"^",9),6,9),?57,"RX: ",$PIECE(^PSRX(PSONV,0),"^")
- +12 IF STA'=13
- DO FULL^VALM1
- DO SAVE
- DO ^PSOVER1
- if '$GET(DFN)
- SET DFN=PSOOLDFN
- End DoDot:1
- if $GET(PSOVQUIT)!$GET(PSORX("DFLG"))
- QUIT
- +13 if $GET(PSORX("DFLG"))
- QUIT
- if $GET(DIRUT)!($GET(DTOUT))
- QUIT
- +14 IF '$GET(PSVERFLG)
- IF $PIECE(^PSRX(PSONV,"STA"),"^")=4!($PIECE(^("STA"),"^")=1)
- SET $PIECE(^PSRX(PSONV,"STA"),"^")=1
- DO DSPL
- GOTO DONE
- +15 IF '$DATA(^PS(52.4,"ADI",PSONV,1))
- IF $PIECE(^PSRX(PSONV,"STA"),"^")=1
- DO DSPL
- if $GET(DIRUT)!($GET(DTOUT))
- GOTO DONEX
- GOTO DONE
- DONE ;
- +1 IF $PIECE(^PSRX(PSONV,"STA"),"^")=4
- SET ^PS(52.4,"ADI",PSONV,1)=""
- +2 KILL PSOVORD
- IF $PIECE(^PSRX(PSONV,"STA"),"^")'=1
- IF $PIECE(^("STA"),"^")'=4
- KILL ^PSRX(PSONV,"DRI")
- +3 SET PSOTHER=""
- FOR
- SET PSOTHER=$ORDER(PSOTHER(PSOTHER))
- if PSOTHER=""
- QUIT
- Begin DoDot:1
- +4 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
- +5 if $DATA(LOCKARRY)
- DO ULK1
- DONEX KILL PSOOPT,SER,LOCKARRY,LOCKINA,PSOLKVRX,DTOUT,DIRUT,PSORX("DFLG"),PSOOVNOD,PSOOVSTA
- +1 QUIT
- OERR ;
- +1 NEW PSOEDITF,PSOVEDIT,PSOOORN,XQORNOD,Y,PSOVBCK,INT,PSORXIEN
- SET PSOVEDIT=0
- +2 KILL PSONOOR,PSODLQT,PSOVER,PSVERFLG,PSOVORD,PSOSIG
- IF $GET(PSONACT)
- WRITE $CHAR(7),$CHAR(7)
- SET VALMSG="No Pharmacy Orderable Item!"
- SET VALMBCK=""
- QUIT
- +3 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
- +4 KILL PSOTPPEN,PSOTPPEX,PSOTPPE9,PSORX("DFLG")
- +5 IF $GET(PSOBEDT)
- WRITE $CHAR(7),$CHAR(7)
- SET VALMSG="Invalid Action at this time !"
- SET VALMBCK=""
- QUIT
- +6 SET PSORXIEN=+$PIECE(PSOLST($PIECE(PSLST,",",ORD)),"^",2)
- +7 IF '$DATA(^PSRX(PSORXIEN,"PKI"))
- IF '$DATA(^XUSEC("PSORPH",DUZ))
- SET VALMSG="Unauthorized Action!"
- SET VALMBCK=""
- QUIT
- +8 IF $GET(^PSRX(PSORXIEN,"PKI"))'=""
- NEW FL
- SET FL=0
- Begin DoDot:1
- +9 IF $PIECE(^PSRX(PSORXIEN,"PKI"),"^")!$PIECE(^PSRX(PSORXIEN,"PKI"),"^",3)
- IF '$DATA(^XUSEC("PSDRPH",DUZ))
- Begin DoDot:2
- +10 SET VALMSG="Digitally Signed "_$SELECT($PIECE(^PSRX(PSORXIEN,"PKI"),"^",3):"eRx ",1:"")_" Order - PSDRPH key required"
- SET VALMBCK=""
- SET FL=1
- End DoDot:2
- QUIT
- +11 IF $PIECE($GET(^PSRX(PSORXIEN,"PKI")),"^",2)
- IF '$DATA(^XUSEC("PSDRPH",DUZ))
- SET VALMSG="CS Order - PSDRPH key is required"
- SET VALMBCK=""
- SET FL=1
- QUIT
- End DoDot:1
- IF FL
- QUIT
- +12 IF '$DATA(^XUSEC("PSORPH",DUZ))
- SET VALMSG="Unauthorized Action!"
- SET VALMBCK=""
- QUIT
- +13 SET PSOVRXN=$PIECE(PSOLST($PIECE(PSLST,",",ORD)),"^",2)
- SET PSOVDFN=$PIECE($GET(^PSRX(PSOVRXN,0)),"^",2)
- +14 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
- +15 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
- +16 NEW PSODFN
- SET (PSOZVER,PSLSTVER)=1
- +17 DO FULL^VALM1
- SET (PSONV,X,DA)=$PIECE(PSOLST($PIECE(PSLST,",",ORD)),"^",2)
- +18 IF '$DATA(^PS(52.4,PSONV,0))
- SET VALMSG="Invalid Action Selection!"
- SET VALMBCK=""
- QUIT
- +19 SET PSOOVNOD=^PS(52.4,PSONV,0)
- SET PSOOVSTA=$PIECE(^PSRX(PSONV,"STA"),"^")
- +20 KILL DIC
- SET DIC(0)="NZ"
- SET DIC=52.4
- DO ^DIC
- KILL DIC
- IF Y<1
- Begin DoDot:1
- +21 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
- +22 SET PSLSTVER=2
- +23 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
- +24 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)
- +25 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
- +26 DO STAT^PSODGDG2
- if FLAGST
- GOTO EOJ
- +27 NEW LST
- SET (DFN,PSDFN,PSODFN)=$PIECE(^PSRX(PSONV,0),"^",2)
- SET PPL=""
- SET PSONAM=$PIECE(^DPT(PSDFN,0),"^")
- +28 DO PID^VADPT
- SET PSOVORD=PSONV
- +29 IF $DATA(^PS(52.4,"ADI",PSONV,1))
- DO DGDGI
- if $GET(PSOVQUIT)!$GET(PSORX("DFLG"))
- GOTO EOJ
- GOTO PPL
- +30 IF $DATA(^PSRX(PSONV,"DRI"))
- SET PSOSIG=1
- DO DGDGI
- if $GET(PSOVQUIT)!$GET(PSORX("DFLG"))
- GOTO EOJ
- GOTO PPL
- +31 if $GET(PSORX("DFLG"))
- GOTO EOJ
- 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 if '$ORDER(PSOVER(0))
- GOTO EOJ
- +2 SET PSONVLP=""
- FOR
- SET PSONVLP=$ORDER(PSOVER(PSONVLP))
- if PSONVLP=""
- QUIT
- Begin DoDot:1
- +3 DO MARKV^PSOTPCAN
- +4 IF $GET(PSORX("PSOL",1))']""
- SET PSORX("PSOL",1)=PSONVLP_","
- QUIT
- +5 FOR PSOX1=0:0
- SET PSOX1=$ORDER(PSORX("PSOL",PSOX1))
- if 'PSOX1
- QUIT
- SET PSOX2=PSOX1
- +6 IF $LENGTH(PSORX("PSOL",PSOX2))+$LENGTH(PSONVLP)<220
- SET PSORX("PSOL",PSOX2)=PSORX("PSOL",PSOX2)_PSONVLP_","
- +7 IF '$TEST
- SET PSORX("PSOL",PSOX2+1)=PSONVLP_","
- End DoDot:1
- EOJ DO ULB
- DO END
- +1 KILL D,DGDG,MW,PSONVLP,P,PCOMX,PDA,PSPRXN,RX,PSD,PSOSTA,PSLSTVER,PSOVORD,PSVFLAG
- +2 IF $GET(PSOCLK)
- IF $GET(PSLST)
- KILL PSLST
- +3 IF $GET(PSOCLK)!($GET(PSOPOCK))
- DO FULL^VALM1
- KILL VALMBCK
- DO ^PSOBUILD
- DO BLD^PSOORUT1
- SET Y=0
- FOR
- SET Y=$ORDER(PSOLST(Y))
- if Y=""
- QUIT
- IF $PIECE(PSOLST(Y),"^",2)=PSONV
- SET PSLST=","_Y
- QUIT
- +4 IF $GET(^PSRX(PSONV,"STA"))'=1&($GET(^PSRX(PSONV,"STA"))'=4)
- SET VALMBCK="Q"
- GOTO EOJ2
- +5 IF '$GET(PSOCLK)!('$GET(PSOPOCK))
- SET VALMBCK="R"
- if $GET(PSOVBCK)
- SET VALMBCK="Q"
- EOJ2 ;
- +1 KILL PSONV,Y
- +2 LOCK -^PSRX($PIECE(PSOLST(ORN),"^",2))
- +3 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("?")="Press Return to continue"
- 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
- SAVE ;
- +1 KILL PSOOVNOD,PSOOVSTA
- SET (PSOOVNOD,PSOOVSTA)=""
- SET PSOOVNOD=^PS(52.4,PSONV,0)
- SET PSOOVSTA=$PIECE(^PSRX(PSONV,"STA"),"^")
- +2 QUIT