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/PSAORDP1.m

    r613 r623  
    1 PSAORDP1        ;BIR/JMB-Print Orders - CONT'D ;9/19/97
    2         ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**3,12,21,61,65,67**; 10/24/97;Build 15
    3         ;This routine prints invoices.
    4         ;
    5         ;References to global ^DIC(51.5 are covered by IA #1931
    6         ;References to global ^PSDRUG( are covered by IA #2095
    7         ;References to global ^PSDRUG("C" are covered by IA #2095
    8         ;
    9 DQ      S IOM=80 D NOW^%DTC S Y=% D DD^%DT S PSARUN=$E(Y,1,18),PSAPAGE=1,$P(PSASLN,"-",80)="",$P(PSADLN,"=",80)="",(PSADJDRG,PSAOUT)=0,PSAFPG=1
    10         S PSAEND=0,PSAORDER=$P(^PSD(58.811,PSAORD,0),"^") D HEADER^PSAORDP2
    11         S PSAIN=$G(^PSD(58.811,PSAORD,1,PSAINV,0)),PSAINVN=$P(PSAIN,"^"),PSASTA=$P(PSAIN,"^",3),PSADEL=+$P(PSAIN,"^",6),PSAREC=+$P(PSAIN,"^",7)
    12 START   W !,"PRIME VENDOR : ",$S($P($G(^PSD(58.811,PSAORD,0)),"^",2)'="":$P($G(^(0)),"^",2),1:"UNKNOWN")
    13         W !!,"ORDER#  : "_PSAORDER,?40,"ORDER DATE   : "_$$DATE($P(PSAIN,"^",4))
    14         W !,"INVOICE#: "_PSAINVN,?40,"INVOICE DATE : "_$$DATE($P(PSAIN,"^",2))
    15         W !,"STATUS  : "_$S(PSASTA="P":"PROCESSED",PSASTA="V":"VERIFIED",PSASTA="L":"LOCKED VERIFYING",PSASTA="C":"COMPLETED",1:"UNKNOWN")_$S(+$P(PSAIN,"^",13):" (SUPPLY INVOICE)",1:"") ;;<*65 RJS>
    16         W ?40,"DELIVERY DATE: "_$S(PSADEL:$$DATE(PSADEL),1:"UNKNOWN")
    17         W !?40,"DATE RECEIVED: "_$S(PSAREC:$$DATE(PSAREC),PSADEL:$$DATE(PSADEL),1:"UNKNOWN"),!
    18         S PSADJDRG=0 S (PSAIECST,PSAAECST)=0 D LINE
    19         ;
    20 EXIT    ;Kills
    21         K %,DIR,DIRUT,PSAAECST,PSACIEN,PSADATA,PSADATE,PSADEC,PSADEL,PSADJ,PSADJD,PSADJDP,PSADJDRG,PSADJSUP,PSADJDV,PSADPDT,PSADPDUZ,PSADVDT,PSADVDUZ,PSADJO,PSADJOP,PSADJOV
    22         K PSADJP,PSADJPP,PSADJPV,PSADJQ,PSADJQP,PSADJQV,PSADLN,PSADRG,PSAECOST,PSAEND,PSAFPG,PSAICOST,PSAIECST,PSAIN,PSAINVN
    23         K PSALN,PSAMORE,PSANDC,PSANODE,PSAOPDT,PSAOPDUZ,PSAORDER,PSAOU,PSAOVDT,PSAOVDUZ,PSAPAGE,PSAPPDT,PSAPPDUZ,PSAPRICE
    24         K PSAPVDT,PSAPVDUZ,PSAQPDT,PSAQPDUZ,PSAQPREA,PSAQVDT,PSAQVDUZ,PSAQVREA,PSAREC,PSARUN,PSAS,PSASLN,PSASS,PSASTA,PSATOT,Y
    25         Q
    26         ;
    27 DATE(PSADATE)           ;convert date
    28         S %=$E(PSADATE,4,5)_"/"_$E(PSADATE,6,7)_"/"_$E(PSADATE,2,3)
    29         I $TR(%,"/")="" S %="UNKNOWN"
    30         Q %
    31         ;
    32 LINE    ;print line items
    33         D LINEHDR^PSAORDP2 S (PSAICOST,PSALN,PSATOT)=0
    34         F  S PSALN=+$O(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN)) Q:'PSALN!(PSAOUT)  D  Q:PSAOUT
    35         .Q:'$D(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,0))
    36         .S PSADATA=^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,0)
    37         .K PSADJQP,PSAQPDUZ,PSAQPDT,PSAQPREA,PSADJQV,PSAQVDUZ,PSAQVDT,PSAQVREA
    38         .K PSADJOP,PSAOPDUZ,PSAOPDT,PSADJOV,PSAOVDUZ,PSAOVDT
    39         .K PSADJPP,PSAPPDUZ,PSAPPDT,PSADJPV,PSAPVDUZ,PSAPVDT
    40         .K PSADJDP,PSADPDUZ,PSADPDT,PSADJDV,PSADVDUZ,PSADVDT
    41         .S PSADJSUP=0
    42         .I $D(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,2)) S PSAMORE=4 D
    43         ..S:+$P(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,2),"^") PSAMORE=5
    44         ..S:+$P(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,2),"^",2) PSAMORE=PSAMORE+1
    45         .E  S PSAMORE=4
    46         .I ($Y+PSAMORE)>IOSL D:$E(IOST,1,2)="C-" SCREEN^PSAORDP2 Q:PSAOUT  D HEADER^PSAORDP2,LINEHDR^PSAORDP2
    47         .W !,$P(PSADATA,"^")
    48 DRUG    .S PSADRG=0,PSADJ=+$O(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,1,"B","D",0))
    49         .I $G(PSADJ) D
    50         ..S PSANODE=$G(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,1,PSADJ,0))
    51         ..S PSADJD=$S($P(PSANODE,"^",6)'="":$P(PSANODE,"^",6),1:$P(PSANODE,"^",2))
    52         ..I $G(PSADJD),$L(PSADJD)=$L(+PSADJD),$P($G(^PSDRUG(+PSADJD,0)),"^")'="" D  Q
    53         ...W ?8,"*"_$P($G(^PSDRUG(+PSADJD,0)),"^") S PSADJDRG=1,PSADRG=PSADJD
    54         ...I $P(PSANODE,"^",6)'="" S PSADJDV=$P(PSANODE,"^",6),PSADVDT=$P(PSANODE,"^",8),PSADVDUZ=$P(PSANODE,"^",9)
    55         ...I $P(PSANODE,"^",2)'="" S PSADJDP=$P(PSANODE,"^",2),PSADPDT=$P(PSANODE,"^",4),PSADPDUZ=$P(PSANODE,"^",5)
    56         ..I $G(PSADJD),$L(PSADJD)=$L(+PSADJD),$P($G(^PSDRUG(+PSADJD,0)),"^")="" S PSADJ=0 Q
    57         ..W ?7,"**"_PSADJD S PSADJSUP=1,PSADRG=0
    58         ..I $P(PSANODE,"^",6)'="" S PSADJDV=$P(PSANODE,"^",6),PSADVDT=$P(PSANODE,"^",8),PSADVDUZ=$P(PSANODE,"^",9)
    59         ..I $P(PSANODE,"^",2)'="" S PSADJDP=$P(PSANODE,"^",2),PSADPDT=$P(PSANODE,"^",4),PSADPDUZ=$P(PSANODE,"^",5)
    60         .I '$G(PSADJ) D
    61         ..S PSADRG=$S(+$P(PSADATA,"^",2)&($P($G(^PSDRUG(+$P(PSADATA,"^",2),0)),"^")'=""):+$P(PSADATA,"^",2),1:0)
    62         ..W ?9,$S(+$P(PSADATA,"^",2)&($P($G(^PSDRUG(+$P(PSADATA,"^",2),0)),"^")'=""):$P(^PSDRUG(+$P(PSADATA,"^",2),0),"^"),1:"DRUG UNKNOWN")
    63 CS      .I +$P(PSADATA,"^",10) W " (CONTROLLED SUBS)" I $P($G(^PSD(58.8,+$P(PSAIN,"^",12),1,PSADRG,0)),"^",14),$P($G(^(0)),"^",14)'>DT W !?5,"*** INACTIVE IN MASTER VAULT ***"
    64         .E  I PSADRG,$P($G(^PSD(58.8,+$P(PSAIN,"^",5),1,PSADRG,0)),"^",14),$P($G(^(0)),"^",14)'>DT W !?5,"*** INACTIVE IN PHARMACY LOCATION ***"
    65         .I PSADRG,$D(^PSDRUG(+PSADRG,"I")) W !?5,"*** INACTIVE IN DRUG FILE ***"
    66         .;
    67 UPC     .W:$P(PSADATA,"^",13)'="" !?9,"UPC: "_$P(PSADATA,"^",13)
    68 NDC     .S PSANDC=$P(PSADATA,"^",11)
    69         .I $E(PSANDC)'="S" D PSANDC1^PSAHELP S PSANDC=PSANDCX K PSANDCX W !?9,PSANDC
    70         .S PSASUB=$S(+$P($G(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,2)),"^",3):+$P($G(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,2)),"^",3),$G(PSANDC)'="":$S(+$O(^PSDRUG("C",PSANDC,+PSADRG,0)):+$O(^PSDRUG("C",PSANDC,+PSADRG,0)),1:0),1:0)
    71 VSN     .W ?25,$S($P(PSADATA,"^",12)'="":$P(PSADATA,"^",12),1:"VSN UNKNOWN")
    72         .;
    73 QTY     .;No Adj. Qty
    74         .S PSAIECST=PSAIECST+($P(PSADATA,"^",3)*$P(PSADATA,"^",5))
    75         .S PSADJP=0,PSADJ=+$O(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,1,"B","P",0))
    76         .I $G(PSADJ) S PSANODE=$G(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,1,PSADJ,0)),PSAPRICE=$S($P(PSANODE,"^",6)'="":$P(PSANODE,"^",6),1:+$P(PSANODE,"^",2))
    77         .I '$G(PSADJ) S PSAPRICE=$P(PSADATA,"^",5)
    78         .S PSADJQ="",PSADJ=+$O(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,1,"B","Q",0))
    79         .I $G(PSADJ) S PSANODE=$G(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,1,PSADJ,0)),PSADJQ=$S($P(PSANODE,"^",6)'="":+$P(PSANODE,"^",6),1:$P(PSANODE,"^",2))
    80         .;Adj. Qty
    81         .I $G(PSADJQ) D
    82         ..I $P(PSANODE,"^",6)'="" S PSADJQV=$P(PSANODE,"^",6),PSAQVREA=$P(PSANODE,"^",7),PSAQVDT=$P(PSANODE,"^",8),PSAQVDUZ=$P(PSANODE,"^",9)
    83         ..I $P(PSANODE,"^",2)'="" S PSADJQP=$P(PSANODE,"^",2),PSAQPREA=$P(PSANODE,"^",3),PSAQPDT=$P(PSANODE,"^",4),PSAQPDUZ=$P(PSANODE,"^",5)
    84         ..S PSAECOST=PSADJQ*PSAPRICE,PSAAECST=PSAAECST+PSAECOST
    85         ..W ?40,$S($G(PSADJQV)'="":$J(PSADJQV,6),1:$J(PSADJQP,6))_"("_$P(PSADATA,"^",3)_")"
    86         .I '$G(PSADJQ) W ?40,$J($P(PSADATA,"^",3),6) S PSAECOST=$P(PSADATA,"^",3)*PSAPRICE,PSAAECST=PSAAECST+PSAECOST
    87         .;
    88 OU      .;Order Unit
    89         .S PSAOU=$S(+$P(PSADATA,"^",4):$P($G(^DIC(51.5,+$P(PSADATA,"^",4),0)),"^"),+PSASUB&(+$P($G(^PSDRUG(PSADRG,1,+PSASUB,0)),"^",5)):$P($G(^DIC(51.5,+$P($G(^PSDRUG(PSADRG,1,+PSASUB,0)),"^",5),0)),"^"),1:"")
    90         .S PSADJO="",PSADJ=+$O(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,1,"B","O",0))
    91         .I $G(PSADJ) S PSANODE=$G(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,1,PSADJ,0)),PSADJO=$S($P(PSANODE,"^",6)'="":$P(PSANODE,"^",6),1:$P(PSANODE,"^",2))
    92         .;Adj. Order Unit
    93         .I PSADJO'="" D
    94         ..I $P(PSANODE,"^",6)'="" S PSADJOV=$P(PSANODE,"^",6),PSAOVDT=$P(PSANODE,"^",8),PSAOVDUZ=$P(PSANODE,"^",9)
    95         ..I $P(PSANODE,"^",2)'="" S PSADJOP=$P(PSANODE,"^",2),PSAOPDT=$P(PSANODE,"^",4),PSAOPDUZ=$P(PSANODE,"^",5)
    96         ..W ?53,$S(+PSADJO:$P($G(^DIC(51.5,+PSADJO,0)),"^"),1:"UNKNOWN")_" ("_$S(PSAOU'="":PSAOU,1:"")_")"
    97         .I PSADJO="" W ?53,$S(PSAOU'="":PSAOU,1:"()")
    98         .;
    99 PRICE   .;Unit price
    100         .S PSADEC=$S($L($P($P(PSADATA,"^",5),".",2))>1:$L($P($P(PSADATA,"^",5),".",2)),1:2)
    101         .S PSADJP=0,PSADJ=+$O(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,1,"B","P",0))
    102         .I $G(PSADJ) S PSANODE=$G(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,1,PSADJ,0)),PSADJP=$S(+$P(PSANODE,"^",6):+$P(PSANODE,"^",6),1:+$P(PSANODE,"^",2))
    103         .;Adj. Unit Price
    104         .I $G(PSADJP) D
    105         ..I +$P(PSANODE,"^",6) S PSADJPV=$P(PSANODE,"^",6),PSAPVDT=$P(PSANODE,"^",8),PSAPVDUZ=$P(PSANODE,"^",9)
    106         ..I +$P(PSANODE,"^",2) S PSADJPP=$P(PSANODE,"^",2),PSAPPDT=$P(PSANODE,"^",4),PSAPPDUZ=$P(PSANODE,"^",5)
    107         ..W ?60,$J(PSADJP,7,2)_" ("_$S(+$P(PSADATA,"^",5):$P(PSADATA,"^",5),$P(PSADATA,"^",5)=0:0,1:"")_")"
    108         .I '$G(PSADJP) D
    109         ..I +$P(PSADATA,"^",5)!($P(PSADATA,"^",5)=0) W ?60,$S(+$P(PSADATA,"^",5):$J($P(PSADATA,"^",5),7,PSADEC),1:0) Q
    110         ..W ?65,"(Blank)"
    111         .;
    112 XCOST   .;Extended cost
    113         .W:PSADJP ?67,$J(PSAECOST,7,2) W:'PSADJP ?70,$J(PSAECOST,9,2)
    114         .;
    115 LEVELS  .;DAVE B (PSA*3*3)
    116         .S OU=$P($G(^PSDRUG(+PSADRG,660)),"^",2) I OU'="" S OU=$P($G(^DIC(51.5,OU,0)),"^",1)
    117         .W !!,"Drug file Data - Dispense Unit: ",$P($G(^PSDRUG(+PSADRG,660)),"^",8),?40,"Order Unit : ",$G(OU)
    118         .;W !,?20," Disp. Unit: ",$P($G(^PSDRUG(+PSADRG,660)),"^",8)
    119         .W " DUOU: ",$P($G(^PSDRUG(+PSADRG,660)),"^",5)
    120         .W !,"Invoiced ",?40,"Order Unit : ",$S($P(PSADATA,"^",4)=""!($P(PSADATA,"^",4)=0):"None Sent",1:$S($P(PSADATA,"^",4)["~":"Invalid: "_$P(PSADATA,"^",4),1:$P(^DIC(51.5,$P(PSADATA,"^",4),0),"^")))
    121         .W " DUOU: ",$S(+$P($G(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,2)),"^")'=0:$P(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,2),"^"),1:"nothing changed")
    122         .K OU
    123         .W:+$P($G(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,2)),"^",4)'=0 !?9,"STOCK LEVEL  : "_$FN(+$P(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,2),"^",4),",")
    124         .W:+$P($G(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,2)),"^",2)'=0 !?9,"REORDER LEVEL: "_$FN(+$P(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,2),"^",2),",")
    125         .;
    126         .;BGN 67
    127         .D DISP2^PSAP67
    128         .;END 67
    129         .I $Y+5>IOSL D:$E(IOST,1,2)="C-" SCREEN^PSAORDP2 Q:PSAOUT  D HEADER^PSAORDP2 D LINEHDR^PSAORDP2
    130         .D ^PSAORDP2 Q:PSAOUT
    131         .W !
    132         Q:PSAOUT
    133         I $Y+5>IOSL D:$E(IOST,1,2)="C-" SCREEN^PSAORDP2 Q:PSAOUT  D HEADER^PSAORDP2
    134         W !,PSASLN
    135         S PSADJSUP=$S($P($G(^PSD(58.811,PSAORD,1,PSAINV,0)),"^",13)=1:1,1:0)
    136         I $G(PSAAECST)'=$G(PSAIECST) D
    137         .W !?47,"TOTAL ADJUSTED COST",?67,$J(PSAAECST,12,2),!
    138         .I +$O(^PSD(58.811,PSAORD,1,PSAINV,2,0)) D
    139         ..S PSACIEN=0 F  S PSACIEN=+$O(^PSD(58.811,PSAORD,1,PSAINV,2,PSACIEN)) Q:'PSACIEN  D
    140         ...Q:'$D(^PSD(58.811,PSAORD,1,PSAINV,2,PSACIEN,0))
    141         ...I $Y+3>IOSL D:$E(IOST,1,2)="C-" SCREEN^PSAORDP2 Q:PSAOUT  D HEADER^PSAORDP2
    142         ...W:+$P(^PSD(58.811,PSAORD,1,PSAINV,2,PSACIEN,0),"^",3) ?55,"CREDIT MEMO "_$J($P(^(0),"^",3),12,2),!
    143         W !?47,"TOTAL INVOICED COST",?67,$J(PSAIECST,12,2)
    144         S PSAEND=1
    145         I $E(IOST)'="C" D
    146         .I PSADJDRG D:$Y+4>IOSL HEADER^PSAORDP2 W !!," * THE DRUG WAS MATCHED TO THE DRUG FILE.",!
    147         .I PSADJSUP D:$Y+4>IOSL HEADER^PSAORDP2 W !,"** THE ITEM IS A SUPPLY ITEM.",!
    148         D:$E(IOST,1,2)="C-" SCREEN^PSAORDP2
    149         W !
    150         Q
     1PSAORDP1 ;BIR/JMB-Print Orders - CONT'D ;9/19/97
     2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**3,12,21,61,65**; 10/24/97;Build 2
     3 ;This routine prints invoices.
     4 ;
     5 ;References to global ^DIC(51.5 are covered by IA #1931
     6 ;References to global ^PSDRUG( are covered by IA #2095
     7 ;References to global ^PSDRUG("C" are covered by IA #2095
     8 ;
     9DQ S IOM=80 D NOW^%DTC S Y=% D DD^%DT S PSARUN=$E(Y,1,18),PSAPAGE=1,$P(PSASLN,"-",80)="",$P(PSADLN,"=",80)="",(PSADJDRG,PSAOUT)=0,PSAFPG=1
     10 S PSAEND=0,PSAORDER=$P(^PSD(58.811,PSAORD,0),"^") D HEADER^PSAORDP2
     11 S PSAIN=$G(^PSD(58.811,PSAORD,1,PSAINV,0)),PSAINVN=$P(PSAIN,"^"),PSASTA=$P(PSAIN,"^",3),PSADEL=+$P(PSAIN,"^",6),PSAREC=+$P(PSAIN,"^",7)
     12START W !,"PRIME VENDOR : ",$S($P($G(^PSD(58.811,PSAORD,0)),"^",2)'="":$P($G(^(0)),"^",2),1:"UNKNOWN")
     13 W !!,"ORDER#  : "_PSAORDER,?40,"ORDER DATE   : "_$$DATE($P(PSAIN,"^",4))
     14 W !,"INVOICE#: "_PSAINVN,?40,"INVOICE DATE : "_$$DATE($P(PSAIN,"^",2))
     15 W !,"STATUS  : "_$S(PSASTA="P":"PROCESSED",PSASTA="V":"VERIFIED",PSASTA="L":"LOCKED VERIFYING",PSASTA="C":"COMPLETED",1:"UNKNOWN")_$S(+$P(PSAIN,"^",13):" (SUPPLY INVOICE)",1:"") ;;<*65 RJS>
     16 W ?40,"DELIVERY DATE: "_$S(PSADEL:$$DATE(PSADEL),1:"UNKNOWN")
     17 W !?40,"DATE RECEIVED: "_$S(PSAREC:$$DATE(PSAREC),PSADEL:$$DATE(PSADEL),1:"UNKNOWN"),!
     18 S PSADJDRG=0 S (PSAIECST,PSAAECST)=0 D LINE
     19 ;
     20EXIT ;Kills
     21 K %,DIR,DIRUT,PSAAECST,PSACIEN,PSADATA,PSADATE,PSADEC,PSADEL,PSADJ,PSADJD,PSADJDP,PSADJDRG,PSADJSUP,PSADJDV,PSADPDT,PSADPDUZ,PSADVDT,PSADVDUZ,PSADJO,PSADJOP,PSADJOV
     22 K PSADJP,PSADJPP,PSADJPV,PSADJQ,PSADJQP,PSADJQV,PSADLN,PSADRG,PSAECOST,PSAEND,PSAFPG,PSAICOST,PSAIECST,PSAIN,PSAINVN
     23 K PSALN,PSAMORE,PSANDC,PSANODE,PSAOPDT,PSAOPDUZ,PSAORDER,PSAOU,PSAOVDT,PSAOVDUZ,PSAPAGE,PSAPPDT,PSAPPDUZ,PSAPRICE
     24 K PSAPVDT,PSAPVDUZ,PSAQPDT,PSAQPDUZ,PSAQPREA,PSAQVDT,PSAQVDUZ,PSAQVREA,PSAREC,PSARUN,PSAS,PSASLN,PSASS,PSASTA,PSATOT,Y
     25 Q
     26 ;
     27DATE(PSADATE)         ;convert date
     28 S %=$E(PSADATE,4,5)_"/"_$E(PSADATE,6,7)_"/"_$E(PSADATE,2,3)
     29 I $TR(%,"/")="" S %="UNKNOWN"
     30 Q %
     31 ;
     32LINE ;print line items
     33 D LINEHDR^PSAORDP2 S (PSAICOST,PSALN,PSATOT)=0
     34 F  S PSALN=+$O(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN)) Q:'PSALN!(PSAOUT)  D  Q:PSAOUT
     35 .Q:'$D(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,0))
     36 .S PSADATA=^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,0)
     37 .K PSADJQP,PSAQPDUZ,PSAQPDT,PSAQPREA,PSADJQV,PSAQVDUZ,PSAQVDT,PSAQVREA
     38 .K PSADJOP,PSAOPDUZ,PSAOPDT,PSADJOV,PSAOVDUZ,PSAOVDT
     39 .K PSADJPP,PSAPPDUZ,PSAPPDT,PSADJPV,PSAPVDUZ,PSAPVDT
     40 .K PSADJDP,PSADPDUZ,PSADPDT,PSADJDV,PSADVDUZ,PSADVDT
     41 .S PSADJSUP=0
     42 .I $D(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,2)) S PSAMORE=4 D
     43 ..S:+$P(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,2),"^") PSAMORE=5
     44 ..S:+$P(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,2),"^",2) PSAMORE=PSAMORE+1
     45 .E  S PSAMORE=4
     46 .I ($Y+PSAMORE)>IOSL D:$E(IOST,1,2)="C-" SCREEN^PSAORDP2 Q:PSAOUT  D HEADER^PSAORDP2,LINEHDR^PSAORDP2
     47 .W !,$P(PSADATA,"^")
     48DRUG .S PSADRG=0,PSADJ=+$O(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,1,"B","D",0))
     49 .I $G(PSADJ) D
     50 ..S PSANODE=$G(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,1,PSADJ,0))
     51 ..S PSADJD=$S($P(PSANODE,"^",6)'="":$P(PSANODE,"^",6),1:$P(PSANODE,"^",2))
     52 ..I $G(PSADJD),$L(PSADJD)=$L(+PSADJD),$P($G(^PSDRUG(+PSADJD,0)),"^")'="" D  Q
     53 ...W ?8,"*"_$P($G(^PSDRUG(+PSADJD,0)),"^") S PSADJDRG=1,PSADRG=PSADJD
     54 ...I $P(PSANODE,"^",6)'="" S PSADJDV=$P(PSANODE,"^",6),PSADVDT=$P(PSANODE,"^",8),PSADVDUZ=$P(PSANODE,"^",9)
     55 ...I $P(PSANODE,"^",2)'="" S PSADJDP=$P(PSANODE,"^",2),PSADPDT=$P(PSANODE,"^",4),PSADPDUZ=$P(PSANODE,"^",5)
     56 ..I $G(PSADJD),$L(PSADJD)=$L(+PSADJD),$P($G(^PSDRUG(+PSADJD,0)),"^")="" S PSADJ=0 Q
     57 ..W ?7,"**"_PSADJD S PSADJSUP=1,PSADRG=0
     58 ..I $P(PSANODE,"^",6)'="" S PSADJDV=$P(PSANODE,"^",6),PSADVDT=$P(PSANODE,"^",8),PSADVDUZ=$P(PSANODE,"^",9)
     59 ..I $P(PSANODE,"^",2)'="" S PSADJDP=$P(PSANODE,"^",2),PSADPDT=$P(PSANODE,"^",4),PSADPDUZ=$P(PSANODE,"^",5)
     60 .I '$G(PSADJ) D
     61 ..S PSADRG=$S(+$P(PSADATA,"^",2)&($P($G(^PSDRUG(+$P(PSADATA,"^",2),0)),"^")'=""):+$P(PSADATA,"^",2),1:0)
     62 ..W ?9,$S(+$P(PSADATA,"^",2)&($P($G(^PSDRUG(+$P(PSADATA,"^",2),0)),"^")'=""):$P(^PSDRUG(+$P(PSADATA,"^",2),0),"^"),1:"DRUG UNKNOWN")
     63CS .I +$P(PSADATA,"^",10) W " (CONTROLLED SUBS)" I $P($G(^PSD(58.8,+$P(PSAIN,"^",12),1,PSADRG,0)),"^",14),$P($G(^(0)),"^",14)'>DT W !?5,"*** INACTIVE IN MASTER VAULT ***"
     64 .E  I PSADRG,$P($G(^PSD(58.8,+$P(PSAIN,"^",5),1,PSADRG,0)),"^",14),$P($G(^(0)),"^",14)'>DT W !?5,"*** INACTIVE IN PHARMACY LOCATION ***"
     65 .I PSADRG,$D(^PSDRUG(+PSADRG,"I")) W !?5,"*** INACTIVE IN DRUG FILE ***"
     66 .;
     67UPC .W:$P(PSADATA,"^",13)'="" !?9,"UPC: "_$P(PSADATA,"^",13)
     68NDC .S PSANDC=$P(PSADATA,"^",11)
     69 .I $E(PSANDC)'="S" D PSANDC1^PSAHELP S PSANDC=PSANDCX K PSANDCX W !?9,PSANDC
     70 .S PSASUB=$S(+$P($G(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,2)),"^",3):+$P($G(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,2)),"^",3),$G(PSANDC)'="":$S(+$O(^PSDRUG("C",PSANDC,+PSADRG,0)):+$O(^PSDRUG("C",PSANDC,+PSADRG,0)),1:0),1:0)
     71VSN .W ?25,$S($P(PSADATA,"^",12)'="":$P(PSADATA,"^",12),1:"VSN UNKNOWN")
     72 .;
     73QTY .;No Adj. Qty
     74 .S PSAIECST=PSAIECST+($P(PSADATA,"^",3)*$P(PSADATA,"^",5))
     75 .S PSADJP=0,PSADJ=+$O(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,1,"B","P",0))
     76 .I $G(PSADJ) S PSANODE=$G(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,1,PSADJ,0)),PSAPRICE=$S($P(PSANODE,"^",6)'="":$P(PSANODE,"^",6),1:+$P(PSANODE,"^",2))
     77 .I '$G(PSADJ) S PSAPRICE=$P(PSADATA,"^",5)
     78 .S PSADJQ="",PSADJ=+$O(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,1,"B","Q",0))
     79 .I $G(PSADJ) S PSANODE=$G(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,1,PSADJ,0)),PSADJQ=$S($P(PSANODE,"^",6)'="":+$P(PSANODE,"^",6),1:$P(PSANODE,"^",2))
     80 .;Adj. Qty
     81 .I $G(PSADJQ) D
     82 ..I $P(PSANODE,"^",6)'="" S PSADJQV=$P(PSANODE,"^",6),PSAQVREA=$P(PSANODE,"^",7),PSAQVDT=$P(PSANODE,"^",8),PSAQVDUZ=$P(PSANODE,"^",9)
     83 ..I $P(PSANODE,"^",2)'="" S PSADJQP=$P(PSANODE,"^",2),PSAQPREA=$P(PSANODE,"^",3),PSAQPDT=$P(PSANODE,"^",4),PSAQPDUZ=$P(PSANODE,"^",5)
     84 ..S PSAECOST=PSADJQ*PSAPRICE,PSAAECST=PSAAECST+PSAECOST
     85 ..W ?40,$S($G(PSADJQV)'="":$J(PSADJQV,6),1:$J(PSADJQP,6))_"("_$P(PSADATA,"^",3)_")"
     86 .I '$G(PSADJQ) W ?40,$J($P(PSADATA,"^",3),6) S PSAECOST=$P(PSADATA,"^",3)*PSAPRICE,PSAAECST=PSAAECST+PSAECOST
     87 .;
     88OU .;Order Unit
     89 .S PSAOU=$S(+$P(PSADATA,"^",4):$P($G(^DIC(51.5,+$P(PSADATA,"^",4),0)),"^"),+PSASUB&(+$P($G(^PSDRUG(PSADRG,1,+PSASUB,0)),"^",5)):$P($G(^DIC(51.5,+$P($G(^PSDRUG(PSADRG,1,+PSASUB,0)),"^",5),0)),"^"),1:"")
     90 .S PSADJO="",PSADJ=+$O(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,1,"B","O",0))
     91 .I $G(PSADJ) S PSANODE=$G(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,1,PSADJ,0)),PSADJO=$S($P(PSANODE,"^",6)'="":$P(PSANODE,"^",6),1:$P(PSANODE,"^",2))
     92 .;Adj. Order Unit
     93 .I PSADJO'="" D
     94 ..I $P(PSANODE,"^",6)'="" S PSADJOV=$P(PSANODE,"^",6),PSAOVDT=$P(PSANODE,"^",8),PSAOVDUZ=$P(PSANODE,"^",9)
     95 ..I $P(PSANODE,"^",2)'="" S PSADJOP=$P(PSANODE,"^",2),PSAOPDT=$P(PSANODE,"^",4),PSAOPDUZ=$P(PSANODE,"^",5)
     96 ..W ?53,$S(+PSADJO:$P($G(^DIC(51.5,+PSADJO,0)),"^"),1:"UNKNOWN")_" ("_$S(PSAOU'="":PSAOU,1:"")_")"
     97 .I PSADJO="" W ?53,$S(PSAOU'="":PSAOU,1:"()")
     98 .;
     99PRICE .;Unit price
     100 .S PSADEC=$S($L($P($P(PSADATA,"^",5),".",2))>1:$L($P($P(PSADATA,"^",5),".",2)),1:2)
     101 .S PSADJP=0,PSADJ=+$O(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,1,"B","P",0))
     102 .I $G(PSADJ) S PSANODE=$G(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,1,PSADJ,0)),PSADJP=$S(+$P(PSANODE,"^",6):+$P(PSANODE,"^",6),1:+$P(PSANODE,"^",2))
     103 .;Adj. Unit Price
     104 .I $G(PSADJP) D
     105 ..I +$P(PSANODE,"^",6) S PSADJPV=$P(PSANODE,"^",6),PSAPVDT=$P(PSANODE,"^",8),PSAPVDUZ=$P(PSANODE,"^",9)
     106 ..I +$P(PSANODE,"^",2) S PSADJPP=$P(PSANODE,"^",2),PSAPPDT=$P(PSANODE,"^",4),PSAPPDUZ=$P(PSANODE,"^",5)
     107 ..W ?60,$J(PSADJP,7,2)_" ("_$S(+$P(PSADATA,"^",5):$P(PSADATA,"^",5),$P(PSADATA,"^",5)=0:0,1:"")_")"
     108 .I '$G(PSADJP) D
     109 ..I +$P(PSADATA,"^",5)!($P(PSADATA,"^",5)=0) W ?60,$S(+$P(PSADATA,"^",5):$J($P(PSADATA,"^",5),7,PSADEC),1:0) Q
     110 ..W ?65,"(Blank)"
     111 .;
     112XCOST .;Extended cost
     113 .W:PSADJP ?67,$J(PSAECOST,7,2) W:'PSADJP ?70,$J(PSAECOST,9,2)
     114 .;
     115LEVELS .;DAVE B (PSA*3*3)
     116 .S OU=$P($G(^PSDRUG(+PSADRG,660)),"^",2) I OU'="" S OU=$P($G(^DIC(51.5,OU,0)),"^",1)
     117 .W !!,"Drug file Data - Dispense Unit: ",$P($G(^PSDRUG(+PSADRG,660)),"^",8),?40,"Order Unit : ",$G(OU)
     118 .;W !,?20," Disp. Unit: ",$P($G(^PSDRUG(+PSADRG,660)),"^",8)
     119 .W " DUOU: ",$P($G(^PSDRUG(+PSADRG,660)),"^",5)
     120 .W !,"Invoiced ",?40,"Order Unit : ",$S($P(PSADATA,"^",4)=""!($P(PSADATA,"^",4)=0):"None Sent",1:$S($P(PSADATA,"^",4)["~":"Invalid: "_$P(PSADATA,"^",4),1:$P(^DIC(51.5,$P(PSADATA,"^",4),0),"^")))
     121 .W " DUOU: ",$S(+$P($G(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,2)),"^")'=0:$P(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,2),"^"),1:"nothing changed")
     122 .K OU
     123 .W:+$P($G(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,2)),"^",4)'=0 !?9,"STOCK LEVEL  : "_$FN(+$P(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,2),"^",4),",")
     124 .W:+$P($G(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,2)),"^",2)'=0 !?9,"REORDER LEVEL: "_$FN(+$P(^PSD(58.811,PSAORD,1,PSAINV,1,PSALN,2),"^",2),",")
     125 .;
     126 .I $Y+5>IOSL D:$E(IOST,1,2)="C-" SCREEN^PSAORDP2 Q:PSAOUT  D HEADER^PSAORDP2 D LINEHDR^PSAORDP2
     127 .D ^PSAORDP2 Q:PSAOUT
     128 .W !
     129 Q:PSAOUT
     130 I $Y+5>IOSL D:$E(IOST,1,2)="C-" SCREEN^PSAORDP2 Q:PSAOUT  D HEADER^PSAORDP2
     131 W !,PSASLN
     132 S PSADJSUP=$S($P($G(^PSD(58.811,PSAORD,1,PSAINV,0)),"^",13)=1:1,1:0)
     133 I $G(PSAAECST)'=$G(PSAIECST) D
     134 .W !?47,"TOTAL ADJUSTED COST",?67,$J(PSAAECST,12,2),!
     135 .I +$O(^PSD(58.811,PSAORD,1,PSAINV,2,0)) D
     136 ..S PSACIEN=0 F  S PSACIEN=+$O(^PSD(58.811,PSAORD,1,PSAINV,2,PSACIEN)) Q:'PSACIEN  D
     137 ...Q:'$D(^PSD(58.811,PSAORD,1,PSAINV,2,PSACIEN,0))
     138 ...I $Y+3>IOSL D:$E(IOST,1,2)="C-" SCREEN^PSAORDP2 Q:PSAOUT  D HEADER^PSAORDP2
     139 ...W:+$P(^PSD(58.811,PSAORD,1,PSAINV,2,PSACIEN,0),"^",3) ?55,"CREDIT MEMO "_$J($P(^(0),"^",3),12,2),!
     140 W !?47,"TOTAL INVOICED COST",?67,$J(PSAIECST,12,2)
     141 S PSAEND=1
     142 I $E(IOST)'="C" D
     143 .I PSADJDRG D:$Y+4>IOSL HEADER^PSAORDP2 W !!," * THE DRUG WAS MATCHED TO THE DRUG FILE.",!
     144 .I PSADJSUP D:$Y+4>IOSL HEADER^PSAORDP2 W !,"** THE ITEM IS A SUPPLY ITEM.",!
     145 D:$E(IOST,1,2)="C-" SCREEN^PSAORDP2
     146 W !
     147 Q
Note: See TracChangeset for help on using the changeset viewer.