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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOORAPI 3956 printed Nov 22, 2024@17:41:44 Page 2
PSOORAPI ;BIR/RTR-API utility routine ;7/8/00
+1 ;;7.0;OUTPATIENT PHARMACY;**45,58**;DEC 1997
+2 ;External reference to ^PSDRUG supported by DBIA 221
+3 ;External reference to $$ZIEN^A7RPSOUB supported by DBIA 3314
+4 ;
EN(PSOB,PSOE,PSOX,PSODT,PSON) ;
+1 ;PSOB - begin date
+2 ;PSOE - end date
+3 ;PSOX - medication array
+4 ;PSODT - fill or release date
+5 ;PSON - node subscript
+6 ;
+7 NEW PSORD,PSORX,PSOFILL,PSODRG,PSOND,PSOPDFN,PSOCX,PSOMED1,PSOMED2,PSODNM,PSOPRT,PSODAYS,PSOCSITE,PSONOC,PSORTN,PSORXIEN
+8 if '$GET(PSOB)!('$GET(PSOE))
QUIT
+9 if $GET(PSODT)'="F"&($GET(PSODT)'="R")
QUIT
+10 SET PSOB=PSOB-.0001
SET PSOE=PSOE+.999999
+11 if $GET(PSON)=""
QUIT
+12 SET PSOCSITE=+$PIECE($$SITE^VASITE(),"^",3)
+13 SET PSORTN=0
IF $TEXT(ZIEN52^A7RPSOUB)]""
SET PSORTN=1
+14 KILL ^TMP(PSON,$JOB),^TMP($JOB,"PSOCT")
+15 if PSODT="F"
GOTO FILL
REL ;Use release date
+1 KILL PSOPRT
+2 FOR PSORD=PSOB:0
SET PSORD=$ORDER(^PSRX("AL",PSORD))
if 'PSORD!(PSORD>PSOE)
QUIT
FOR PSORX=0:0
SET PSORX=$ORDER(^PSRX("AL",PSORD,PSORX))
if 'PSORX
QUIT
SET PSOFILL=""
FOR
SET PSOFILL=$ORDER(^PSRX("AL",PSORD,PSORX,PSOFILL))
if PSOFILL=""
QUIT
Begin DoDot:1
+3 DO SET
+4 if '$GET(PSODRG)!('$GET(PSOPDFN))
QUIT
+5 DO MED
End DoDot:1
+6 ;Partial releases
+7 SET PSOPRT=1
+8 FOR PSORD=PSOB:0
SET PSORD=$ORDER(^PSRX("AM",PSORD))
if 'PSORD!(PSORD>PSOE)
QUIT
FOR PSORX=0:0
SET PSORX=$ORDER(^PSRX("AM",PSORD,PSORX))
if 'PSORX
QUIT
SET PSOFILL=""
FOR
SET PSOFILL=$ORDER(^PSRX("AM",PSORD,PSORX,PSOFILL))
if PSOFILL=""
QUIT
Begin DoDot:1
+9 DO SET
+10 if '$GET(PSODRG)!('$GET(PSOPDFN))
QUIT
+11 DO MED
End DoDot:1
+12 GOTO END
FILL ;Use fill date
+1 KILL PSOPRT
+2 FOR PSORD=PSOB:0
SET PSORD=$ORDER(^PSRX("AD",PSORD))
if 'PSORD!(PSORD>PSOE)
QUIT
FOR PSORX=0:0
SET PSORX=$ORDER(^PSRX("AD",PSORD,PSORX))
if 'PSORX
QUIT
SET PSOFILL=""
FOR
SET PSOFILL=$ORDER(^PSRX("AD",PSORD,PSORX,PSOFILL))
if PSOFILL=""
QUIT
Begin DoDot:1
+3 DO SET
+4 if '$GET(PSODRG)!('$GET(PSOPDFN))
QUIT
+5 DO MED
End DoDot:1
+6 ;Partial fills
+7 SET PSOPRT=1
+8 FOR PSORD=PSOB:0
SET PSORD=$ORDER(^PSRX("ADP",PSORD))
if 'PSORD!(PSORD>PSOE)
QUIT
FOR PSORX=0:0
SET PSORX=$ORDER(^PSRX("ADP",PSORD,PSORX))
if 'PSORX
QUIT
SET PSOFILL=""
FOR
SET PSOFILL=$ORDER(^PSRX("ADP",PSORD,PSORX,PSOFILL))
if PSOFILL=""
QUIT
Begin DoDot:1
+9 DO SET
+10 if '$GET(PSODRG)!('$GET(PSOPDFN))
QUIT
+11 DO MED
End DoDot:1
+12 GOTO END
SET ;
+1 KILL PSOND,PSODNM,PSODAYS
SET PSODRG=+$PIECE($GET(^PSRX(PSORX,0)),"^",6)
SET PSOPDFN=+$PIECE($GET(^(0)),"^",2)
IF PSODRG
SET PSOND=+$PIECE($GET(^PSDRUG(PSODRG,"ND")),"^")
SET PSODNM=$PIECE($GET(^(0)),"^")
+2 IF $GET(PSOPRT)
SET PSODAYS=$PIECE($GET(^PSRX(PSORX,"P",+$GET(PSOFILL),0)),"^",10)
+3 IF '$GET(PSOPRT)
SET PSODAYS=$SELECT($GET(PSOFILL):$PIECE($GET(^PSRX(PSORX,1,+$GET(PSOFILL),0)),"^",10),1:$PIECE($GET(^PSRX(PSORX,0)),"^",8))
+4 QUIT
MED ;Check medication array for matches
+1 KILL PSOMED1,PSOMED2,PSOMED3
+2 IF $DATA(PSOX(PSODRG_";PSDRUG("))
SET PSOMED1=1
DO MEDS
QUIT
+3 IF $GET(PSOND)
IF $DATA(PSOX(PSOND_";PSNDF(50.6,"))
SET PSOMED2=1
DO MEDS
QUIT
+4 ;Here, add class check when ready, use PSOMED2 for NDF, default to 1 for VA Class in MEDS
+5 QUIT
MEDS ;
+1 SET PSONOC=0
IF '$GET(PSOPRT)
IF '$GET(PSOFILL)
IF $GET(PSORTN)
IF $GET(PSOCSITE)
SET PSORXIEN=$PIECE($GET(^PSRX(PSORX,0)),"^")
IF $GET(PSORXIEN)'=""
SET PSONOC=$$ZIEN52^A7RPSOUB(PSOCSITE,PSORXIEN)
+2 if $GET(PSONOC)
QUIT
+3 IF $DATA(^TMP($JOB,"PSOCT",PSOPDFN))
SET (PSOCX,^TMP($JOB,"PSOCT",PSOPDFN))=^TMP($JOB,"PSOCT",PSOPDFN)+1
+4 IF '$DATA(^TMP($JOB,"PSOCT",PSOPDFN))
SET (PSOCX,^TMP($JOB,"PSOCT",PSOPDFN))=1
+5 SET ^TMP(PSON,$JOB,PSOPDFN,PSOCX,0)=$SELECT($GET(PSOMED1):PSODRG_";PSDRUG(",1:$GET(PSOND)_";PSNDF(50.6,")
+6 IF $GET(PSODT)="F"
Begin DoDot:1
+7 IF '$GET(PSOPRT)
SET ^TMP(PSON,$JOB,PSOPDFN,PSOCX,1)=PSORD_"^"_$SELECT('$GET(PSOFILL)&($PIECE($GET(^PSRX(PSORX,2)),"^",13)):$EXTRACT($PIECE(...
... $GET(^(2)),"^",13),1,7),$GET(PSOFILL)&($PIECE($GET(^PSRX(PSORX,1,$GET(PSOFILL),0)),"^",18)):$EXTRACT($PIECE($GET(^(0)),"^",18),1,7),1:"")_"^"_$GET(PSODNM)
+8 IF $GET(PSOPRT)
SET ^TMP(PSON,$JOB,PSOPDFN,PSOCX,1)=PSORD_"^"_$SELECT($GET(PSOFILL)&($PIECE($GET(^PSRX(PSORX,"P",$GET(PSOFILL),0)),"^",19)):$EXTRACT($PIECE($GET(^(0)),"^",19),1,7),1:"")_"^"_$GET(PSODNM)
+9 SET ^TMP(PSON,$JOB,PSOPDFN,PSOCX,1)=$GET(^TMP(PSON,$JOB,PSOPDFN,PSOCX,1))_"^"_$GET(PSODAYS)
End DoDot:1
QUIT
+10 SET ^TMP(PSON,$JOB,PSOPDFN,PSOCX,1)=$SELECT('...
SET $GET(PSOPRT)&('$GET(PSOFILL)):$EXTRACT($PIECE($GET(^PSRX(PSORX,2)),"^",2),1,7),'$GET(PSOPRT)&($GET(PSOFILL)):$EXTRACT($PIECE($GET(^PSRX(PSORX,1,+$GET(PSOFILL),0)),"^"),1,7),$GET(PSOPRT):$EXTRACT(...
... $PIECE($GET(^PSRX(PSORX,"P",+$GET(PSOFILL),0)),"^"),1,7),1:"")
+11 SET ^TMP(PSON,$JOB,PSOPDFN,PSOCX,1)=$GET(^TMP(PSON,$JOB,PSOPDFN,PSOCX,1))_"^"_$EXTRACT($GET(PSORD),1,7)_"^"_$GET(PSODNM)_"^"_$GET(PSODAYS)
+12 QUIT
END ;
+1 KILL ^TMP($JOB,"PSOCT")
+2 QUIT
