- 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 Apr 23, 2025@18:46:13 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
