PSOORRL3 ;BHAM ISC/SJA - returns patient's outpatient meds-new sort ;Dec 10, 2021@09:33:28
;;7.0;OUTPATIENT PHARMACY;**225,331,381,622,441**;DEC 1997;Build 208
;External reference to ^PS(55 supported by DBIA 2228
;External reference to ^PSDRUG supported by DBIA 221
;External reference to ^VA(200 supported by DBIA 10060
;External reference to ^PS(51.2 supported by DBIA 2226
;External reference to ^PS(50.7 supported by DBIA 2223
;External reference to ^PS(50.606 supported by DBIA 2174
;External reference to OCL^PSJORRE supported by DBIA 2383
OCL ;entry point to return condensed list
;BHW;PSO*7*159;New SD* Variables
N SD,SDT,SDT1,PSG,PST,PSD,DRUG,PSOSTA
D:$P($G(^PS(55,DFN,0)),"^",6)'=2 EN^PSOHLUP(DFN)
K ^TMP("PS",$J),^TMP("PSO",$J),^TMP("PS1",$J)
S TFN=0,PSBDT=$G(BDT),PSEDT=$G(EDT) I +$G(PSBDT)<1 S X1=DT,X2=-120 D C^%DTC S PSBDT=X
S EXDT=PSBDT-1,IFN=0
F S EXDT=$O(^PS(55,DFN,"P","A",EXDT)) Q:'EXDT F S IFN=$O(^PS(55,DFN,"P","A",EXDT,IFN)) Q:'IFN D:$D(^PSRX(IFN,0))
.S PSOSTA=$P($G(^PSRX(IFN,"STA")),"^") Q:'(PSOSTA=0!(PSOSTA=11)!(PSOSTA=5)!(PSOSTA=3)!(PSOSTA=16))
.S TFN=TFN+1,RX0=^PSRX(IFN,0),RX2=$G(^(2)),RX3=$G(^(3)),STA=+$G(^("STA")),TRM=0,LSTFD=$P(RX2,"^",2),LSTRD=$P(RX2,"^",13),LSTDS=$P(RX0,"^",8)
.F I=0:0 S I=$O(^PSRX(IFN,1,I)) Q:'I S TRM=TRM+1,LSTFD=$P(^PSRX(IFN,1,I,0),"^"),LSTDS=$P(^(0),"^",10) S:$P(^(0),"^",18)]"" LSTRD=$P(^(0),"^",18)
.S ST0=STA,ST=$P("ERROR^ACTIVE^^^HOLD^^ACTIVE/SUSP^^^^^^EXPIRED^^^^^HOLD^","^",ST0+2)
.I STA=0,+$G(^PSRX(IFN,"PARK")) S ST="ACTIVE/PARKED" ;441 PAPI
.S DRUG=$P($G(^PSDRUG(+$P(RX0,"^",6),0)),"^")
.S ^TMP("PSO",$J,DRUG,ST,TFN,0)=IFN_"R;O"_"^"_DRUG_"^^"_$P(RX2,"^",6)_"^"_($P(RX0,"^",9)-TRM)_"^^^"_$P($G(^PSRX(IFN,"OR1")),"^",2)
.S ^TMP("PSO",$J,DRUG,ST,TFN,"P",0)=$P(RX0,"^",4)_"^"_$P($G(^VA(200,+$P(RX0,"^",4),0)),"^")
.S ^TMP("PSO",$J,DRUG,ST,TFN,0)=^TMP("PSO",$J,DRUG,ST,TFN,0)_"^"_ST_"^"_LSTFD_"^"_$P(RX0,"^",8)_"^"_$P(RX0,"^",7)_"^^^"_$P(RX0,"^",13)_"^"_LSTRD_"^"_LSTDS
.S ^TMP("PSO",$J,DRUG,ST,TFN,"SCH",0)=0
.S (SCH,SC)=0 F S SC=$O(^PSRX(IFN,"SCH",SC)) Q:'SC S SCH=SCH+1,^TMP("PSO",$J,DRUG,ST,TFN,"SCH",SCH,0)=$P(^PSRX(IFN,"SCH",SC,0),"^"),^TMP("PSO",$J,DRUG,ST,TFN,"SCH",0)=^TMP("PSO",$J,DRUG,ST,TFN,"SCH",0)+1
.S ^TMP("PSO",$J,DRUG,ST,TFN,"MDR",0)=0,(MDR,MR)=0 F S MR=$O(^PSRX(IFN,"MEDR",MR)) Q:'MR D
..Q:'$D(^PS(51.2,+^PSRX(IFN,"MEDR",MR,0),0)) S MDR=MDR+1
..I $P($G(^PS(51.2,+^PSRX(IFN,"MEDR",MR,0),0)),"^",3)]"" S ^TMP("PSO",$J,DRUG,ST,TFN,"MDR",MDR,0)=$P(^PS(51.2,+^PSRX(IFN,"MEDR",MR,0),0),"^",3)
..I $D(^PS(51.2,+^PSRX(IFN,"MEDR",MR,0),0)),$P($G(^(0)),"^",3)']"" S ^TMP("PSO",$J,DRUG,ST,TFN,"MDR",MDR,0)=$P(^PS(51.2,+^PSRX(IFN,"MEDR",MR,0),0),"^")
..S ^TMP("PSO",$J,DRUG,ST,TFN,"MDR",0)=^TMP("PSO",$J,DRUG,ST,TFN,"MDR",0)+1
.S PSOELSE=0 I $D(^PSRX(IFN,"SIG")),'$P(^PSRX(IFN,"SIG"),"^",2) S PSOELSE=1 S X=$P(^PSRX(IFN,"SIG"),"^") D SIG1^PSOORRL1
.I '$G(PSOELSE) S ITFN=1 D
..S ^TMP("PSO",$J,DRUG,ST,TFN,"SIG",ITFN,0)=$G(^PSRX(IFN,"SIG1",1,0)),^TMP("PSO",$J,DRUG,ST,TFN,"SIG",0)=+$G(^TMP("PSO",$J,DRUG,ST,TFN,"SIG",0))+1
..F I=1:0 S I=$O(^PSRX(IFN,"SIG1",I)) Q:'I S ITFN=ITFN+1,^TMP("PSO",$J,DRUG,ST,TFN,"SIG",ITFN,0)=^PSRX(IFN,"SIG1",I,0),^TMP("PSO",$J,DRUG,ST,TFN,"SIG",0)=+$G(^TMP("PSO",$J,DRUG,ST,TFN,"SIG",0))+1
.S:$P($G(^PSRX(IFN,"IND")),U)]"" ^TMP("PSO",$J,DRUG,ST,TFN,"IND",0)=$P(^PSRX(IFN,"IND"),U) ;*441-IND
K PSOELSE D NVA
S PSG="",J=1 F S PSG=$O(^TMP("PSO",$J,PSG)) Q:PSG="" S PST="" F S PST=$O(^TMP("PSO",$J,PSG,PST)) Q:PST="" S I=0 F S I=$O(^TMP("PSO",$J,PSG,PST,I)) Q:'I D
.M ^TMP("PS",$J,J)=^TMP("PSO",$J,PSG,PST,I) S J=J+1
S PSG="" F S PSG=$O(^TMP("PS1",$J,PSG)) Q:PSG="" S PST="" F S PST=$O(^TMP("PS1",$J,PSG,PST)) Q:PST="" S I=0 F S I=$O(^TMP("PS1",$J,PSG,PST,I)) Q:I="" D
.M ^TMP("PS",$J,J)=^TMP("PS1",$J,PSG,PST,I) S J=J+1
K ^TMP("PSO",$J),^TMP("PS1",$J)
D OCL^PSJORRE(DFN,$G(PSOBDTIN),$G(PSOEDTIN),.TFN,+$G(VIEW))
D END^PSOORRL1
K SDT,SDT1,ST,DRUG,PSG,PST,PSD,EDT,EDT1,BDT,DBT1,X
Q
NVA ; Set Non-VA Med Orders in the ^TMP Global
;BHW;PSO*7*159;New SDT,SDT1 Variables
;BDT - ORCH CONTEXT MEDS START DATE
;EDT - ORCH CONTEXT MEDS END DATE
;SDT - NON-VA MED START DATE
;PSODCDT - NON-VA MED DISCONTINUE DATE
N SDT,SDT1,PSOACT,PSODC,PSODCDT,PSOBDT,PSOEDT
S PSOBDT=$G(BDT),PSOEDT=$G(EDT)
I 'PSOBDT,'PSOEDT S PSOBDT=PSBDT,PSOEDT=DT ;*381
I PSOBDT,'PSOEDT S PSOEDT=DT ;*381
F I=0:0 S I=$O(^PS(55,DFN,"NVA",I)) Q:'I S X=$G(^PS(55,DFN,"NVA",I,0)) D
.Q:'$P(X,"^")
.I $O(^PS(55,DFN,"NVA",I,3,0)) D NVANEW^PSOORRLO Q ;*441-Complex dose
.S DRG=$S($P(X,"^",2):$P($G(^PSDRUG($P(X,"^",2),0)),"^"),1:$P(^PS(50.7,$P(X,"^"),0),"^")_" "_$P(^PS(50.606,$P(^PS(50.7,$P(X,"^"),0),"^",2),0),"^"))
.S SDT=$P(X,"^",9),PSODCDT=$P(X,"^",7) ;*331
.S (PSOACT,PSODC)=0
.I 'PSODCDT S PSOACT=1
.I PSODCDT S PSODC=1
.I PSOACT D ;ACTIVE NON-VA MED
..I 'SDT D TMPBLD Q
..I $E(SDT,4,5),$E(SDT,6,7) D
...I SDT>$G(PSOEDT) Q
...D TMPBLD ;MED START DATE PRIOR TO PARAM. END DATE
..I $E(SDT,4,5),'$E(SDT,6,7) D Q
...S SDT1=$E(SDT,1,5),BDT1=$E(+$G(PSOBDT),1,5),EDT1=$E(+$G(PSOEDT),1,5)
...I SDT1>EDT1 Q
...D TMPBLD ;MED START DATE PRIOR TO PARAM. END DATE
..I '$E(SDT,4,5),'$E(SDT,6,7) D Q
...S SDT1=$E(SDT,1,3),BDT1=$E(+$G(PSOBDT),1,3),EDT1=$E(+$G(PSOEDT),1,3)
...I SDT1>EDT1 Q
...D TMPBLD ;MED START DATE PRIOR TO PARAM. END DATE
.I PSODC D ;DISCONTINUED NON-VA MED
..I SDT="",PSODCDT>$G(PSOBDT) D TMPBLD Q ;NO MED START DATE AND MED DC DATE AFTER PARAM START DATE
..I PSODCDT<$G(PSOBDT) Q ;QUIT IF MED DC DATE BEFORE PARAM START DATE
..I SDT>$G(PSOEDT) Q ;QUIT IF MED START DATE AFTER PARAM END DATE
..D TMPBLD Q
Q
TMPBLD S TFN=$G(TFN)+1,ST="ACTIVE"
S ^TMP("PS1",$J,DRG,ST,TFN,0)=I_"N;O^"_DRG
S $P(^TMP("PS1",$J,DRG,ST,TFN,0),"^",8)=$P(X,"^",8)_"^"_$S($P(X,"^",7):"DISCONTINUED",1:"ACTIVE")
S ^TMP("PS1",$J,DRG,ST,TFN,"SCH",0)=1,^TMP("PS1",$J,DRG,ST,TFN,"SCH",1,0)=$P(X,"^",5)
S ^TMP("PS1",$J,DRG,ST,TFN,"SIG",0)=1,^TMP("PS1",$J,DRG,ST,TFN,"SIG",1,0)=$P(X,"^",3)_" "_$P(X,"^",4)_" "_$P(X,"^",5)
S:$P($G(^PS(55,DFN,"NVA",I,2)),U)]"" ^TMP("PS1",$J,DRG,ST,TFN,"IND",0)=$P($G(^PS(55,DFN,"NVA",I,2)),U) ;*441-IND
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOORRL3 6185 printed Dec 13, 2024@02:32:20 Page 2
PSOORRL3 ;BHAM ISC/SJA - returns patient's outpatient meds-new sort ;Dec 10, 2021@09:33:28
+1 ;;7.0;OUTPATIENT PHARMACY;**225,331,381,622,441**;DEC 1997;Build 208
+2 ;External reference to ^PS(55 supported by DBIA 2228
+3 ;External reference to ^PSDRUG supported by DBIA 221
+4 ;External reference to ^VA(200 supported by DBIA 10060
+5 ;External reference to ^PS(51.2 supported by DBIA 2226
+6 ;External reference to ^PS(50.7 supported by DBIA 2223
+7 ;External reference to ^PS(50.606 supported by DBIA 2174
+8 ;External reference to OCL^PSJORRE supported by DBIA 2383
OCL ;entry point to return condensed list
+1 ;BHW;PSO*7*159;New SD* Variables
+2 NEW SD,SDT,SDT1,PSG,PST,PSD,DRUG,PSOSTA
+3 if $PIECE($GET(^PS(55,DFN,0)),"^",6)'=2
DO EN^PSOHLUP(DFN)
+4 KILL ^TMP("PS",$JOB),^TMP("PSO",$JOB),^TMP("PS1",$JOB)
+5 SET TFN=0
SET PSBDT=$GET(BDT)
SET PSEDT=$GET(EDT)
IF +$GET(PSBDT)<1
SET X1=DT
SET X2=-120
DO C^%DTC
SET PSBDT=X
+6 SET EXDT=PSBDT-1
SET IFN=0
+7 FOR
SET EXDT=$ORDER(^PS(55,DFN,"P","A",EXDT))
if 'EXDT
QUIT
FOR
SET IFN=$ORDER(^PS(55,DFN,"P","A",EXDT,IFN))
if 'IFN
QUIT
if $DATA(^PSRX(IFN,0))
Begin DoDot:1
+8 SET PSOSTA=$PIECE($GET(^PSRX(IFN,"STA")),"^")
if '(PSOSTA=0!(PSOSTA=11)!(PSOSTA=5)!(PSOSTA=3)!(PSOSTA=16))
QUIT
+9 SET TFN=TFN+1
SET RX0=^PSRX(IFN,0)
SET RX2=$GET(^(2))
SET RX3=$GET(^(3))
SET STA=+$GET(^("STA"))
SET TRM=0
SET LSTFD=$PIECE(RX2,"^",2)
SET LSTRD=$PIECE(RX2,"^",13)
SET LSTDS=$PIECE(RX0,"^",8)
+10 FOR I=0:0
SET I=$ORDER(^PSRX(IFN,1,I))
if 'I
QUIT
SET TRM=TRM+1
SET LSTFD=$PIECE(^PSRX(IFN,1,I,0),"^")
SET LSTDS=$PIECE(^(0),"^",10)
if $PIECE(^(0),"^",18)]""
SET LSTRD=$PIECE(^(0),"^",18)
+11 SET ST0=STA
SET ST=$PIECE("ERROR^ACTIVE^^^HOLD^^ACTIVE/SUSP^^^^^^EXPIRED^^^^^HOLD^","^",ST0+2)
+12 ;441 PAPI
IF STA=0
IF +$GET(^PSRX(IFN,"PARK"))
SET ST="ACTIVE/PARKED"
+13 SET DRUG=$PIECE($GET(^PSDRUG(+$PIECE(RX0,"^",6),0)),"^")
+14 SET ^TMP("PSO",$JOB,DRUG,ST,TFN,0)=IFN_"R;O"_"^"_DRUG_"^^"_$PIECE(RX2,"^",6)_"^"_($PIECE(RX0,"^",9)-TRM)_"^^^"_$PIECE($GET(^PSRX(IFN,"OR1")),"^",2)
+15 SET ^TMP("PSO",$JOB,DRUG,ST,TFN,"P",0)=$PIECE(RX0,"^",4)_"^"_$PIECE($GET(^VA(200,+$PIECE(RX0,"^",4),0)),"^")
+16 SET ^TMP("PSO",$JOB,DRUG,ST,TFN,0)=^TMP("PSO",$JOB,DRUG,ST,TFN,0)_"^"_ST_"^"_LSTFD_"^"_$PIECE(RX0,"^",8)_"^"_$PIECE(RX0,"^",7)_"^^^"_$PIECE(RX0,"^",13)_"^"_LSTRD_"^"_LSTDS
+17 SET ^TMP("PSO",$JOB,DRUG,ST,TFN,"SCH",0)=0
+18 SET (SCH,SC)=0
FOR
SET SC=$ORDER(^PSRX(IFN,"SCH",SC))
if 'SC
QUIT
SET SCH=SCH+1
SET ^TMP("PSO",$JOB,DRUG,ST,TFN,"SCH",SCH,0)=$PIECE(^PSRX(IFN,"SCH",SC,0),"^")
SET ^TMP("PSO",$JOB,DRUG,ST,TFN,"SCH",0)=^TMP("PSO",$JOB,DRUG,ST,TFN,"SCH",0)+1
+19 SET ^TMP("PSO",$JOB,DRUG,ST,TFN,"MDR",0)=0
SET (MDR,MR)=0
FOR
SET MR=$ORDER(^PSRX(IFN,"MEDR",MR))
if 'MR
QUIT
Begin DoDot:2
+20 if '$DATA(^PS(51.2,+^PSRX(IFN,"MEDR",MR,0),0))
QUIT
SET MDR=MDR+1
+21 IF $PIECE($GET(^PS(51.2,+^PSRX(IFN,"MEDR",MR,0),0)),"^",3)]""
SET ^TMP("PSO",$JOB,DRUG,ST,TFN,"MDR",MDR,0)=$PIECE(^PS(51.2,+^PSRX(IFN,"MEDR",MR,0),0),"^",3)
+22 IF $DATA(^PS(51.2,+^PSRX(IFN,"MEDR",MR,0),0))
IF $PIECE($GET(^(0)),"^",3)']""
SET ^TMP("PSO",$JOB,DRUG,ST,TFN,"MDR",MDR,0)=$PIECE(^PS(51.2,+^PSRX(IFN,"MEDR",MR,0),0),"^")
+23 SET ^TMP("PSO",$JOB,DRUG,ST,TFN,"MDR",0)=^TMP("PSO",$JOB,DRUG,ST,TFN,"MDR",0)+1
End DoDot:2
+24 SET PSOELSE=0
IF $DATA(^PSRX(IFN,"SIG"))
IF '$PIECE(^PSRX(IFN,"SIG"),"^",2)
SET PSOELSE=1
SET X=$PIECE(^PSRX(IFN,"SIG"),"^")
DO SIG1^PSOORRL1
+25 IF '$GET(PSOELSE)
SET ITFN=1
Begin DoDot:2
+26 SET ^TMP("PSO",$JOB,DRUG,ST,TFN,"SIG",ITFN,0)=$GET(^PSRX(IFN,"SIG1",1,0))
SET ^TMP("PSO",$JOB,DRUG,ST,TFN,"SIG",0)=+$GET(^TMP("PSO",$JOB,DRUG,ST,TFN,"SIG",0))+1
+27 FOR I=1:0
SET I=$ORDER(^PSRX(IFN,"SIG1",I))
if 'I
QUIT
SET ITFN=ITFN+1
SET ^TMP("PSO",$JOB,DRUG,ST,TFN,"SIG",ITFN,0)=^PSRX(IFN,"SIG1",I,0)
SET ^TMP("PSO",$JOB,DRUG,ST,TFN,"SIG",0)=+$GET(^TMP("PSO",$JOB,DRUG,ST,TFN,"SIG",0))+1
End DoDot:2
+28 ;*441-IND
if $PIECE($GET(^PSRX(IFN,"IND")),U)]""
SET ^TMP("PSO",$JOB,DRUG,ST,TFN,"IND",0)=$PIECE(^PSRX(IFN,"IND"),U)
End DoDot:1
+29 KILL PSOELSE
DO NVA
+30 SET PSG=""
SET J=1
FOR
SET PSG=$ORDER(^TMP("PSO",$JOB,PSG))
if PSG=""
QUIT
SET PST=""
FOR
SET PST=$ORDER(^TMP("PSO",$JOB,PSG,PST))
if PST=""
QUIT
SET I=0
FOR
SET I=$ORDER(^TMP("PSO",$JOB,PSG,PST,I))
if 'I
QUIT
Begin DoDot:1
+31 MERGE ^TMP("PS",$JOB,J)=^TMP("PSO",$JOB,PSG,PST,I)
SET J=J+1
End DoDot:1
+32 SET PSG=""
FOR
SET PSG=$ORDER(^TMP("PS1",$JOB,PSG))
if PSG=""
QUIT
SET PST=""
FOR
SET PST=$ORDER(^TMP("PS1",$JOB,PSG,PST))
if PST=""
QUIT
SET I=0
FOR
SET I=$ORDER(^TMP("PS1",$JOB,PSG,PST,I))
if I=""
QUIT
Begin DoDot:1
+33 MERGE ^TMP("PS",$JOB,J)=^TMP("PS1",$JOB,PSG,PST,I)
SET J=J+1
End DoDot:1
+34 KILL ^TMP("PSO",$JOB),^TMP("PS1",$JOB)
+35 DO OCL^PSJORRE(DFN,$GET(PSOBDTIN),$GET(PSOEDTIN),.TFN,+$GET(VIEW))
+36 DO END^PSOORRL1
+37 KILL SDT,SDT1,ST,DRUG,PSG,PST,PSD,EDT,EDT1,BDT,DBT1,X
+38 QUIT
NVA ; Set Non-VA Med Orders in the ^TMP Global
+1 ;BHW;PSO*7*159;New SDT,SDT1 Variables
+2 ;BDT - ORCH CONTEXT MEDS START DATE
+3 ;EDT - ORCH CONTEXT MEDS END DATE
+4 ;SDT - NON-VA MED START DATE
+5 ;PSODCDT - NON-VA MED DISCONTINUE DATE
+6 NEW SDT,SDT1,PSOACT,PSODC,PSODCDT,PSOBDT,PSOEDT
+7 SET PSOBDT=$GET(BDT)
SET PSOEDT=$GET(EDT)
+8 ;*381
IF 'PSOBDT
IF 'PSOEDT
SET PSOBDT=PSBDT
SET PSOEDT=DT
+9 ;*381
IF PSOBDT
IF 'PSOEDT
SET PSOEDT=DT
+10 FOR I=0:0
SET I=$ORDER(^PS(55,DFN,"NVA",I))
if 'I
QUIT
SET X=$GET(^PS(55,DFN,"NVA",I,0))
Begin DoDot:1
+11 if '$PIECE(X,"^")
QUIT
+12 ;*441-Complex dose
IF $ORDER(^PS(55,DFN,"NVA",I,3,0))
DO NVANEW^PSOORRLO
QUIT
+13 SET DRG=$SELECT($PIECE(X,"^",2):$PIECE($GET(^PSDRUG($PIECE(X,"^",2),0)),"^"),1:$PIECE(^PS(50.7,$PIECE(X,"^"),0),"^")_" "_$PIECE(^PS(50.606,$PIECE(^PS(50.7,$PIECE(X,"^"),0),"^",2),0),"^"))
+14 ;*331
SET SDT=$PIECE(X,"^",9)
SET PSODCDT=$PIECE(X,"^",7)
+15 SET (PSOACT,PSODC)=0
+16 IF 'PSODCDT
SET PSOACT=1
+17 IF PSODCDT
SET PSODC=1
+18 ;ACTIVE NON-VA MED
IF PSOACT
Begin DoDot:2
+19 IF 'SDT
DO TMPBLD
QUIT
+20 IF $EXTRACT(SDT,4,5)
IF $EXTRACT(SDT,6,7)
Begin DoDot:3
+21 IF SDT>$GET(PSOEDT)
QUIT
+22 ;MED START DATE PRIOR TO PARAM. END DATE
DO TMPBLD
End DoDot:3
+23 IF $EXTRACT(SDT,4,5)
IF '$EXTRACT(SDT,6,7)
Begin DoDot:3
+24 SET SDT1=$EXTRACT(SDT,1,5)
SET BDT1=$EXTRACT(+$GET(PSOBDT),1,5)
SET EDT1=$EXTRACT(+$GET(PSOEDT),1,5)
+25 IF SDT1>EDT1
QUIT
+26 ;MED START DATE PRIOR TO PARAM. END DATE
DO TMPBLD
End DoDot:3
QUIT
+27 IF '$EXTRACT(SDT,4,5)
IF '$EXTRACT(SDT,6,7)
Begin DoDot:3
+28 SET SDT1=$EXTRACT(SDT,1,3)
SET BDT1=$EXTRACT(+$GET(PSOBDT),1,3)
SET EDT1=$EXTRACT(+$GET(PSOEDT),1,3)
+29 IF SDT1>EDT1
QUIT
+30 ;MED START DATE PRIOR TO PARAM. END DATE
DO TMPBLD
End DoDot:3
QUIT
End DoDot:2
+31 ;DISCONTINUED NON-VA MED
IF PSODC
Begin DoDot:2
+32 ;NO MED START DATE AND MED DC DATE AFTER PARAM START DATE
IF SDT=""
IF PSODCDT>$GET(PSOBDT)
DO TMPBLD
QUIT
+33 ;QUIT IF MED DC DATE BEFORE PARAM START DATE
IF PSODCDT<$GET(PSOBDT)
QUIT
+34 ;QUIT IF MED START DATE AFTER PARAM END DATE
IF SDT>$GET(PSOEDT)
QUIT
+35 DO TMPBLD
QUIT
End DoDot:2
End DoDot:1
+36 QUIT
TMPBLD SET TFN=$GET(TFN)+1
SET ST="ACTIVE"
+1 SET ^TMP("PS1",$JOB,DRG,ST,TFN,0)=I_"N;O^"_DRG
+2 SET $PIECE(^TMP("PS1",$JOB,DRG,ST,TFN,0),"^",8)=$PIECE(X,"^",8)_"^"_$SELECT($PIECE(X,"^",7):"DISCONTINUED",1:"ACTIVE")
+3 SET ^TMP("PS1",$JOB,DRG,ST,TFN,"SCH",0)=1
SET ^TMP("PS1",$JOB,DRG,ST,TFN,"SCH",1,0)=$PIECE(X,"^",5)
+4 SET ^TMP("PS1",$JOB,DRG,ST,TFN,"SIG",0)=1
SET ^TMP("PS1",$JOB,DRG,ST,TFN,"SIG",1,0)=$PIECE(X,"^",3)_" "_$PIECE(X,"^",4)_" "_$PIECE(X,"^",5)
+5 ;*441-IND
if $PIECE($GET(^PS(55,DFN,"NVA",I,2)),U)]""
SET ^TMP("PS1",$JOB,DRG,ST,TFN,"IND",0)=$PIECE($GET(^PS(55,DFN,"NVA",I,2)),U)
+6 QUIT
