- PSOP2 ;BIR/SAB - medication profile long or short ;May 20, 2020@10:17
- ;;7.0;OUTPATIENT PHARMACY;**15,98,132,326,441**;DEC 1997;Build 208
- ;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
- 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),"^")
- 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: " N AAAA 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)
- .W:$P($G(^PS(52.41,PENDREX,4)),"^",2)]"" !,?1,"Indication: "_$P(^PS(52.41,PENDREX,4),"^",2) ;*441-IND
- 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 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
- .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")
- ..W:$P($G(^PS(55,DFN,"NVA",PPP,2)),"^")]"" !,?2,"Indication: "_$P(^PS(55,DFN,"NVA",PPP,2),"^") ;*441-IND
- .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)
- .W:$P($G(^PS(55,DFN,"NVA",PPP,2)),"^")]"" !,?2,"Indication: "_$P(^PS(55,DFN,"NVA",PPP,2),"^") ;*441-IND
- .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,PRV
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOP2 5924 printed Jan 18, 2025@03:33:39 Page 2
- PSOP2 ;BIR/SAB - medication profile long or short ;May 20, 2020@10:17
- +1 ;;7.0;OUTPATIENT PHARMACY;**15,98,132,326,441**;DEC 1997;Build 208
- +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
- 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 if '$DATA(^PSDRUG(+$PIECE(^PSRX(J,0),"^",6),0))
- QUIT
- SET DRG=$PIECE(^(0),"^")
- +1 IF $GET(DRS)
- Begin DoDot:1
- +2 IF DRG]PSFR
- IF PSTO]DRG
- SET TRDR=1
- End DoDot:1
- if '$GET(TRDR)
- 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 TRDR
- QUIT
- +4 IF $PIECE($GET(^PSRX(J,2)),"^",6)'<PSODTCT
- SET ^TMP($JOB,$EXTRACT(DRG,1,31),J)=^PSRX(J,0)
- KILL TRDR
- +5 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: "
- NEW AAAA
- 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
- +13 ;*441-IND
- if $PIECE($GET(^PS(52.41,PENDREX,4)),"^",2)]""
- WRITE !,?1,"Indication: "_$PIECE(^PS(52.41,PENDREX,4),"^",2)
- End DoDot:1
- +14 IF '$GET(PQT)
- IF $EXTRACT(IOST)="C"
- DO DIR^PSOP1
- +15 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
- 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 if '$PIECE(NVAOR,"^")
- QUIT
- +5 IF $Y+10>IOSL
- IF $EXTRACT(IOST)="C"
- DO DIR^PSOP1
- if $DATA(PQT)
- QUIT
- WRITE @IOF
- +6 IF $Y+11>IOSL
- IF $EXTRACT(IOST)'="C"
- DO HD1
- +7 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)),"^"))
- +8 IF PLS="S"
- Begin DoDot:2
- +9 WRITE !?2,"Dosage: "_$PIECE(NVAOR,"^",3)
- +10 WRITE !?2,"Schedule: "_$PIECE(NVAOR,"^",5)
- +11 WRITE !?2,"Date Documented: "
- +12 WRITE $EXTRACT($PIECE(NVAOR,"^",10),4,5)_"/"_$EXTRACT($PIECE(NVAOR,"^",10),6,7)_"/"_$EXTRACT($PIECE(NVAOR,"^",10),2,3)
- +13 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")
- +14 ;*441-IND
- if $PIECE($GET(^PS(55,DFN,"NVA",PPP,2)),"^")]""
- WRITE !,?2,"Indication: "_$PIECE(^PS(55,DFN,"NVA",PPP,2),"^")
- 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 ;*441-IND
- if $PIECE($GET(^PS(55,DFN,"NVA",PPP,2)),"^")]""
- WRITE !,?2,"Indication: "_$PIECE(^PS(55,DFN,"NVA",PPP,2),"^")
- +23 IF ($Y+5)>IOSL
- IF $EXTRACT(IOST)'="C"
- DO HD1
- +24 IF $ORDER(^PS(55,DFN,"NVA",PPP,"OCK",0))
- WRITE !?2,"Order Check(s):"
- Begin DoDot:2
- +25 IF ($Y+5)>IOSL
- IF $EXTRACT(IOST)'="C"
- DO HD1
- WRITE !?2,"Order Check(s):"
- +26 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
- +27 IF ($Y+5)>IOSL
- IF $EXTRACT(IOST)'="C"
- DO HD1
- +28 IF $ORDER(^PS(55,DFN,"NVA",PPP,"OCK",NVAP,"OVR",0))
- WRITE !?5,"Override Reason: "
- Begin DoDot:4
- +29 IF ($Y+5)>IOSL
- IF $EXTRACT(IOST)'="C"
- DO HD1
- +30 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):"
- +31 WRITE ?2,"Override Provider: "_$PIECE(^VA(200,PRV,0),"^"),!
- End DoDot:2
- +32 IF ($Y+5)>IOSL
- IF $EXTRACT(IOST)'="C"
- DO HD1
- +33 IF $ORDER(^PS(55,DFN,"NVA",PPP,"DSC",0))
- WRITE !?2,"Statement/Explanation/Comments: "
- Begin DoDot:2
- +34 IF ($Y+5)>IOSL
- IF $EXTRACT(IOST)'="C"
- DO HD1
- +35 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
- +36 WRITE !
- KILL NVA,NVAP,NVAPR,NVAOR,PRV
- +37 QUIT