PSAVERA1 ;BHM/DB - Edit previously verified invoices;16NOV99
;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**21**; 10/24/97
;References to ^DIC(51.5 are covered by IA #1931
;References to ^PSDRUG( are covered by IA #2095
;
S $P(PSASLN,"=",79)="" K PSALINE
DISPLN S PSALINE=$S('$D(PSALINE):$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,0)),1:$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE))) G Q:PSALINE'>0 S CNT=$G(CNT)+1
S PSADATA=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,0))
S PSATEMP=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,2))
S PSAVSN=$P(PSADATA,"^",12),PSAOUT=0
DRUG S PSADJ=+$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B","D",0))
I $G(PSADJ) D
.S PSANODE=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,PSADJ,0))
.S PSADJD=$S($P(PSANODE,"^",6)'="":$P(PSANODE,"^",6),1:$P(PSANODE,"^",2))
.S PSASUP=$S(PSADJD'?1.N:1,1:0)
.S PSADRG=$S(PSADJ&('PSASUP):$G(PSADJD),PSADJ&(PSASUP):0,1:+$P(PSADATA,"^",2))
.I $G(PSADJD),$L(PSADJD)=+$L(PSADJD),$P($G(^PSDRUG(+PSADJD,0)),"^")'="" S (PSADRG,PSA50IEN)=+PSADJD Q
.I $G(PSADJD),$L(PSADJD)=+$L(PSADJD),$P($G(^PSDRUG(+PSADJD,0)),"^")="" S (PSADJ,PSADRG)=0 Q
.S PSADJSUP=1,(PSADRG,PSA50IEN)=PSADJD
I '$G(PSADJ) D
.S (PSA50IEN,PSADRG)=$S(+$P(PSADATA,"^",2)&($P($G(^PSDRUG(+$P(PSADATA,"^",2),0)),"^")'=""):+$P(PSADATA,"^",2),1:0)
S PSADRUGN=$S($P($G(^PSDRUG(PSADRG,0)),"^")'="":$P($G(^PSDRUG(PSADRG,0)),"^"),1:"Unknown Drug Name")
QTY ;Quantity
;No Adj. Qty
S PSADJQ="",PSADJ=+$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B","Q",0))
I $G(PSADJ) S PSANODE=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,PSADJ,0)),PSADJQ=$S($P(PSANODE,"^",6)'="":+$P(PSANODE,"^",6),1:$P(PSANODE,"^",2))
;Adj. Qty
I $G(PSADJQ) S PSAQTY=PSADJQ
I '$G(PSADJQ) S PSAQTY=$P(PSADATA,"^",3)
UPC S:$P(PSADATA,"^",13) PSAUPC=$P(PSADATA,"^",13)
OU ;W !,"Order Unit : "
S PSAOU=$S(+$P(PSADATA,"^",4)&($P($G(^DIC(51.5,+$P(PSADATA,"^",4),0)),"^")'=""):+$P(PSADATA,"^",4),1:"")
S PSATEMP=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,2))
I +$P(PSATEMP,"^",3),PSADRG,+$P($G(^PSDRUG(PSADRG,1,+$P(PSATEMP,"^",3),0)),"^",5) S PSAOU=+$P(^PSDRUG(PSADRG,1,+$P(PSATEMP,"^",3),0),"^",5)
S PSADJO="",PSADJ=+$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B","O",0))
I $G(PSADJ) S PSANODE=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,PSADJ,0)),PSADJO=$S($P(PSANODE,"^",6)'="":$P(PSANODE,"^",6),1:$P(PSANODE,"^",2))
;Adj. Order Unit
I PSADJO'="" S PSAOU=+PSADJO
I PSADJO="" ;W $S(+PSAOU:$P($G(^DIC(51.5,+PSAOU,0)),"^"),1:"Blank")
;
NDC S PSANDC=$P(PSADATA,"^",11)
;I $E(PSANDC)'="S" W ?38,"NDC: "_$S(PSANDC'="":$E(PSANDC,1,6)_"-"_$E(PSANDC,7,10)_"-"_$E(PSANDC,11,12),1:"Blank")
;
PRICE ;W !,"Unit Price : $"
S PSADJP=0,PSADJ=+$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B","P",0))
I $G(PSADJ) S PSANODE=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,PSADJ,0)),PSADJP=$S(+$P(PSANODE,"^",6):+$P(PSANODE,"^",6),1:+$P(PSANODE,"^",2))
;Adj. Unit Price
I $G(PSADJP) D
.I $L($P(PSADJP,".",2))<2 S PSADJP=$P(PSADJP,".")_"."_$P(PSADJP,".",2)_$E("00",1,(2-$L($P(PSADJP,".",2))))
.;W $FN(PSADJP,",")_" ($"_$S(+$P(PSADATA,"^",5):$FN($P(PSADATA,"^",5),","),$P(PSADATA,"^",5)=0:"0.00",1:"")_")"
.S PSAPRICE=PSADJP
I '$G(PSADJP) D
.S PSAPRICE=+$P(PSADATA,"^",5)
.;I $G(PSAPRICE)!(PSAPRICE=0) W $S($G(PSAPRICE):PSAPRICE,1:"0.00") Q
.;W "Blank"
;
VSN ;W ?38,"VSN: "_$S(PSAVSN'="":PSAVSN,1:"Blank"),!
VDU S PSADUOU=+$P(PSATEMP,"^"),PSAREORD=+$P(PSATEMP,"^",2),PSASUB=+$P(PSATEMP,"^",3),PSASTOCK=+$P(PSATEMP,"^",4)
S INVARRAY(PSAORD,PSAINV,PSALINE)=$G(PSADRG)_"~"_$G(PSADRUGN)_"^"_$G(PSAQTY)_"^"_$G(PSALOC)_"^"_$G(PSAOU)_"^"_$G(PSANDC)_"^"_$G(PSAPRICE)_"^"_$G(PSAVSN)_"^"_$G(PSAUPC)
;
I '+$P($G(^PSD(58.8,+PSALOC,0)),"^",14) G DISPLN
;
STOCK S PSASTOCK=$S(+PSASTOCK:+PSASTOCK,+$P($G(^PSD(58.8,+PSALOC,1,+PSADRG,0)),"^",3):+$P($G(^PSD(58.8,+PSALOC,1,+PSADRG,0)),"^",3),1:"Blank")
REORDER S PSAREORD=$S(+PSAREORD:+PSAREORD,+$P($G(^PSD(58.8,+PSALOC,1,+PSADRG,0)),"^",5):+$P($G(^PSD(58.8,+PSALOC,1,+PSADRG,0)),"^",5),1:"Blank")
S INVARRAY(PSAORD,PSAINV,PSALINE)=$G(INVARRAY(PSAORD,PSAINV,PSALINE))_"^"_$G(PSASTOCK)_"^"_$G(PSAREORD)
G DISPLN
ASK R !!,"Enter an '^' to abort, <RET> to continue, or a corresponding line item number: ",AN:DTIME I AN="" G DISPLN
I AN["^" G Q
I AN<0!(AN>CNT) W !,"Enter a number between 1 and ",CNT G ASK
S (PSALINE,PSALINEN)=AN
PROCSS I '$D(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,0)) W !,"Invalid line number." G ASK
S PSADATA=^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,0),PSASUP=0
S PSANDC=$P(PSADATA,"^",11),PSAVSN=$P(PSADATA,"^",12),PSALOC=$S($P(PSADATA,"^",10):+$P(PSAIN,"^",12),1:+$P(PSAIN,"^",5))
VIEW S PSALINEN=" " D VERDISP^PSAUTL4 W !,PSASLN,!
W "1. Drug",!,"2. Order Unit",! S PSACHO=2
S DIR(0)="LO^1:"_PSACHO,DIR("A")="Edit fields",DIR("?")="Enter the number(s) of the data to be edited" S DIR("??")="^D DDQOR^PSAVER3"
D ^DIR K DIR I $G(DTOUT)!($G(DUOUT)) S PSAOUT=1 Q
Q:Y="" S PSAFLDS=Y,PSASET=0 ;D VERDISP^PSAUTL4 W PSASLN
FIELDS F PSAPCF=1:1 S PSAFLD=$P(PSAFLDS,",",PSAPCF) Q:'PSAFLD!(PSAOUT) D
.I PSAFLD=1 D ASKDRUG^PSAVERA2 Q
.I PSAFLD=2 D OU^PSAVER2 Q
Q Q
PSAVERA1 ;BHM/DB - Edit previously verified invoices;16NOV99
+1 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**21**; 10/24/97
+2 ;References to ^DIC(51.5 are covered by IA #1931
+3 ;References to ^PSDRUG( are covered by IA #2095
+4 ;
+5 SET $PIECE(PSASLN,"=",79)=""
KILL PSALINE
DISPLN SET PSALINE=$SELECT('$DATA(PSALINE):$ORDER(^PSD(58.811,PSAIEN,1,PSAIEN1,1,0)),1:$ORDER(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE)))
IF PSALINE'>0
GOTO Q
SET CNT=$GET(CNT)+1
+1 SET PSADATA=$GET(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,0))
+2 SET PSATEMP=$GET(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,2))
+3 SET PSAVSN=$PIECE(PSADATA,"^",12)
SET PSAOUT=0
DRUG SET PSADJ=+$ORDER(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B","D",0))
+1 IF $GET(PSADJ)
Begin DoDot:1
+2 SET PSANODE=$GET(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,PSADJ,0))
+3 SET PSADJD=$SELECT($PIECE(PSANODE,"^",6)'="":$PIECE(PSANODE,"^",6),1:$PIECE(PSANODE,"^",2))
+4 SET PSASUP=$SELECT(PSADJD'?1.N:1,1:0)
+5 SET PSADRG=$SELECT(PSADJ&('PSASUP):$GET(PSADJD),PSADJ&(PSASUP):0,1:+$PIECE(PSADATA,"^",2))
+6 IF $GET(PSADJD)
IF $LENGTH(PSADJD)=+$LENGTH(PSADJD)
IF $PIECE($GET(^PSDRUG(+PSADJD,0)),"^")'=""
SET (PSADRG,PSA50IEN)=+PSADJD
QUIT
+7 IF $GET(PSADJD)
IF $LENGTH(PSADJD)=+$LENGTH(PSADJD)
IF $PIECE($GET(^PSDRUG(+PSADJD,0)),"^")=""
SET (PSADJ,PSADRG)=0
QUIT
+8 SET PSADJSUP=1
SET (PSADRG,PSA50IEN)=PSADJD
End DoDot:1
+9 IF '$GET(PSADJ)
Begin DoDot:1
+10 SET (PSA50IEN,PSADRG)=$SELECT(+$PIECE(PSADATA,"^",2)&($PIECE($GET(^PSDRUG(+$PIECE(PSADATA,"^",2),0)),"^")'=""):+$PIECE(PSADATA,"^",2),1:0)
End DoDot:1
+11 SET PSADRUGN=$SELECT($PIECE($GET(^PSDRUG(PSADRG,0)),"^")'="":$PIECE($GET(^PSDRUG(PSADRG,0)),"^"),1:"Unknown Drug Name")
QTY ;Quantity
+1 ;No Adj. Qty
+2 SET PSADJQ=""
SET PSADJ=+$ORDER(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B","Q",0))
+3 IF $GET(PSADJ)
SET PSANODE=$GET(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,PSADJ,0))
SET PSADJQ=$SELECT($PIECE(PSANODE,"^",6)'="":+$PIECE(PSANODE,"^",6),1:$PIECE(PSANODE,"^",2))
+4 ;Adj. Qty
+5 IF $GET(PSADJQ)
SET PSAQTY=PSADJQ
+6 IF '$GET(PSADJQ)
SET PSAQTY=$PIECE(PSADATA,"^",3)
UPC IF $PIECE(PSADATA,"^",13)
SET PSAUPC=$PIECE(PSADATA,"^",13)
OU ;W !,"Order Unit : "
+1 SET PSAOU=$SELECT(+$PIECE(PSADATA,"^",4)&($PIECE($GET(^DIC(51.5,+$PIECE(PSADATA,"^",4),0)),"^")'=""):+$PIECE(PSADATA,"^",4),1:"")
+2 SET PSATEMP=$GET(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,2))
+3 IF +$PIECE(PSATEMP,"^",3)
IF PSADRG
IF +$PIECE($GET(^PSDRUG(PSADRG,1,+$PIECE(PSATEMP,"^",3),0)),"^",5)
SET PSAOU=+$PIECE(^PSDRUG(PSADRG,1,+$PIECE(PSATEMP,"^",3),0),"^",5)
+4 SET PSADJO=""
SET PSADJ=+$ORDER(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B","O",0))
+5 IF $GET(PSADJ)
SET PSANODE=$GET(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,PSADJ,0))
SET PSADJO=$SELECT($PIECE(PSANODE,"^",6)'="":$PIECE(PSANODE,"^",6),1:$PIECE(PSANODE,"^",2))
+6 ;Adj. Order Unit
+7 IF PSADJO'=""
SET PSAOU=+PSADJO
+8 ;W $S(+PSAOU:$P($G(^DIC(51.5,+PSAOU,0)),"^"),1:"Blank")
IF PSADJO=""
+9 ;
NDC SET PSANDC=$PIECE(PSADATA,"^",11)
+1 ;I $E(PSANDC)'="S" W ?38,"NDC: "_$S(PSANDC'="":$E(PSANDC,1,6)_"-"_$E(PSANDC,7,10)_"-"_$E(PSANDC,11,12),1:"Blank")
+2 ;
PRICE ;W !,"Unit Price : $"
+1 SET PSADJP=0
SET PSADJ=+$ORDER(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B","P",0))
+2 IF $GET(PSADJ)
SET PSANODE=$GET(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,PSADJ,0))
SET PSADJP=$SELECT(+$PIECE(PSANODE,"^",6):+$PIECE(PSANODE,"^",6),1:+$PIECE(PSANODE,"^",2))
+3 ;Adj. Unit Price
+4 IF $GET(PSADJP)
Begin DoDot:1
+5 IF $LENGTH($PIECE(PSADJP,".",2))<2
SET PSADJP=$PIECE(PSADJP,".")_"."_$PIECE(PSADJP,".",2)_$EXTRACT("00",1,(2-$LENGTH($PIECE(PSADJP,".",2))))
+6 ;W $FN(PSADJP,",")_" ($"_$S(+$P(PSADATA,"^",5):$FN($P(PSADATA,"^",5),","),$P(PSADATA,"^",5)=0:"0.00",1:"")_")"
+7 SET PSAPRICE=PSADJP
End DoDot:1
+8 IF '$GET(PSADJP)
Begin DoDot:1
+9 SET PSAPRICE=+$PIECE(PSADATA,"^",5)
+10 ;I $G(PSAPRICE)!(PSAPRICE=0) W $S($G(PSAPRICE):PSAPRICE,1:"0.00") Q
+11 ;W "Blank"
End DoDot:1
+12 ;
VSN ;W ?38,"VSN: "_$S(PSAVSN'="":PSAVSN,1:"Blank"),!
VDU SET PSADUOU=+$PIECE(PSATEMP,"^")
SET PSAREORD=+$PIECE(PSATEMP,"^",2)
SET PSASUB=+$PIECE(PSATEMP,"^",3)
SET PSASTOCK=+$PIECE(PSATEMP,"^",4)
+1 SET INVARRAY(PSAORD,PSAINV,PSALINE)=$GET(PSADRG)_"~"_$GET(PSADRUGN)_"^"_$GET(PSAQTY)_"^"_$GET(PSALOC)_"^"_$GET(PSAOU)_"^"_$GET(PSANDC)_"^"_$GET(PSAPRICE)_"^"_$GET(PSAVSN)_"^"_$GET(PSAUPC)
+2 ;
+3 IF '+$PIECE($GET(^PSD(58.8,+PSALOC,0)),"^",14)
GOTO DISPLN
+4 ;
STOCK SET PSASTOCK=$SELECT(+PSASTOCK:+PSASTOCK,+$PIECE($GET(^PSD(58.8,+PSALOC,1,+PSADRG,0)),"^",3):+$PIECE($GET(^PSD(58.8,+PSALOC,1,+PSADRG,0)),"^",3),1:"Blank")
REORDER SET PSAREORD=$SELECT(+PSAREORD:+PSAREORD,+$PIECE($GET(^PSD(58.8,+PSALOC,1,+PSADRG,0)),"^",5):+$PIECE($GET(^PSD(58.8,+PSALOC,1,+PSADRG,0)),"^",5),1:"Blank")
+1 SET INVARRAY(PSAORD,PSAINV,PSALINE)=$GET(INVARRAY(PSAORD,PSAINV,PSALINE))_"^"_$GET(PSASTOCK)_"^"_$GET(PSAREORD)
+2 GOTO DISPLN
ASK READ !!,"Enter an '^' to abort, <RET> to continue, or a corresponding line item number: ",AN:DTIME
IF AN=""
GOTO DISPLN
+1 IF AN["^"
GOTO Q
+2 IF AN<0!(AN>CNT)
WRITE !,"Enter a number between 1 and ",CNT
GOTO ASK
+3 SET (PSALINE,PSALINEN)=AN
PROCSS IF '$DATA(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,0))
WRITE !,"Invalid line number."
GOTO ASK
+1 SET PSADATA=^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,0)
SET PSASUP=0
+2 SET PSANDC=$PIECE(PSADATA,"^",11)
SET PSAVSN=$PIECE(PSADATA,"^",12)
SET PSALOC=$SELECT($PIECE(PSADATA,"^",10):+$PIECE(PSAIN,"^",12),1:+$PIECE(PSAIN,"^",5))
VIEW SET PSALINEN=" "
DO VERDISP^PSAUTL4
WRITE !,PSASLN,!
+1 WRITE "1. Drug",!,"2. Order Unit",!
SET PSACHO=2
+2 SET DIR(0)="LO^1:"_PSACHO
SET DIR("A")="Edit fields"
SET DIR("?")="Enter the number(s) of the data to be edited"
SET DIR("??")="^D DDQOR^PSAVER3"
+3 DO ^DIR
KILL DIR
IF $GET(DTOUT)!($GET(DUOUT))
SET PSAOUT=1
QUIT
+4 ;D VERDISP^PSAUTL4 W PSASLN
IF Y=""
QUIT
SET PSAFLDS=Y
SET PSASET=0
FIELDS FOR PSAPCF=1:1
SET PSAFLD=$PIECE(PSAFLDS,",",PSAPCF)
IF 'PSAFLD!(PSAOUT)
QUIT
Begin DoDot:1
+1 IF PSAFLD=1
DO ASKDRUG^PSAVERA2
QUIT
+2 IF PSAFLD=2
DO OU^PSAVER2
QUIT
End DoDot:1
Q QUIT
