95 lines
5.4 KiB
Mathematica
95 lines
5.4 KiB
Mathematica
PSOHLDC ;BIR/RTR-Process incoming cancel messages from CHCS ;09/06/02
|
|
;;7.0;OUTPATIENT PHARMACY;**111,121,146,223,148,249**;DEC 1997;Build 9
|
|
;External reference to ^PSSLOCK supported by DBIA 2789
|
|
;
|
|
ENDC ;
|
|
;Process exceptions
|
|
N DA,PSOEXINP,PSOHLINR,PSOHLSTP,PSOHLSTR,PSOHLPL,PSOHLCM,PSOCANRC,PSOCANRN,PSOHUIOR
|
|
S (PSOHBDS,PSOEXXQ)=0
|
|
I PSOHDFOR S PSOEXMS="Invalid message structure." D NAK^PSOHLEXC Q
|
|
F PSOHMSG="MSH","PID","ORC" Q:PSOEXXQ I '$D(PSOHLMIS(PSOHMSG)) S PSOEXMS="Missing "_PSOHMSG_" segment." S PSOHBDS=1 D NAK^PSOHLEXC
|
|
I $G(PSOEXXQ) Q
|
|
I $G(HL("SAN"))="" S PSOEXMS="Missing sending application name." D NAK^PSOHLEXC Q
|
|
S PSOHY("EXAPP")=HL("SAN")
|
|
I '$G(PSOHY("PAT"))!('$D(^DPT(+$G(PSOHY("PAT")),0))) S PSOEXMS="Invalid patient entry." D NAK^PSOHLEXC Q
|
|
I $G(PSOHY("CHNUM"))="" S PSOEXMS="Missing CHCS Placer Order Number." D NAK^PSOHLEXC Q
|
|
D CAN^PSOHLEXC
|
|
I $G(PSOEXXQ) Q
|
|
S (PSOEXINP,PSOHLINR)=0
|
|
S PSOEXINP=$O(^PS(52.41,"C",PSOHY("CHNUM"),PSOHY("EXAPP"),0)) I PSOEXINP D PEND Q
|
|
S PSOHLINR=$O(^PSRX("D",PSOHY("CHNUM"),PSOHY("EXAPP"),0)) I PSOHLINR D RX Q
|
|
S PSOEXMS="Unable to find order in Pharmacy." D NAK^PSOHLEXC
|
|
Q
|
|
PEND ;Process a DC message on a Pending order
|
|
I PSOHY("PAT")'=$P($G(^PS(52.41,PSOEXINP,0)),"^",2) S PSOEXMS="Patient mismatch in Pending order." D NAK^PSOHLEXC Q
|
|
K PSOMSG D PSOL^PSSLOCK(+PSOEXINP_"S") I '$G(PSOMSG) S PSOEXMS="Pending order is being edited by another user." D NAK^PSOHLEXC K PSOMSG Q
|
|
K PSOMSG
|
|
S PSOHLSTP=$P($G(^PS(52.41,PSOEXINP,0)),"^",3)
|
|
I PSOHLSTP'="NW" D D NAK^PSOHLEXC Q
|
|
.S PSOEXMS="Unable to cancel Pending order, status is "_$S(PSOHLSTP="HD":"HOLD",PSOHLSTP="RNW":"RENEW",PSOHLSTP="DE":"DISCONTINUE (EDIT)",PSOHLSTP="DC":"DISCONTINUE",PSOHLSTP="RF":"REFILL REQUEST",1:"UNKNOWN")_"."
|
|
S $P(^PS(52.41,PSOEXINP,0),"^",3)="DC"
|
|
S PSOHLPL=$P(^PS(52.41,PSOEXINP,0),"^")
|
|
K ^PS(52.41,"AOR",+$P($G(^PS(52.41,PSOEXINP,0)),"^",2),+$P($G(^PS(52.41,PSOEXINP,"INI")),"^"),PSOEXINP)
|
|
S PSOHLCM="Discontinued by Provider."
|
|
S $P(^PS(52.41,PSOEXINP,4),"^")=PSOHLCM
|
|
D PVSET
|
|
S PSOHUIOR=1
|
|
I PSOHLPL D EN^PSOHLSN(PSOHLPL,"OC",PSOHLCM,"")
|
|
D PSOUL^PSSLOCK(+PSOEXINP_"S")
|
|
D ACK^PSOHLEXC
|
|
K PSOHUIOR
|
|
Q
|
|
RX ;Process a DC message on a prescription
|
|
N PSOSUSD,PSOIFN,PSORFDT,PSOHTEST,PSOHPDA,CMOP,ACOM,PSOARECX,PSODFN
|
|
S PSOARECX=0
|
|
I PSOHY("PAT")'=$P($G(^PSRX(PSOHLINR,0)),"^",2) S PSOEXMS="Patient mismatch in prescription." D NAK^PSOHLEXC Q
|
|
S PSODFN=$P($G(^PSRX(PSOHLINR,0)),"^",2)
|
|
K PSOMSG D PSOL^PSSLOCK(PSOHLINR) I '$G(PSOMSG) S PSOEXMS="Prescription is being edited by another user." D NAK^PSOHLEXC K PSOMSG Q
|
|
K PSOMSG
|
|
S PSOHLSTR=$P($G(^PSRX(PSOHLINR,"STA")),"^")
|
|
I PSOHLSTR>11,PSOHLSTR<16 D D NAK^PSOHLEXC Q
|
|
.S PSOEXMS="Unable to cancel prescription, status is "_$S(PSOHLSTR=12:"DISCONTINUED",PSOHLSTR=13:"DELETED",PSOHLSTR=14:"DISCONTINUED BY PROVIDER",1:"DISCONTINUED (EDIT)")_"."
|
|
S (PSOHLCM,ACOM)="Discontinued by Provider."
|
|
I PSOHLSTR=3!(PSOHLSTR=16) D
|
|
.S (PSOHLCM,ACOM)="Discontinued by Provider while on hold." K:$P($G(^PSRX(PSOHLINR,"H")),"^") ^PSRX("AH",$P($G(^PSRX(PSOHLINR,"H")),"^"),PSOHLINR) S ^PSRX(PSOHLINR,"H")=""
|
|
.I $P(^PSRX(PSOHLINR,0),"^",13),'$O(^PSRX(PSOHLINR,1,0)) S DIE=52,DR="22///"_$E($P(^PSRX(PSOHLINR,0),"^",13),1,7),DA=PSOHLINR D ^DIE K DIE,DA,DR Q
|
|
.S (PSOIFN,PSOSUSD)=0,PSORFDT="" F S PSOIFN=$O(^PSRX(PSOHLINR,1,PSOIFN)) Q:'PSOIFN S PSOSUSD=PSOIFN,PSORFDT=$P($G(^PSRX(PSOHLINR,1,PSOIFN,0)),"^")
|
|
.I $G(PSORFDT)=""!('$G(PSOSUSD)) Q
|
|
.I '$P($G(^PSRX(PSOHLINR,1,PSOSUSD,0)),"^",18) S PSOHTEST=0 D I 'PSOHTEST K ^PSRX(PSOHLINR,1,PSOSUSD),^PSRX("AD",PSORFDT,PSOHLINR,PSOSUSD),^PSRX(PSOHLINR,1,"B",PSORFDT,PSOSUSD),PSOIFN,PSOSUSD,PSORFDT
|
|
..F PSOHPDA=0:0 S PSOHPDA=$O(^PSRX(PSOHLINR,"L",PSOHPDA)) Q:'PSOHPDA I $P($G(^PSRX(PSOHLINR,"L",PSOHPDA,0)),"^",2)=PSOSUSD S PSOHTEST=1
|
|
..K CMOP S DA=PSOHLINR D ^PSOCMOPA I $G(CMOP(CMOP("L")))="",$G(CMOP("S"))'="L" Q
|
|
..S PSOHTEST=1
|
|
D SUS
|
|
I '$G(PSOARECX) D ACTL
|
|
S $P(^PSRX(PSOHLINR,"STA"),"^")=14,$P(^PSRX(PSOHLINR,3),"^",5)=DT
|
|
D CAN^PSOTPCAN(PSOHLINR),REVERSE^PSOBPSU1(PSOHLINR,,"DC",7)
|
|
I $O(^PS(52.41,"ARF",PSOHLINR,0)),'$O(^PS(52.41,"APSOD",PSODFN,0)) S DA=$O(^PS(52.41,"ARF",PSOHLINR,0)),DIK="^PS(52.41," D ^DIK K DIK
|
|
D PVSET
|
|
S PSOHUIOR=1
|
|
D EN^PSOHLSN1(PSOHLINR,"OD","","Discontinued by Provider","")
|
|
K PSOHUIOR
|
|
I $G(^PS(52.4,PSOHLINR,0))]"" S DA=PSOHLINR,DIK="^PS(52.4," D ^DIK K DIK
|
|
D PSOUL^PSSLOCK(PSOHLINR)
|
|
D ACK^PSOHLEXC
|
|
Q
|
|
SUS N RXDA,SUSDA,IFN,PSORFDEL,SUSD,RF,NODE
|
|
S RXDA=PSOHLINR,(DA,SUSDA)=$O(^PS(52.5,"B",PSOHLINR,0)) D:DA
|
|
.S SUSD=$P($G(^PS(52.5,DA,0)),"^",2)
|
|
.S:+$G(^PS(52.5,DA,"P"))'=1 (PSOHLCM,ACOM)="Discontinued by Provider while suspended."
|
|
.I $O(^PSRX(PSOHLINR,1,0)) S PSOARECX=1 D ACTL S DA=PSOHLINR D:'$G(^PS(52.5,+SUSDA,"P")) REF^PSOCAN2
|
|
.I $P($G(^PS(52.5,+SUSDA,0)),"^",2),$P($G(^(0)),"^",3) S DA=SUSDA,DIK="^PS(52.5," D ^DIK K DIK
|
|
Q
|
|
ACTL ;Add Activity log
|
|
N PSORXREF,REA,PSOACNT,PSOSIBB,PSORFH,PSORFCNT
|
|
S PSORXREF=0,PSODFN=+$P(^PSRX(PSOHLINR,0),"^",2) D
|
|
.S PSOACNT=0 F PSOSUBB=0:0 S PSOSUBB=$O(^PSRX(PSOHLINR,"A",PSOSUBB)) Q:'PSOSUBB S PSOACNT=PSOSUBB
|
|
.S PSORFCNT=0 F PSORFH=0:0 S PSORFH=$O(^PSRX(PSOHLINR,1,PSORFH)) Q:'PSORFH S PSORFCNT=PSORFH S:PSORFH>5 PSORFCNT=PSORFH+1
|
|
.D NOW^%DTC S ^PSRX(PSOHLINR,"A",0)="^52.3DA^"_(PSOACNT+1)_"^"_(PSOACNT+1),^PSRX(PSOHLINR,"A",PSOACNT+1,0)=%_"^C^"_$G(PSOHY("PROV"))_"^"_PSORFCNT_"^"_$G(PSOHLCM)
|
|
.S REA="C" S DA=PSOHLINR N EXP,PCD,IFN D EXP^PSOHELP1
|
|
Q
|
|
PVSET ;
|
|
N DIC,X,Y,USER1
|
|
D USER^PSOORFI2(PSOHY("PROV"))
|
|
S PSOCANRC=PSOHY("PROV"),PSOCANRN=USER1
|
|
Q
|