75 lines
3.8 KiB
Mathematica
75 lines
3.8 KiB
Mathematica
|
PSOORAPI ;BIR/RTR-API utility routine ;7/8/00
|
||
|
|
;;7.0;OUTPATIENT PHARMACY;**45,58**;DEC 1997
|
||
|
|
;External reference to ^PSDRUG supported by DBIA 221
|
||
|
|
;External reference to $$ZIEN^A7RPSOUB supported by DBIA 3314
|
||
|
|
;
|
||
|
|
EN(PSOB,PSOE,PSOX,PSODT,PSON) ;
|
||
|
|
;PSOB - begin date
|
||
|
|
;PSOE - end date
|
||
|
|
;PSOX - medication array
|
||
|
|
;PSODT - fill or release date
|
||
|
|
;PSON - node subscript
|
||
|
|
;
|
||
|
|
N PSORD,PSORX,PSOFILL,PSODRG,PSOND,PSOPDFN,PSOCX,PSOMED1,PSOMED2,PSODNM,PSOPRT,PSODAYS,PSOCSITE,PSONOC,PSORTN,PSORXIEN
|
||
|
|
Q:'$G(PSOB)!('$G(PSOE))
|
||
|
|
Q:$G(PSODT)'="F"&($G(PSODT)'="R")
|
||
|
|
S PSOB=PSOB-.0001,PSOE=PSOE+.999999
|
||
|
|
Q:$G(PSON)=""
|
||
|
|
S PSOCSITE=+$P($$SITE^VASITE(),"^",3)
|
||
|
|
S PSORTN=0 I $T(ZIEN52^A7RPSOUB)]"" S PSORTN=1
|
||
|
|
K ^TMP(PSON,$J),^TMP($J,"PSOCT")
|
||
|
|
G:PSODT="F" FILL
|
||
|
|
REL ;Use release date
|
||
|
|
K PSOPRT
|
||
|
|
F PSORD=PSOB:0 S PSORD=$O(^PSRX("AL",PSORD)) Q:'PSORD!(PSORD>PSOE) F PSORX=0:0 S PSORX=$O(^PSRX("AL",PSORD,PSORX)) Q:'PSORX S PSOFILL="" F S PSOFILL=$O(^PSRX("AL",PSORD,PSORX,PSOFILL)) Q:PSOFILL="" D
|
||
|
|
.D SET
|
||
|
|
.Q:'$G(PSODRG)!('$G(PSOPDFN))
|
||
|
|
.D MED
|
||
|
|
;Partial releases
|
||
|
|
S PSOPRT=1
|
||
|
|
F PSORD=PSOB:0 S PSORD=$O(^PSRX("AM",PSORD)) Q:'PSORD!(PSORD>PSOE) F PSORX=0:0 S PSORX=$O(^PSRX("AM",PSORD,PSORX)) Q:'PSORX S PSOFILL="" F S PSOFILL=$O(^PSRX("AM",PSORD,PSORX,PSOFILL)) Q:PSOFILL="" D
|
||
|
|
.D SET
|
||
|
|
.Q:'$G(PSODRG)!('$G(PSOPDFN))
|
||
|
|
.D MED
|
||
|
|
G END
|
||
|
|
FILL ;Use fill date
|
||
|
|
K PSOPRT
|
||
|
|
F PSORD=PSOB:0 S PSORD=$O(^PSRX("AD",PSORD)) Q:'PSORD!(PSORD>PSOE) F PSORX=0:0 S PSORX=$O(^PSRX("AD",PSORD,PSORX)) Q:'PSORX S PSOFILL="" F S PSOFILL=$O(^PSRX("AD",PSORD,PSORX,PSOFILL)) Q:PSOFILL="" D
|
||
|
|
.D SET
|
||
|
|
.Q:'$G(PSODRG)!('$G(PSOPDFN))
|
||
|
|
.D MED
|
||
|
|
;Partial fills
|
||
|
|
S PSOPRT=1
|
||
|
|
F PSORD=PSOB:0 S PSORD=$O(^PSRX("ADP",PSORD)) Q:'PSORD!(PSORD>PSOE) F PSORX=0:0 S PSORX=$O(^PSRX("ADP",PSORD,PSORX)) Q:'PSORX S PSOFILL="" F S PSOFILL=$O(^PSRX("ADP",PSORD,PSORX,PSOFILL)) Q:PSOFILL="" D
|
||
|
|
.D SET
|
||
|
|
.Q:'$G(PSODRG)!('$G(PSOPDFN))
|
||
|
|
.D MED
|
||
|
|
G END
|
||
|
|
SET ;
|
||
|
|
K PSOND,PSODNM,PSODAYS S PSODRG=+$P($G(^PSRX(PSORX,0)),"^",6),PSOPDFN=+$P($G(^(0)),"^",2) I PSODRG S PSOND=+$P($G(^PSDRUG(PSODRG,"ND")),"^"),PSODNM=$P($G(^(0)),"^")
|
||
|
|
I $G(PSOPRT) S PSODAYS=$P($G(^PSRX(PSORX,"P",+$G(PSOFILL),0)),"^",10)
|
||
|
|
I '$G(PSOPRT) S PSODAYS=$S($G(PSOFILL):$P($G(^PSRX(PSORX,1,+$G(PSOFILL),0)),"^",10),1:$P($G(^PSRX(PSORX,0)),"^",8))
|
||
|
|
Q
|
||
|
|
MED ;Check medication array for matches
|
||
|
|
K PSOMED1,PSOMED2,PSOMED3
|
||
|
|
I $D(PSOX(PSODRG_";PSDRUG(")) S PSOMED1=1 D MEDS Q
|
||
|
|
I $G(PSOND),$D(PSOX(PSOND_";PSNDF(50.6,")) S PSOMED2=1 D MEDS Q
|
||
|
|
;Here, add class check when ready, use PSOMED2 for NDF, default to 1 for VA Class in MEDS
|
||
|
|
Q
|
||
|
|
MEDS ;
|
||
|
|
S PSONOC=0 I '$G(PSOPRT),'$G(PSOFILL),$G(PSORTN),$G(PSOCSITE) S PSORXIEN=$P($G(^PSRX(PSORX,0)),"^") I $G(PSORXIEN)'="" S PSONOC=$$ZIEN52^A7RPSOUB(PSOCSITE,PSORXIEN)
|
||
|
|
Q:$G(PSONOC)
|
||
|
|
I $D(^TMP($J,"PSOCT",PSOPDFN)) S (PSOCX,^TMP($J,"PSOCT",PSOPDFN))=^TMP($J,"PSOCT",PSOPDFN)+1
|
||
|
|
I '$D(^TMP($J,"PSOCT",PSOPDFN)) S (PSOCX,^TMP($J,"PSOCT",PSOPDFN))=1
|
||
|
|
S ^TMP(PSON,$J,PSOPDFN,PSOCX,0)=$S($G(PSOMED1):PSODRG_";PSDRUG(",1:$G(PSOND)_";PSNDF(50.6,")
|
||
|
|
I $G(PSODT)="F" D Q
|
||
|
|
.I '$G(PSOPRT) S ^TMP(PSON,$J,PSOPDFN,PSOCX,1)=PSORD_"^"_$S('$G(PSOFILL)&($P($G(^PSRX(PSORX,2)),"^",13)):$E($P($G(^(2)),"^",13),1,7),$G(PSOFILL)&($P($G(^PSRX(PSORX,1,$G(PSOFILL),0)),"^",18)):$E($P($G(^(0)),"^",18),1,7),1:"")_"^"_$G(PSODNM)
|
||
|
|
.I $G(PSOPRT) S ^TMP(PSON,$J,PSOPDFN,PSOCX,1)=PSORD_"^"_$S($G(PSOFILL)&($P($G(^PSRX(PSORX,"P",$G(PSOFILL),0)),"^",19)):$E($P($G(^(0)),"^",19),1,7),1:"")_"^"_$G(PSODNM)
|
||
|
|
.S ^TMP(PSON,$J,PSOPDFN,PSOCX,1)=$G(^TMP(PSON,$J,PSOPDFN,PSOCX,1))_"^"_$G(PSODAYS)
|
||
|
|
S ^TMP(PSON,$J,PSOPDFN,PSOCX,1)=$S('$G(PSOPRT)&('$G(PSOFILL)):$E($P($G(^PSRX(PSORX,2)),"^",2),1,7),'$G(PSOPRT)&($G(PSOFILL)):$E($P($G(^PSRX(PSORX,1,+$G(PSOFILL),0)),"^"),1,7),$G(PSOPRT):$E($P($G(^PSRX(PSORX,"P",+$G(PSOFILL),0)),"^"),1,7),1:"")
|
||
|
|
S ^TMP(PSON,$J,PSOPDFN,PSOCX,1)=$G(^TMP(PSON,$J,PSOPDFN,PSOCX,1))_"^"_$E($G(PSORD),1,7)_"^"_$G(PSODNM)_"^"_$G(PSODAYS)
|
||
|
|
Q
|
||
|
|
END ;
|
||
|
|
K ^TMP($J,"PSOCT")
|
||
|
|
Q
|