Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSOVER

PSOVER.m

Go to the documentation of this file. 
  1. 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
  1.  ;External references L, UL, PSOL, and PSOUL^PSSLOCK supported by DBIA 2789
  1.  ;External reference to ^PS(56 supported by DBIA 2229
  1.  ; Modified - IHS/CIA/PLS - 03/03/06 - Line PACK+2
  1.  ;            IHS/MSC/PLS - 07/02/08 - New EP PAT1
  1.  D:'$D(PSOPAR) ^PSOLSET I '$D(PSOPAR) W $C(7),!!,"Pharmacy Division Must be Selected!",! Q
  1.  Q:'$D(^XUSEC("PSORPH",DUZ))  S PSOZVER=1
  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
  1.  S PSONV=0,(DFN,PSDFN,PSODFN)=+Y,PPL="",PSONAM=$P(^DPT(PSDFN,0),"^") D ^PSOBUILD
  1. L1 D PID^VADPT S PSONV=$O(^PS(52.4,"C",PSDFN,PSONV)) I 'PSONV D PACK G PAT
  1.  F DGDG=0:0 S DGDG=$O(^PS(52.4,"C",PSDFN,DGDG)) S PSONV=DGDG K PSOSIG,PSOTHER Q:'DGDG!($D(PSOQUIT))  D
  1.  .I $D(^PS(52.4,"ADI",DGDG,1)) S PSONV=DGDG D DGDGI Q
  1.  .I $D(^PSRX(PSONV,"DRI")) S PSOSIG=1 D DGDGI Q
  1.  .D:'$D(^PS(52.4,"ADI",PSONV,1))&('$D(^PSRX(PSONV,"DRI"))) DSPL Q
  1.  G QUIT:$D(PSOSD)
  1.  Q
  1. PAT1 ; EP - New IHS Patient processing
  1.  D:'$D(PSOPAR) ^PSOLSET I '$D(PSOPAR) W $C(7),!!,"Pharmacy Division Must be Selected!",! Q
  1.  Q:'$D(^XUSEC("PSORPH",DUZ))  ; User must hold the PSORPH security key
  1.  S PSOZVER=1
  1.  K PSOTT,PSOACT,PSOVER,PSOQUIT,PSOVERA
  1.  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
  1.  S PSONV=0,(DFN,PSDFN,PSODFN)=+Y,PPL="",PSONAM=$P(^DPT(PSDFN,0),"^") D ^PSOBUILD
  1.  D PID^VADPT S PSONV=$O(^PS(52.4,"C",PSDFN,PSONV)) I 'PSONV D PACK G PAT
  1.  ; Loop through prescriptions for the patient
  1.  ; Lock patient
  1.  S PSOPLCK=$$L^PSSLOCK(PSDFN,0) I '$G(PSOPLCK) D LOCK^PSOORCPY Q
  1.  F DGDG=0:0 S DGDG=$O(^PS(52.4,"C",PSDFN,DGDG)) S PSONV=DGDG K PSOSIG,PSOTHER Q:'DGDG!($D(PSOQUIT))  D
  1.  .D LRX Q:'$G(PSOMSG)  K PSOMSG
  1.  .I $D(^PS(52.4,"ADI",DGDG,1)) S PSONV=DGDG D DGDGI D PSOUL^PSSLOCK(PSONV) Q
  1.  .I $D(^PSRX(PSONV,"DRI")) S PSOSIG=1 D DGDGI D PSOUL^PSSLOCK(PSONV) Q
  1.  .D:'$D(^PS(52.4,"ADI",PSONV,1))&('$D(^PSRX(PSONV,"DRI"))) DSPL D PSOUL^PSSLOCK(PSONV) Q
  1.  D PACK
  1.  G QUIT:$D(PSOSD)
  1.  G PAT1
  1.  ;
  1. SHOW I '$D(PSOSD) W !,$C(7),"This patient has no prescriptions on file",!! Q
  1.  D ^PSODSPL Q
  1.  ;
  1. CLERK D:'$D(PSOPAR) ^PSOLSET I '$D(PSOPAR) W $C(7),!!,"Pharmacy Division Must be Selected!",! G END
  1.  K PSOVERPL,PSOVERPX,PSOVERPH,PSOVERLX
  1.  ; IHS/MSC/PLS - 07/10/08
  1.  ;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
  1.  K PSOQUIT,PSOCQ S PSOCLK=1
  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
  1.  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
  1. 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)
  1.  .S PSONVXX=PSONV
  1.  .I $G(PSOVERPH)=$G(PSOVERPX),$G(PSOVERLX) Q
  1.  .I $G(PSOVERPH)'=$G(PSOVERPX) K PSOVERLX D:$G(PSOVERPH)&('$G(PSOVERPL)) ULP S PSOVERPH=PSOVERPX D LPAT I $G(PSOVERPL) Q
  1.  .S PSDFN0=PSDFN
  1.  .D LRX I '$G(PSOMSG) Q
  1.  .K PSOMSG I $D(^PS(52.4,"ADI",DGDG,1)) S PSONV=DGDG D DGDGI D PSOUL^PSSLOCK(PSONVXX) Q
  1.  .I $D(^PSRX(PSONV,"DRI")) S PSOSIG=1 D DGDGI D PSOUL^PSSLOCK(PSONVXX) Q
  1.  .D:'$D(^PS(52.4,"ADI",PSONV,1))&('$D(^PSRX(PSONV,"DRI"))) DSPL D PSOUL^PSSLOCK(PSONVXX) Q
  1.  D:$G(PSOVERPH)&('$G(PSOVERPL)) ULP
  1. CL2 D PACK G CLERK
  1. 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.  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
  1.  I PSDFN0'=DFN D ^PSOBUILD,PID^VADPT S PSONAM=$P(^DPT(DFN,0),"^")
  1.  Q
  1. 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.  S PPL="" F J=0:0 S J=$O(PSOVERA(J)) Q:'J  S PPL=PPL_J_","
  1.  ; IHS/CIA/PLS - 03/03/06 - Added next line so that autorelease would support verification
  1.  N PSOFROM S PSOFROM="NEW"
  1.  I PPL]"" S PSOOPT=3,PSOTRVV=1 D ^PSORXL K PSOOPT,PSOTRVV
  1.  ;IHS/MSC/PLS - 07/10/08
  1.  ;K PSD,PSOVER S PPL="" Q
  1.  K PSD,PSOVERA S PPL="" Q
  1. QUIT D PACK
  1. 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
  1.  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
  1.  K PSOVERA  ;IHS/MSC/PLS - 07/10/08
  1.  K PSONOOR,PSOSIG,DIR,DUOUT,DTOUT,DIRUT,DIROUT,INA,MED,SER1 K:'$G(POERR) PSOSD Q
  1. DSPL Q:$P(^PSRX(PSONV,"STA"),"^")=13
  1.  S DA=PSONV I $P($G(^PSRX(DA,"PKI")),"^") N PKI,PKI1,PKIR,PKIE D CER^PSOPKIV1
  1.  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"),!
  1.  S PSVFLAG=1 D ^PSOVER1 K PSVFLAG
  1.  Q
  1. DGDGI ;process drug interaction for non verified rxs
  1.  S SER1=$S('$G(PSOSIG):$P(^PS(52.4,PSONV,0),"^",9),1:$P(^PSRX(PSONV,"DRI"),"^"))
  1.  S MED=$S('$G(PSOSIG):$P(^PS(52.4,PSONV,0),"^",10),1:$P(^PSRX(PSONV,"DRI"),"^",2))
  1.  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
  1.  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
  1.  .I $G(PSOVMSGX)'="" W PSOVMSGX,!
  1.  K PSOVMSGX
  1.  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
  1.  I 'PSVERFLG I $P(^PSRX(PSONV,"STA"),"^")=4!($P(^("STA"),"^")=1) S $P(^PSRX(PSONV,"STA"),"^")=1 D DSPL G DONE
  1.  I '$D(^PS(52.4,"ADI",PSONV,1)),$P(^PSRX(PSONV,"STA"),"^")=1 D DSPL G DONE
  1.  I 'PSVERFLG,$P(^PSRX(PSONV,"STA"),"^")=1 D DSPL
  1. DONE I $P(^PSRX(PSONV,"STA"),"^")'=1,$P(^("STA"),"^")'=4 K ^PSRX(PSONV,"DRI")
  1.  S PSOTHER="" F  S PSOTHER=$O(PSOTHER(PSOTHER)) Q:PSOTHER=""  D
  1.  .I $G(PSOTHER),$P($G(^PSRX(PSOTHER,"STA")),"^")=1,$P($G(^PS(52.4,PSOTHER,0)),"^",10)="" S PSONV=PSOTHER D DSPL
  1.  D:$D(LOCKARRY) ULK1
  1. DONEX K PSOOPT,SER,LOCKARRY,LOCKINA,PSOLKVRX Q
  1. OERR ;K PSONOOR,PSOVER I $G(PSONACT) W $C(7),$C(7) S VALMSG="No Pharmacy Orderable Item!",VALMBCK="" Q
  1.  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
  1.  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
  1.  K PSOTPPEN,PSOTPPEX,PSOTPPE9
  1.  I $G(PSOBEDT) W $C(7),$C(7) S VALMSG="Invalid Action at this time !",VALMBCK="" Q
  1.  I '$D(^XUSEC("PSORPH",DUZ)) S VALMSG="Unauthorized Action!",VALMBCK="" Q
  1.  S PSOVRXN=$P(PSOLST($P(PSLST,",",ORD)),"^",2),PSOVDFN=$P($G(^PSRX(PSOVRXN,0)),"^",2)
  1.  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
  1.  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
  1.  N PSODFN S (PSOZVER,PSLSTVER)=1
  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)
  1.  .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
  1.  .S PSLSTVER=2
  1.  .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
  1.  .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)
  1.  .S DIK="^PS(52.4,",DA=PSONV D IX^DIK K DIK S Y(0)=^PS(52.4,PSONV,0),(X,DA)=PSONV
  1.  D STAT^PSODGDG2 G:FLAGST EOJ
  1.  N LST S (DFN,PSDFN,PSODFN)=$P(Y(0),"^",2),PPL="",PSONAM=$P(^DPT(PSDFN,0),"^")
  1.  D PID^VADPT I $D(^PS(52.4,"ADI",PSONV,1)) D DGDGI G:$G(VERLFLAG) EOJ G PPL
  1.  I $D(^PSRX(PSONV,"DRI")) S PSOSIG=1 D DGDGI G:$G(VERLFLAG) EOJ G PPL
  1.  D:'$D(^PS(52.4,"ADI",PSONV,1))&('$D(^PSRX(PSONV,"DRI"))) DSPL
  1. PPL I $G(PSLSTVER)=2,$D(^PS(52.4,PSONV,0)) S DA=PSONV,DIK="^PS(52.4," D ^DIK K DIK,DA
  1.  ; IHS/MSC/PLS - 07/10/08 - NEXT FOUR LINES
  1.  ;G EOJ:'$O(PSOVER(0))
  1.  G EOJ:'$O(PSOVERA(0))
  1.  ;S PSONVLP="" F  S PSONVLP=$O(PSOVER(PSONVLP)) Q:PSONVLP=""  D
  1.  S PSONVLP="" F  S PSONVLP=$O(PSOVERA(PSONVLP)) Q:PSONVLP=""  D
  1.  .D MARKV^PSOTPCAN
  1.  .I $G(PSORX("PSOL",1))']"" S PSORX("PSOL",1)=PSONVLP_"," Q
  1.  .F PSOX1=0:0 S PSOX1=$O(PSORX("PSOL",PSOX1)) Q:'PSOX1  S PSOX2=PSOX1
  1.  .I $L(PSORX("PSOL",PSOX2))+$L(PSONVLP)<220 S PSORX("PSOL",PSOX2)=PSORX("PSOL",PSOX2)_PSONVLP_","
  1.  .E  S PSORX("PSOL",PSOX2+1)=PSONVLP_","
  1. EOJ D ULB,END K D,DGDG,MW,PSONVLP,P,PCOMX,PDA,PSPRXN,RX,PSD,PSOSTA,PSLSTVER
  1.  L -^PSRX($P(PSOLST(ORN),"^",2))
  1.  Q
  1. LPAT ;
  1.  K PSOVERPL
  1.  I '$G(PSOVERPX) Q
  1.  S PSOPLCK=$$L^PSSLOCK(PSOVERPX,0) I '$G(PSOPLCK) D LOCK^PSOORCPY S (PSOVERPL,PSOVERLX)=1
  1.  K PSOPLCK
  1.  Q
  1. ULP ;
  1.  I '$G(PSOVERPH) Q
  1.  D UL^PSSLOCK(PSOVERPH) K PSOVERPH
  1.  Q
  1. LRX ;
  1.  K PSOMSG I '$G(PSONV) Q
  1.  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
  1.  .I $G(PSDFN) W "for patient "_$P($G(^DPT(PSDFN,0)),"^")_".",!
  1.  Q
  1. ULRX ;
  1.  I '$G(PSONV) Q
  1.  D PSOUL^PSSLOCK(PSONV)
  1.  Q
  1. LK1 ;
  1.  I '$G(PSOLKVRX) Q
  1.  D PSOL^PSSLOCK(PSOLKVRX) I '$G(PSOMSG) S VERLFLAG=1,PSOVMSGX=$P($G(PSOMSG),"^",2) Q
  1.  S LOCKARRY(PSOLKVRX)=PSOLKVRX
  1.  Q
  1. ULK1 ;
  1.  I '$D(LOCKARRY) Q
  1.  S PSOVOLK="" F  S PSOVOLK=$O(LOCKARRY(PSOVOLK)) Q:$G(PSOVOLK)=""  D PSOUL^PSSLOCK(PSOVOLK)
  1.  K PSOVOLK
  1.  Q
  1. ULB ;
  1.  I $G(PSOVDFN) D UL^PSSLOCK(PSOVDFN)
  1.  I $G(PSOVRXN) D PSOUL^PSSLOCK(PSOVRXN)
  1.  K PSOVDFN,PSOVRXN
  1.  Q