PSOP2 ;BIR/SAB - medication profile long or short ;29-May-2012 15:04;PLS
;;7.0;OUTPATIENT PHARMACY;**15,98,132,1013,326,1015**;DEC 1997;Build 62
;External reference to File #55 supported by DBIA 2228
;External reference to PSDRUG supported by DBIA 221
;External reference ^PS(50.606 supported by DBIA 2174
;External reference ^PS(50.7 supported by DBIA 2223
;
;Modified - IHS/MSC/PLS - 11/08/2011 - Line DRUG+1
DATE I $G(DTS) D Q:'$G(TRDT)
.S:$P(^PSRX(J,0),"^",13)'<SDT&($P(^(0),"^",13)'>EDT) TRDT=1
S X=$P(^PSRX(J,0),"^",13),X=999999999-X,^TMP($J,X,J)=^(0) K TRDT
Q
DRUG ;Q:'$D(^PSDRUG(+$P(^PSRX(J,0),"^",6),0)) S DRG=$P(^(0),"^")
Q:'$D(^PSDRUG(+$P(^PSRX(J,0),"^",6),0)) S DRG=$$UP^XLFSTR($P(^(0),"^")) ;IHS/MSC/PLS - 11/08/2011
I $G(DRS) D Q:'$G(TRDR)
.I DRG]PSFR,PSTO]DRG S TRDR=1
I $P($G(^PSRX(J,3)),"^",5),$P($G(^PSRX(J,3)),"^",5)<PSODTCT,$P($G(^("STA")),"^")>11,$P($G(^("STA")),"^")'=16 K TRDR Q
I $P($G(^PSRX(J,2)),"^",6)'<PSODTCT S ^TMP($J,$E(DRG,1,31),J)=^PSRX(J,0) K TRDR
Q
CLSS Q:'$D(^PSDRUG(+$P(^PSRX(J,0),"^",6),0)) S DRG=$P(^(0),"^",2)
I $G(CLS) D Q:'$G(TRCL)
.I DRG]PSFR,PSTO]DRG S TRCL=1
I $P($G(^PSRX(J,3)),"^",5),$P($G(^PSRX(J,3)),"^",5)<PSODTCT,$P($G(^("STA")),"^")>11,$P($G(^("STA")),"^")'=16 K TRCL Q
I $P($G(^PSRX(J,2)),"^",6)'<PSODTCT S ^TMP($J,$S(DRG]"":$E(DRG,1,31),1:"UNKNOWN"),J)=^PSRX(J,0) K TRCL
Q
PEND ;list pending orders
S PPPCNT=1 F PPP=0:0 S PPP=$O(^PS(52.41,"P",DFN,PPP)) Q:'PPP S PPPSTAT=$P($G(^PS(52.41,PPP,0)),"^",3) I PPPSTAT="NW"!(PPPSTAT="HD")!(PPPSTAT="RNW") D
.S PSOPEND(PPPCNT)=PPP_"^"_$S(+$P($G(^PS(52.41,PPP,0)),"^",9):"DD",1:"OI")_"^"_$P($G(^(0)),"^",5)_"^"_$P(^(0),"^",6)_"^"_$P(^(0),"^",10)_"^"_$P(^(0),"^",11) S PPPCNT=PPPCNT+1
Q:PPPCNT=1 I $E(IOST)="C" D DIR^PSOP1 Q:$G(PQT)
D HD1 S PPCOUNT=1 F EEEE=0:0 S EEEE=$O(PSOPEND(EEEE)) Q:'EEEE!($G(PQT)) D
.S PENDREX=$P(PSOPEND(EEEE),"^"),PPDIS=$P($G(^PS(52.41,PENDREX,0)),"^",9),PPOI=$P($G(^(0)),"^",8)
.W:PPCOUNT>1 ! W !,"Drug: ",$S($P(PSOPEND(EEEE),"^",2)="DD":$P($G(^PSDRUG(+PPDIS,0)),"^"),1:$P($G(^PS(50.7,+PPOI,0)),"^")_" "_$P($G(^PS(50.606,+$P($G(^(0)),"^",2),0)),"^")),! S PPCOUNT=PPCOUNT+1
.W ?1,"Eff. Date: ",$E($P(PSOPEND(EEEE),"^",4),4,5)_"-"_$E($P(PSOPEND(EEEE),"^",4),6,7)_"-"_$E($P(PSOPEND(EEEE),"^",4),2,3),?22,"Qty: ",$P(PSOPEND(EEEE),"^",5),?40,"Refills: ",$P(PSOPEND(EEEE),"^",6)
.K DIC,X,Y S DIC="^VA(200,",DIC(0)="M",X="`"_+$P(PSOPEND(EEEE),"^",3) D ^DIC K DIC,X
.W ?52,"Prov: "_$E($P(Y,"^",2),1,21)
.D:($Y+5>IOSL)&($E(IOST)="C") DIR^PSOP1 Q:$G(PQT) D:$Y+5>IOSL HD1
.S PCOUNT=1 W !?1,"Sig: " F AAAA=0:0 S AAAA=$O(^PS(52.41,PENDREX,"SIG",AAAA)) Q:'AAAA!($G(PQT)) W:PCOUNT>1 ! W ?6,$G(^PS(52.41,PENDREX,"SIG",AAAA,0)) S PCOUNT=PCOUNT+1 D:($Y+5>IOSL)&($E(IOST)="C") DIR^PSOP1 Q:$G(PQT) D:$Y+5>IOSL
..D HD1 S PPCOUNT=$S('$O(^PS(52.41,PENDREX,"SIG",AAAA)):1,1:PPCOUNT)
I '$G(PQT),$E(IOST)="C" D DIR^PSOP1
Q
HD1 ;W @IOF W !,?29,"PENDING ORDERS",!,PSOPLINE
I $G(PLS)="L" S PAGE=PAGE+1
W @IOF W !,"Patient: "_$P($G(^DPT(DFN,0)),"^"),?70,"Page: "_PAGE,!?21,$S($G(NVA):"Non-VA MEDS (Not Dispensed by VA)",1:"Pending Outpatient Orders"),!,PSOPLINE
I $G(PLS)="S" S PAGE=PAGE+1
Q
NVA ;non-va meds
Q:'$O(^PS(55,DFN,"NVA",0))
W !!,PSOPLINE,!?(80-$L("Non-VA MEDS (Not Dispensed by VA)"))/2,"Non-VA MEDS (Not Dispensed by VA)",!
K PQT S PCNT=1 F PPP=0:0 S PPP=$O(^PS(55,DFN,"NVA",PPP)) Q:'PPP!($G(PQT)) S NVAOR=^PS(55,DFN,"NVA",PPP,0),NVA=1 D
.;I PCNT D HD1 S PCNT=0
.Q:'$P(NVAOR,"^")
.I $Y+10>IOSL,$E(IOST)="C" D DIR^PSOP1 Q:$D(PQT) W @IOF
.I $Y+11>IOSL,$E(IOST)'="C" D HD1
.W !!,$S($P(NVAOR,"^",2):$P($G(^PSDRUG(+$P(NVAOR,"^",2),0)),"^"),1:$P($G(^PS(50.7,$P(NVAOR,"^"),0)),"^")_" "_$P($G(^PS(50.606,+$P($G(^(0)),"^",2),0)),"^"))
.I PLS="S" D Q
..W !?2,"Dosage: "_$P(NVAOR,"^",3)
..W !?2,"Schedule: "_$P(NVAOR,"^",5)
..W !?2,"Date Documented: "
..W $E($P(NVAOR,"^",10),4,5)_"/"_$E($P(NVAOR,"^",10),6,7)_"/"_$E($P(NVAOR,"^",10),2,3)
..W !?2,"Status: "_$S($P(NVAOR,"^",7):"Discontinued ("_$E($P(NVAOR,"^",7),4,5)_"/"_$E($P(NVAOR,"^",7),6,7)_"/"_$E($P(NVAOR,"^",7),2,3)_")",1:"Active")
.I ($Y+5)>IOSL,$E(IOST)'="C" D HD1
.W !?2,"Dosage: "_$P(NVAOR,"^",3)
.W !?2,"Schedule: "_$P(NVAOR,"^",5)
.W !?2,"Route: "_$P(NVAOR,"^",4)
.W !?2,"Status: "_$S($P(NVAOR,"^",7):"Discontinued ("_$E($P(NVAOR,"^",7),4,5)_"/"_$E($P(NVAOR,"^",7),6,7)_"/"_$E($P(NVAOR,"^",7),2,3)_")",1:"Active")
.W !?2,"Start Date: "_$E($P(NVAOR,"^",9),4,5)_"/"_$E($P(NVAOR,"^",9),6,7)_"/"_$E($P(NVAOR,"^",9),2,3),?$X+5,"CPRS Order #: "_$P(NVAOR,"^",8)
.W !?2,"Documented By: "_$S($G(^VA(200,$P(NVAOR,"^",11),0))]"":$P(^VA(200,$P(NVAOR,"^",11),0),"^"),1:"Unknown")_" on "_$E($P(NVAOR,"^",10),4,5)_"/"_$E($P(NVAOR,"^",10),6,7)_"/"_$E($P(NVAOR,"^",10),2,3)
.I ($Y+5)>IOSL,$E(IOST)'="C" D HD1
.I $O(^PS(55,DFN,"NVA",PPP,"OCK",0)) W !?2,"Order Check(s):" D
..I ($Y+5)>IOSL,$E(IOST)'="C" D HD1 W !?2,"Order Check(s):"
..F NVAP=0:0 S NVAP=$O(^PS(55,DFN,"NVA",PPP,"OCK",NVAP)) Q:'NVAP W !?3,"#"_NVAP_". "_$P(^PS(55,DFN,"NVA",PPP,"OCK",NVAP,0),"^") S PRV=$P(^(0),"^",2) D I ($Y+5)>IOSL,$E(IOST)'="C" D HD1 W !?2,"Order Check(s):"
...I ($Y+5)>IOSL,$E(IOST)'="C" D HD1
...I $O(^PS(55,DFN,"NVA",PPP,"OCK",NVAP,"OVR",0)) W !?5,"Override Reason: " D
....I ($Y+5)>IOSL,$E(IOST)'="C" D HD1
....F NVAPR=0:0 S NVAPR=$O(^PS(55,DFN,"NVA",PPP,"OCK",NVAP,"OVR",NVAPR)) Q:'NVAPR W ?22,^PS(55,DFN,"NVA",PPP,"OCK",NVAP,"OVR",NVAPR,0),!
..W ?2,"Override Provider: "_$P(^VA(200,PRV,0),"^"),!
.I ($Y+5)>IOSL,$E(IOST)'="C" D HD1
.I $O(^PS(55,DFN,"NVA",PPP,"DSC",0)) W !?2,"Statement/Explanation/Comments: " D
..I ($Y+5)>IOSL,$E(IOST)'="C" D HD1
..F NVAP=0:0 S NVAP=$O(^PS(55,DFN,"NVA",PPP,"DSC",NVAP)) Q:'NVAP W $P(^PS(55,DFN,"NVA",PPP,"DSC",NVAP,0),"^"),!?34
W ! K NVA,NVAP,NVAPR,NVAOR
Q
PSOP2 ;BIR/SAB - medication profile long or short ;29-May-2012 15:04;PLS
+1 ;;7.0;OUTPATIENT PHARMACY;**15,98,132,1013,326,1015**;DEC 1997;Build 62
+2 ;External reference to File #55 supported by DBIA 2228
+3 ;External reference to PSDRUG supported by DBIA 221
+4 ;External reference ^PS(50.606 supported by DBIA 2174
+5 ;External reference ^PS(50.7 supported by DBIA 2223
+6 ;
+7 ;Modified - IHS/MSC/PLS - 11/08/2011 - Line DRUG+1
DATE IF $GET(DTS)
Begin DoDot:1
+1 IF $PIECE(^PSRX(J,0),"^",13)'<SDT&($PIECE(^(0),"^",13)'>EDT)
SET TRDT=1
End DoDot:1
IF '$GET(TRDT)
QUIT
+2 SET X=$PIECE(^PSRX(J,0),"^",13)
SET X=999999999-X
SET ^TMP($JOB,X,J)=^(0)
KILL TRDT
+3 QUIT
DRUG ;Q:'$D(^PSDRUG(+$P(^PSRX(J,0),"^",6),0)) S DRG=$P(^(0),"^")
+1 ;IHS/MSC/PLS - 11/08/2011
IF '$DATA(^PSDRUG(+$PIECE(^PSRX(J,0),"^",6),0))
QUIT
SET DRG=$$UP^XLFSTR($PIECE(^(0),"^"))
+2 IF $GET(DRS)
Begin DoDot:1
+3 IF DRG]PSFR
IF PSTO]DRG
SET TRDR=1
End DoDot:1
IF '$GET(TRDR)
QUIT
+4 IF $PIECE($GET(^PSRX(J,3)),"^",5)
IF $PIECE($GET(^PSRX(J,3)),"^",5)<PSODTCT
IF $PIECE($GET(^("STA")),"^")>11
IF $PIECE($GET(^("STA")),"^")'=16
KILL TRDR
QUIT
+5 IF $PIECE($GET(^PSRX(J,2)),"^",6)'<PSODTCT
SET ^TMP($JOB,$EXTRACT(DRG,1,31),J)=^PSRX(J,0)
KILL TRDR
+6 QUIT
CLSS IF '$DATA(^PSDRUG(+$PIECE(^PSRX(J,0),"^",6),0))
QUIT
SET DRG=$PIECE(^(0),"^",2)
+1 IF $GET(CLS)
Begin DoDot:1
+2 IF DRG]PSFR
IF PSTO]DRG
SET TRCL=1
End DoDot:1
IF '$GET(TRCL)
QUIT
+3 IF $PIECE($GET(^PSRX(J,3)),"^",5)
IF $PIECE($GET(^PSRX(J,3)),"^",5)<PSODTCT
IF $PIECE($GET(^("STA")),"^")>11
IF $PIECE($GET(^("STA")),"^")'=16
KILL TRCL
QUIT
+4 IF $PIECE($GET(^PSRX(J,2)),"^",6)'<PSODTCT
SET ^TMP($JOB,$SELECT(DRG]"":$EXTRACT(DRG,1,31),1:"UNKNOWN"),J)=^PSRX(J,0)
KILL TRCL
+5 QUIT
PEND ;list pending orders
+1 SET PPPCNT=1
FOR PPP=0:0
SET PPP=$ORDER(^PS(52.41,"P",DFN,PPP))
IF 'PPP
QUIT
SET PPPSTAT=$PIECE($GET(^PS(52.41,PPP,0)),"^",3)
IF PPPSTAT="NW"!(PPPSTAT="HD")!(PPPSTAT="RNW")
Begin DoDot:1
+2 SET PSOPEND(PPPCNT)=PPP_"^"_$SELECT(+$PIECE($GET(^PS(52.41,PPP,0)),"^",9):"DD",1:"OI")_"^"_$PIECE($GET(^(0)),"^",5)_"^"_$PIECE(^(0),"^",6)_"^"_$PIECE(^(0),"^",10)_"^"_$PIECE(^(0),"^",11)
SET PPPCNT=PPPCNT+1
End DoDot:1
+3 IF PPPCNT=1
QUIT
IF $EXTRACT(IOST)="C"
DO DIR^PSOP1
IF $GET(PQT)
QUIT
+4 DO HD1
SET PPCOUNT=1
FOR EEEE=0:0
SET EEEE=$ORDER(PSOPEND(EEEE))
IF 'EEEE!($GET(PQT))
QUIT
Begin DoDot:1
+5 SET PENDREX=$PIECE(PSOPEND(EEEE),"^")
SET PPDIS=$PIECE($GET(^PS(52.41,PENDREX,0)),"^",9)
SET PPOI=$PIECE($GET(^(0)),"^",8)
+6 IF PPCOUNT>1
WRITE !
WRITE !,"Drug: ",$SELECT($PIECE(PSOPEND(EEEE),"^",2)="DD":$PIECE($GET(^PSDRUG(+PPDIS,0)),"^"),1:$PIECE($GET(^PS(50.7,+PPOI,0)),"^")_" "_$PIECE($GET(^PS(50.606,+$PIECE($GET(^(0)),"^",2),0)),"^")),!
SET PPCOUNT=PPCOUNT+1
+7 WRITE ?1,"Eff. Date: ",$EXTRACT($PIECE(PSOPEND(EEEE),"^",4),4,5)_"-"_$EXTRACT($PIECE(PSOPEND(EEEE),"^",4),6,7)_"-"_$EXTRACT($PIECE(PSOPEND(EEEE),"^",4),2,3),?22,"Qty: ",$PIECE(PSOPEND(EEEE),"^",5),?40,"Refills: ",$PIECE(PSOPEND(EEEE),"^
",6)
+8 KILL DIC,X,Y
SET DIC="^VA(200,"
SET DIC(0)="M"
SET X="`"_+$PIECE(PSOPEND(EEEE),"^",3)
DO ^DIC
KILL DIC,X
+9 WRITE ?52,"Prov: "_$EXTRACT($PIECE(Y,"^",2),1,21)
+10 IF ($Y+5>IOSL)&($EXTRACT(IOST)="C")
DO DIR^PSOP1
IF $GET(PQT)
QUIT
IF $Y+5>IOSL
DO HD1
+11 SET PCOUNT=1
WRITE !?1,"Sig: "
FOR AAAA=0:0
SET AAAA=$ORDER(^PS(52.41,PENDREX,"SIG",AAAA))
IF 'AAAA!($GET(PQT))
QUIT
IF PCOUNT>1
WRITE !
WRITE ?6,$GET(^PS(52.41,PENDREX,"SIG",AAAA,0))
SET PCOUNT=PCOUNT+1
IF ($Y+5>IOSL)&($EXTRACT(IOST)="C")
DO DIR^PSOP1
IF $GET(PQT)
QUIT
IF $Y+5>IOSL
Begin DoDot:2
+12 DO HD1
SET PPCOUNT=$SELECT('$ORDER(^PS(52.41,PENDREX,"SIG",AAAA)):1,1:PPCOUNT)
End DoDot:2
End DoDot:1
+13 IF '$GET(PQT)
IF $EXTRACT(IOST)="C"
DO DIR^PSOP1
+14 QUIT
HD1 ;W @IOF W !,?29,"PENDING ORDERS",!,PSOPLINE
+1 IF $GET(PLS)="L"
SET PAGE=PAGE+1
+2 WRITE @IOF
WRITE !,"Patient: "_$PIECE($GET(^DPT(DFN,0)),"^"),?70,"Page: "_PAGE,!?21,$SELECT($GET(NVA):"Non-VA MEDS (Not Dispensed by VA)",1:"Pending Outpatient Orders"),!,PSOPLINE
+3 IF $GET(PLS)="S"
SET PAGE=PAGE+1
+4 QUIT
NVA ;non-va meds
+1 IF '$ORDER(^PS(55,DFN,"NVA",0))
QUIT
+2 WRITE !!,PSOPLINE,!?(80-$LENGTH("Non-VA MEDS (Not Dispensed by VA)"))/2,"Non-VA MEDS (Not Dispensed by VA)",!
+3 KILL PQT
SET PCNT=1
FOR PPP=0:0
SET PPP=$ORDER(^PS(55,DFN,"NVA",PPP))
IF 'PPP!($GET(PQT))
QUIT
SET NVAOR=^PS(55,DFN,"NVA",PPP,0)
SET NVA=1
Begin DoDot:1
+4 ;I PCNT D HD1 S PCNT=0
+5 IF '$PIECE(NVAOR,"^")
QUIT
+6 IF $Y+10>IOSL
IF $EXTRACT(IOST)="C"
DO DIR^PSOP1
IF $DATA(PQT)
QUIT
WRITE @IOF
+7 IF $Y+11>IOSL
IF $EXTRACT(IOST)'="C"
DO HD1
+8 WRITE !!,$SELECT($PIECE(NVAOR,"^",2):$PIECE($GET(^PSDRUG(+$PIECE(NVAOR,"^",2),0)),"^"),1:$PIECE($GET(^PS(50.7,$PIECE(NVAOR,"^"),0)),"^")_" "_$PIECE($GET(^PS(50.606,+$PIECE($GET(^(0)),"^",2),0)),"^"))
+9 IF PLS="S"
Begin DoDot:2
+10 WRITE !?2,"Dosage: "_$PIECE(NVAOR,"^",3)
+11 WRITE !?2,"Schedule: "_$PIECE(NVAOR,"^",5)
+12 WRITE !?2,"Date Documented: "
+13 WRITE $EXTRACT($PIECE(NVAOR,"^",10),4,5)_"/"_$EXTRACT($PIECE(NVAOR,"^",10),6,7)_"/"_$EXTRACT($PIECE(NVAOR,"^",10),2,3)
+14 WRITE !?2,"Status: "_$SELECT($PIECE(NVAOR,"^",7):"Discontinued ("_$EXTRACT($PIECE(NVAOR,"^",7),4,5)_"/"_$EXTRACT($PIECE(NVAOR,"^",7),6,7)_"/"_$EXTRACT($PIECE(NVAOR,"^",7),2,3)_")",1:"Active")
End DoDot:2
QUIT
+15 IF ($Y+5)>IOSL
IF $EXTRACT(IOST)'="C"
DO HD1
+16 WRITE !?2,"Dosage: "_$PIECE(NVAOR,"^",3)
+17 WRITE !?2,"Schedule: "_$PIECE(NVAOR,"^",5)
+18 WRITE !?2,"Route: "_$PIECE(NVAOR,"^",4)
+19 WRITE !?2,"Status: "_$SELECT($PIECE(NVAOR,"^",7):"Discontinued ("_$EXTRACT($PIECE(NVAOR,"^",7),4,5)_"/"_$EXTRACT($PIECE(NVAOR,"^",7),6,7)_"/"_$EXTRACT($PIECE(NVAOR,"^",7),2,3)_")",1:"Active")
+20 WRITE !?2,"Start Date: "_$EXTRACT($PIECE(NVAOR,"^",9),4,5)_"/"_$EXTRACT($PIECE(NVAOR,"^",9),6,7)_"/"_$EXTRACT($PIECE(NVAOR,"^",9),2,3),?$X+5,"CPRS Order #: "_$PIECE(NVAOR,"^",8)
+21 WRITE !?2,"Documented By: "_$SELECT($GET(^VA(200,$PIECE(NVAOR,"^",11),0))]"":$PIECE(^VA(200,$PIECE(NVAOR,"^",11),0),"^"),1:"Unknown")_" on "_$EXTRACT($PIECE(NVAOR,"^",10),4,5)_"/"_$EXTRACT($PIECE(NVAOR,"^",10),6,7)_"/"_$EXTRACT($PIECE(N
VAOR,"^",10),2,3)
+22 IF ($Y+5)>IOSL
IF $EXTRACT(IOST)'="C"
DO HD1
+23 IF $ORDER(^PS(55,DFN,"NVA",PPP,"OCK",0))
WRITE !?2,"Order Check(s):"
Begin DoDot:2
+24 IF ($Y+5)>IOSL
IF $EXTRACT(IOST)'="C"
DO HD1
WRITE !?2,"Order Check(s):"
+25 FOR NVAP=0:0
SET NVAP=$ORDER(^PS(55,DFN,"NVA",PPP,"OCK",NVAP))
IF 'NVAP
QUIT
WRITE !?3,"#"_NVAP_". "_$PIECE(^PS(55,DFN,"NVA",PPP,"OCK",NVAP,0),"^")
SET PRV=$PIECE(^(0),"^",2)
Begin DoDot:3
+26 IF ($Y+5)>IOSL
IF $EXTRACT(IOST)'="C"
DO HD1
+27 IF $ORDER(^PS(55,DFN,"NVA",PPP,"OCK",NVAP,"OVR",0))
WRITE !?5,"Override Reason: "
Begin DoDot:4
+28 IF ($Y+5)>IOSL
IF $EXTRACT(IOST)'="C"
DO HD1
+29 FOR NVAPR=0:0
SET NVAPR=$ORDER(^PS(55,DFN,"NVA",PPP,"OCK",NVAP,"OVR",NVAPR))
IF 'NVAPR
QUIT
WRITE ?22,^PS(55,DFN,"NVA",PPP,"OCK",NVAP,"OVR",NVAPR,0),!
End DoDot:4
End DoDot:3
IF ($Y+5)>IOSL
IF $EXTRACT(IOST)'="C"
DO HD1
WRITE !?2,"Order Check(s):"
+30 WRITE ?2,"Override Provider: "_$PIECE(^VA(200,PRV,0),"^"),!
End DoDot:2
+31 IF ($Y+5)>IOSL
IF $EXTRACT(IOST)'="C"
DO HD1
+32 IF $ORDER(^PS(55,DFN,"NVA",PPP,"DSC",0))
WRITE !?2,"Statement/Explanation/Comments: "
Begin DoDot:2
+33 IF ($Y+5)>IOSL
IF $EXTRACT(IOST)'="C"
DO HD1
+34 FOR NVAP=0:0
SET NVAP=$ORDER(^PS(55,DFN,"NVA",PPP,"DSC",NVAP))
IF 'NVAP
QUIT
WRITE $PIECE(^PS(55,DFN,"NVA",PPP,"DSC",NVAP,0),"^"),!?34
End DoDot:2
End DoDot:1
+35 WRITE !
KILL NVA,NVAP,NVAPR,NVAOR
+36 QUIT
