source: WorldVistAEHR/trunk/r/OUTPATIENT_PHARMACY-PSO-APSP-HUIP/PSOORAPI.m@ 1201

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