Ignore:
Timestamp:
Dec 4, 2009, 12:11:15 AM (14 years ago)
Author:
George Lilly
Message:

revised back to 6/30/08 version

File:
1 edited

Legend:

Unmodified
Added
Removed

  • WorldVistAEHR/trunk/r/DRUG_ACCOUNTABILITY-PSA/PSAVERA1.m

    r613 r623  
    1 PSAVERA1        ;BHM/DB - Edit previously verified invoices;16NOV99
    2         ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**21,61,63**; 10/24/97;Build 10
    3         ;References to ^DIC(51.5 are covered by IA #1931
    4         ;References to ^PSDRUG( are covered by IA #2095
    5         ;
    6         S $P(PSASLN,"=",79)="" K PSALINE
    7 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
    8         S PSADATA=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,0))
    9         S PSATEMP=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,2))
    10         S PSAVSN=$P(PSADATA,"^",12),PSAOUT=0
    11 DRUG    S PSADJ=+$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B","D",0))
    12         I $G(PSADJ) D
    13         .S PSANODE=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,PSADJ,0))
    14         .S PSADJD=$S($P(PSANODE,"^",6)'="":$P(PSANODE,"^",6),1:$P(PSANODE,"^",2))
    15         .S PSASUP=$S(PSADJD'?1.N:1,1:0)
    16         .S PSADRG=$S(PSADJ&('PSASUP):$G(PSADJD),PSADJ&(PSASUP):0,1:+$P(PSADATA,"^",2))
    17         .I $G(PSADJD),$L(PSADJD)=$L(+PSADJD),$P($G(^PSDRUG(+PSADJD,0)),"^")'="" S (PSADRG,PSA50IEN)=+PSADJD Q
    18         .I $G(PSADJD),$L(PSADJD)=$L(+PSADJD),$P($G(^PSDRUG(+PSADJD,0)),"^")="" S (PSADJ,PSADRG)=0 Q
    19         .S PSADJSUP=1,(PSADRG,PSA50IEN)=PSADJD
    20         I '$G(PSADJ) D
    21         .S (PSA50IEN,PSADRG)=$S(+$P(PSADATA,"^",2)&($P($G(^PSDRUG(+$P(PSADATA,"^",2),0)),"^")'=""):+$P(PSADATA,"^",2),1:0)
    22         S PSADRUGN=$S($P($G(^PSDRUG(PSADRG,0)),"^")'="":$P($G(^PSDRUG(PSADRG,0)),"^"),1:"Unknown Drug Name")
    23 QTY     ;Quantity
    24         ;No Adj. Qty
    25         S PSADJQ="",PSADJ=+$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B","Q",0))
    26         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))
    27         ;Adj. Qty
    28         I $G(PSADJQ) S PSAQTY=PSADJQ
    29         I '$G(PSADJQ) S PSAQTY=$P(PSADATA,"^",3)
    30 UPC     S:$P(PSADATA,"^",13) PSAUPC=$P(PSADATA,"^",13)
    31 OU      ;W !,"Order Unit  : "
    32         S PSAOU=$S(+$P(PSADATA,"^",4)&($P($G(^DIC(51.5,+$P(PSADATA,"^",4),0)),"^")'=""):+$P(PSADATA,"^",4),1:"")
    33         S PSATEMP=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,2))
    34         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)
    35         S PSADJO="",PSADJ=+$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B","O",0))
    36         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))
    37         ;Adj. Order Unit
    38         I PSADJO'="" S PSAOU=+PSADJO
    39         I PSADJO="" ;W $S(+PSAOU:$P($G(^DIC(51.5,+PSAOU,0)),"^"),1:"Blank")
    40         ;
    41 NDC     S PSANDC=$P(PSADATA,"^",11)
    42         ;I $E(PSANDC)'="S" W ?38,"NDC: "_$S(PSANDC'="":$E(PSANDC,1,6)_"-"_$E(PSANDC,7,10)_"-"_$E(PSANDC,11,12),1:"Blank")
    43         ;
    44 PRICE   ;W !,"Unit Price  : $"
    45         S PSADJP=0,PSADJ=+$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B","P",0))
    46         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))
    47         ;Adj. Unit Price
    48         I $G(PSADJP) D
    49         .I $L($P(PSADJP,".",2))<2 S PSADJP=$P(PSADJP,".")_"."_$P(PSADJP,".",2)_$E("00",1,(2-$L($P(PSADJP,".",2))))
    50         .;W $FN(PSADJP,",")_" ($"_$S(+$P(PSADATA,"^",5):$FN($P(PSADATA,"^",5),","),$P(PSADATA,"^",5)=0:"0.00",1:"")_")"
    51         .S PSAPRICE=PSADJP
    52         I '$G(PSADJP) D
    53         .S PSAPRICE=+$P(PSADATA,"^",5)
    54         .;I $G(PSAPRICE)!(PSAPRICE=0) W $S($G(PSAPRICE):PSAPRICE,1:"0.00") Q
    55         .;W "Blank"
    56         ;
    57 VSN     ;W ?38,"VSN: "_$S(PSAVSN'="":PSAVSN,1:"Blank"),!
    58 VDU     S PSADUOU=+$P(PSATEMP,"^"),PSAREORD=+$P(PSATEMP,"^",2),PSASUB=+$P(PSATEMP,"^",3),PSASTOCK=+$P(PSATEMP,"^",4)
    59         S INVARRAY(PSAORD,PSAINV,PSALINE)=$G(PSADRG)_"~"_$G(PSADRUGN)_"^"_$G(PSAQTY)_"^"_$G(PSALOC)_"^"_$G(PSAOU)_"^"_$G(PSANDC)_"^"_$G(PSAPRICE)_"^"_$G(PSAVSN)_"^"_$G(PSAUPC)
    60         ;
    61         I '+$P($G(^PSD(58.8,+PSALOC,0)),"^",14) G DISPLN
    62         ;
    63 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")
    64 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")
    65         S INVARRAY(PSAORD,PSAINV,PSALINE)=$G(INVARRAY(PSAORD,PSAINV,PSALINE))_"^"_$G(PSASTOCK)_"^"_$G(PSAREORD)
    66         G DISPLN
    67 ASK     R !!,"Enter an '^' to abort, <RET> to continue, or a corresponding line item number: ",AN:DTIME I AN="" G DISPLN
    68         I AN["^" G Q
    69         I AN<0!(AN>CNT) W !,"Enter a number between 1 and ",CNT G ASK
    70         S (PSALINE,PSALINEN)=AN
    71 PROCSS  I '$D(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,0)) W !,"Invalid line number." G ASK
    72         S PSADATA=^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,0),PSASUP=0
    73         S PSANDC=$P(PSADATA,"^",11),PSAVSN=$P(PSADATA,"^",12),PSALOC=$S($P(PSADATA,"^",10):+$P(PSAIN,"^",12),1:+$P(PSAIN,"^",5))
    74 VIEW    S PSALINEN=" " D VERDISP^PSAUTL4 W !,PSASLN,!
    75         W "1. Drug",!,"2. Order Unit",! S PSACHO=2
    76         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"
    77         D ^DIR K DIR I $G(DTOUT)!($G(DUOUT)) S PSAOUT=1 Q
    78         Q:Y=""  S PSAFLDS=Y,PSASET=0 ;D VERDISP^PSAUTL4 W PSASLN
    79 FIELDS  F PSAPCF=1:1 S PSAFLD=$P(PSAFLDS,",",PSAPCF) Q:'PSAFLD!(PSAOUT)  D
    80         .I PSAFLD=1 D ASKDRUG^PSAVERA2 Q
    81         .I PSAFLD=2 D OU^PSAVER2 Q
    82 Q       Q
    83         ;
    84 UPDATE  ; *63 RJS CODE REMOVED FROM PSAVERA AND CALLED BY PSAVERA
    85         ;File data in 58.8
    86         ;PSALOC= Either PSALOC or PSALOCB
    87         S PSADRG=PSABFR
    88         F  L +^PSD(58.8,PSALOC,1,PSADRG,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I  Q
    89         S PSADUREC=PSAQTY*$G(PSAODUOU),PSABAL=$P($G(^PSD(58.8,PSALOC,1,PSADRG,0)),"^",4),$P(^PSD(58.8,PSALOC,1,PSADRG,0),"^",4)=PSABAL-$G(PSABFR("Q"))
    90         L -^PSD(58.8,PSALOC,1,PSADRG,0)
    91         S PSADRG=PSAAFTER,PSAABAL=PSABAL,PSADUREC=PSAQTY*$G(PSADUOU)
    92         D NOW^%DTC S PSADT=+$E(%,1,14)
    93         I '$D(^PSD(58.8,PSALOC,1,PSADRG,0)) D
    94         .S:'$D(^PSD(58.8,PSALOC,1,0)) DIC("P")=$P(^DD(58.8,10,0),"^",2)
    95         .S DA(1)=PSALOC,DIC="^PSD(58.8,"_DA(1)_",1,",(DA,DINUM,X)=PSADRG,DIC(0)="L",DLAYGO=58.8 ;*53
    96         .F  L +^PSD(58.8,PSALOC,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I  Q
    97         .D FILE^DICN L -^PSD(58.8,PSALOC,0) K DIC,DA,DLAYGO
    98         F  L +^PSD(58.8,PSALOC,1,PSADRG,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I  Q
    99         S PSABAL=$P($G(^PSD(58.8,PSALOC,1,PSADRG,0)),"^",4)
    100         I $P($G(^PSD(58.8,PSALOC,1,PSADRG,0)),"^",1)'=PSADRG S $P(^PSD(58.8,PSALOC,1,PSADRG,0),"^",1)=PSADRG
    101         S $P(^PSD(58.8,PSALOC,1,PSADRG,0),"^",4)=PSADUREC+PSABAL
    102         I +$P($G(^PSD(58.8,PSALOC,0)),"^",14) D
    103         .I PSASTOCK'=$P(^PSD(58.8,PSALOC,1,PSADRG,0),"^",3) S $P(^PSD(58.8,PSALOC,1,PSADRG,0),"^",3)=PSASTOCK
    104         .I PSAREORD'=$P(^PSD(58.8,PSALOC,1,PSADRG,0),"^",5) S $P(^PSD(58.8,PSALOC,1,PSADRG,0),"^",5)=PSAREORD
    105         S:'$D(^PSD(58.8,PSALOC,1,PSADRG,5,0)) DIC("P")=$P(^DD(58.8001,20,0),"^",2)
    106         I '$D(^PSD(58.8,PSALOC,1,PSADRG,5,$E(DT,1,5)*100,0)) D
    107         .S DIC="^PSD(58.8,"_PSALOC_",1,"_PSADRG_",5,",DIC(0)="L",DIC("DR")="1////^S X=$G(PSABAL)",(X,DINUM)=$E(DT,1,5)*100,DA(2)=PSALOC,DA(1)=PSADRG,DLAYGO=58.8 D ^DIC K DIC
    108         .S X="T-1M" D ^%DT S DIC="^PSD(58.8,"_PSALOC_",1,"_PSADRG_",5,",DIC(0)="L",(X,DINUM)=$E(Y,1,5)*100 D ^DIC K DIC,DLAYGO S DA=+Y
    109         .S DA(2)=PSALOC,DA(1)=PSADRG,DIE="^PSD(58.8,"_DA(2)_",1,"_DA(1)_",5,",DR="3////^S X=$G(PSABAL)" D ^DIE K DIE
    110         S DA(2)=PSALOC,DA(1)=PSADRG,DIE="^PSD(58.8,"_DA(2)_",1,"_DA(1)_",5,",DA=$E(DT,1,5)*100,DR="5////^S X="_($P($G(^(0)),"^",3)+PSADUREC) D ^DIE K DIE
    111         L -^PSD(58.8,PSALOC,1,PSADRG,0)
    112         W !,"updating pharmacy location file."
    113 FILE581 ;Update transaction file ;;*63
    114         S PSAVDUZ=DUZ,PSAREA="EDIT VERIFIED INVOICE"
    115         I '$G(PSABFR(581)) D NEW581 Q
    116         I PSADRG'=PSABFR S PSANQTY=0,PSAAQTY=$G(PSABFR("Q"))*-1
    117         I PSADRG=PSABFR S PSANQTY=PSADUREC D
    118         .S PSAAQTY=PSADUREC-$G(PSABFR("Q"))
    119 FIND    S PSAT=$P(^PSD(58.81,0),"^",3)+1 I $D(^PSD(58.81,PSAT)) S $P(^PSD(58.81,0),"^",3)=$P(^PSD(58.81,0),"^",3)+1 G FIND
    120         S DIC="^PSD(58.81,",DIC(0)="L",DLAYGO=58.81,(DINUM,X)=PSAT D ^DIC K DIC,DINUM,DLAYGO L -^PSD(58.81,0)
    121         S DIE="^PSD(58.81,",DA=PSAT
    122         I PSAAFTER'=PSABFR S PSADRG=PSABFR
    123         S DR="1////14;2////^S X=PSALOC;3////^S X=PSADT;4////^S X=PSADRG;48////^S X=PSADT;49////^S X=PSAVDUZ;50////^S X=PSANQTY;51////^S X=PSAAQTY;53////^S X=PSAREA;54////^S X=PSAABAL;71////^S X=PSAINV;106////^S X=PSAORD"
    124         F  L +^PSD(58.81,DA,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I  Q
    125         D ^DIE L -^PSD(58.81,DA,0) K DIE
    126         I PSAAFTER'=PSABFR S PSADRG=PSAAFTER D NEW581
    127         Q
    128         ;
    129 NEW581  S PSAT=$P(^PSD(58.81,0),"^",3)+1 I $D(^PSD(58.81,PSAT)) S $P(^PSD(58.81,0),"^",3)=$P(^PSD(58.81,0),"^",3)+1 G NEW581
    130         S DIC="^PSD(58.81,",DIC(0)="L",DLAYGO=58.81,(DINUM,X)=PSAT D ^DIC K DIC,DINUM,DLAYGO L -^PSD(58.81,0)
    131         S PSADUREC=PSAQTY*$G(PSADUOU)
    132         S DIE="^PSD(58.81,",DA=PSAT,DR="1////1;2////^S X=PSALOC;3////^S X=PSADT;4////^S X=PSADRG;5////^S X=PSADUREC;6////^S X=PSAVDUZ;9////^S X=PSABAL;71////^S X=PSAINV;106////^S X=PSAORD"
    133         I $G(PSACS)>0 S DR=DR_";100////^S X=PSACS"
    134         F  L +^PSD(58.81,DA,0):$S($G(DILOCKTM)>0:DILOCKTM,1:3) I  Q
    135         D ^DIE L -^PSD(58.81,DA,0) K DIE W !,"updating transaction file." Q
    136         Q
     1PSAVERA1 ;BHM/DB - Edit previously verified invoices;16NOV99
     2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**21,61**; 10/24/97;Build 1
     3 ;References to ^DIC(51.5 are covered by IA #1931
     4 ;References to ^PSDRUG( are covered by IA #2095
     5 ;
     6 S $P(PSASLN,"=",79)="" K PSALINE
     7DISPLN 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
     8 S PSADATA=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,0))
     9 S PSATEMP=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,2))
     10 S PSAVSN=$P(PSADATA,"^",12),PSAOUT=0
     11DRUG S PSADJ=+$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B","D",0))
     12 I $G(PSADJ) D
     13 .S PSANODE=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,PSADJ,0))
     14 .S PSADJD=$S($P(PSANODE,"^",6)'="":$P(PSANODE,"^",6),1:$P(PSANODE,"^",2))
     15 .S PSASUP=$S(PSADJD'?1.N:1,1:0)
     16 .S PSADRG=$S(PSADJ&('PSASUP):$G(PSADJD),PSADJ&(PSASUP):0,1:+$P(PSADATA,"^",2))
     17 .I $G(PSADJD),$L(PSADJD)=$L(+PSADJD),$P($G(^PSDRUG(+PSADJD,0)),"^")'="" S (PSADRG,PSA50IEN)=+PSADJD Q
     18 .I $G(PSADJD),$L(PSADJD)=$L(+PSADJD),$P($G(^PSDRUG(+PSADJD,0)),"^")="" S (PSADJ,PSADRG)=0 Q
     19 .S PSADJSUP=1,(PSADRG,PSA50IEN)=PSADJD
     20 I '$G(PSADJ) D
     21 .S (PSA50IEN,PSADRG)=$S(+$P(PSADATA,"^",2)&($P($G(^PSDRUG(+$P(PSADATA,"^",2),0)),"^")'=""):+$P(PSADATA,"^",2),1:0)
     22 S PSADRUGN=$S($P($G(^PSDRUG(PSADRG,0)),"^")'="":$P($G(^PSDRUG(PSADRG,0)),"^"),1:"Unknown Drug Name")
     23QTY ;Quantity
     24 ;No Adj. Qty
     25 S PSADJQ="",PSADJ=+$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B","Q",0))
     26 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))
     27 ;Adj. Qty
     28 I $G(PSADJQ) S PSAQTY=PSADJQ
     29 I '$G(PSADJQ) S PSAQTY=$P(PSADATA,"^",3)
     30UPC S:$P(PSADATA,"^",13) PSAUPC=$P(PSADATA,"^",13)
     31OU ;W !,"Order Unit  : "
     32 S PSAOU=$S(+$P(PSADATA,"^",4)&($P($G(^DIC(51.5,+$P(PSADATA,"^",4),0)),"^")'=""):+$P(PSADATA,"^",4),1:"")
     33 S PSATEMP=$G(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,2))
     34 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)
     35 S PSADJO="",PSADJ=+$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B","O",0))
     36 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))
     37 ;Adj. Order Unit
     38 I PSADJO'="" S PSAOU=+PSADJO
     39 I PSADJO="" ;W $S(+PSAOU:$P($G(^DIC(51.5,+PSAOU,0)),"^"),1:"Blank")
     40 ;
     41NDC S PSANDC=$P(PSADATA,"^",11)
     42 ;I $E(PSANDC)'="S" W ?38,"NDC: "_$S(PSANDC'="":$E(PSANDC,1,6)_"-"_$E(PSANDC,7,10)_"-"_$E(PSANDC,11,12),1:"Blank")
     43 ;
     44PRICE ;W !,"Unit Price  : $"
     45 S PSADJP=0,PSADJ=+$O(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,1,"B","P",0))
     46 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))
     47 ;Adj. Unit Price
     48 I $G(PSADJP) D
     49 .I $L($P(PSADJP,".",2))<2 S PSADJP=$P(PSADJP,".")_"."_$P(PSADJP,".",2)_$E("00",1,(2-$L($P(PSADJP,".",2))))
     50 .;W $FN(PSADJP,",")_" ($"_$S(+$P(PSADATA,"^",5):$FN($P(PSADATA,"^",5),","),$P(PSADATA,"^",5)=0:"0.00",1:"")_")"
     51 .S PSAPRICE=PSADJP
     52 I '$G(PSADJP) D
     53 .S PSAPRICE=+$P(PSADATA,"^",5)
     54 .;I $G(PSAPRICE)!(PSAPRICE=0) W $S($G(PSAPRICE):PSAPRICE,1:"0.00") Q
     55 .;W "Blank"
     56 ;
     57VSN ;W ?38,"VSN: "_$S(PSAVSN'="":PSAVSN,1:"Blank"),!
     58VDU S PSADUOU=+$P(PSATEMP,"^"),PSAREORD=+$P(PSATEMP,"^",2),PSASUB=+$P(PSATEMP,"^",3),PSASTOCK=+$P(PSATEMP,"^",4)
     59 S INVARRAY(PSAORD,PSAINV,PSALINE)=$G(PSADRG)_"~"_$G(PSADRUGN)_"^"_$G(PSAQTY)_"^"_$G(PSALOC)_"^"_$G(PSAOU)_"^"_$G(PSANDC)_"^"_$G(PSAPRICE)_"^"_$G(PSAVSN)_"^"_$G(PSAUPC)
     60 ;
     61 I '+$P($G(^PSD(58.8,+PSALOC,0)),"^",14) G DISPLN
     62 ;
     63STOCK 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")
     64REORDER 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")
     65 S INVARRAY(PSAORD,PSAINV,PSALINE)=$G(INVARRAY(PSAORD,PSAINV,PSALINE))_"^"_$G(PSASTOCK)_"^"_$G(PSAREORD)
     66 G DISPLN
     67ASK R !!,"Enter an '^' to abort, <RET> to continue, or a corresponding line item number: ",AN:DTIME I AN="" G DISPLN
     68 I AN["^" G Q
     69 I AN<0!(AN>CNT) W !,"Enter a number between 1 and ",CNT G ASK
     70 S (PSALINE,PSALINEN)=AN
     71PROCSS I '$D(^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,0)) W !,"Invalid line number." G ASK
     72 S PSADATA=^PSD(58.811,PSAIEN,1,PSAIEN1,1,PSALINE,0),PSASUP=0
     73 S PSANDC=$P(PSADATA,"^",11),PSAVSN=$P(PSADATA,"^",12),PSALOC=$S($P(PSADATA,"^",10):+$P(PSAIN,"^",12),1:+$P(PSAIN,"^",5))
     74VIEW S PSALINEN=" " D VERDISP^PSAUTL4 W !,PSASLN,!
     75 W "1. Drug",!,"2. Order Unit",! S PSACHO=2
     76 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"
     77 D ^DIR K DIR I $G(DTOUT)!($G(DUOUT)) S PSAOUT=1 Q
     78 Q:Y=""  S PSAFLDS=Y,PSASET=0 ;D VERDISP^PSAUTL4 W PSASLN
     79FIELDS F PSAPCF=1:1 S PSAFLD=$P(PSAFLDS,",",PSAPCF) Q:'PSAFLD!(PSAOUT)  D
     80 .I PSAFLD=1 D ASKDRUG^PSAVERA2 Q
     81 .I PSAFLD=2 D OU^PSAVER2 Q
     82Q Q
Note: See TracChangeset for help on using the changeset viewer.