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

    r613 r623  
    1 PSAUP4  ;BIR/JMB-Upload and Process Prime Vendor Invoice Data - CONT'D ;9/19/97
    2         ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**3,12,20,21,67**; 10/24/97;Build 15
    3         ;This routine prints invoices from the ^XTMP global on the screen or
    4         ;to a printer.
    5         ;
    6         ;References to ^PSDRUG( are covered by IA #2095
    7         ;References to ^DIC(51.5( are covered by IA #1931
    8         ;
    9         W !!,"Enter the device which will be used to print",!,"the invoices with all items, errors, and adjustments.",!
    10         S %ZIS="Q" D ^%ZIS I POP S PSAOUT=1 Q
    11         I $D(IO("Q")) S ZTDESC="Drug Acct. - Prime Vendor Invoice Upload Report",ZTRTN="DQ^PSAUP4" D ^%ZTLOAD Q
    12         ;
    13 DQ      ;queue starts here
    14         S IOM=80
    15         D NOW^%DTC S Y=% D DD^%DT S PSARUN=$E(Y,1,18),$P(PSASLN,"-",80)="",$P(PSADLN,"=",80)="",(PSADJDRG,PSADJSUP,PSAOUT)=0,PSAFPG=1
    16         U IO
    17         S PSACTRL=0 F  S PSACTRL=$O(^XTMP("PSAPV",PSACTRL)) Q:PSACTRL=""!(PSAOUT)  D START
    18         W @IOF D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@" K IO("Q")
    19         ;
    20 EXIT    ;Kills printing variables only
    21         K %,%ZIS,DIR,DIRUT,PSAAECST,PSABY,PSACS,PSACTRL,PSADATA,PSADATE,PSADEC,PSADRG,PSADJDRG,PSADJORD,PSADJQTY,PSADJSUP,PSADLN,PSADS,PSAECOST,PSAEND,PSAFPG,PSAICOST,PSAIECST
    22         K PSAIN,PSALINE,PSANDC,PSAODT,PSAODUZ,PSAOREA,PSAOUT,PSAPAGE,PSAPHARM,PSAQDT,PSAQDUZ,PSAQREA,PSAMV,PSARUN,PSAS,PSASLN,PSASS,PSAST,PSASTA,PSATOT,Y,ZTDESC,ZTRTN,ZTSK
    23         Q
    24         ;
    25 START   S PSAPAGE=1,PSAEND=0 D HEADER S PSAIN=$G(^XTMP("PSAPV",PSACTRL,"IN"))
    26         S (PSADJDRG,PSADJSUP,PSAIECST,PSAAECST)=0,PSAPHARM=$P(PSAIN,"^",7),PSAMV=$P(PSAIN,"^",12)
    27         W !,"PRIME VENDOR : ",$S($P($G(^XTMP("PSAPV",PSACTRL,"DS")),"^")'="":$P($G(^("DS")),"^"),1:"UNKNOWN")
    28         W !!,"ORDER#  : "_$P(PSAIN,"^",4),?40,"ORDER DATE  : "_$$DATE($P(PSAIN,"^",3))
    29         W !,"INVOICE#: "_$P(PSAIN,"^",2),?40,"INVOICE DATE: "_$$DATE(+PSAIN)
    30         S PSASTA=$P(PSAIN,"^",8)
    31         W !,"STATUS  : "_$S(PSASTA="":"UPLOADED WITH ERRORS",PSASTA="OK":"UPLOADED WITHOUT ERRORS",PSASTA="P":"PROCESSED",1:"UNKNOWN")_$S($P(PSAIN,"^",13)="SUP":" (SUPPLY INVOICE)",1:"")
    32         I $Y+8>IOSL D:$E(IOST,1,2)="C-" SCREEN Q:PSAOUT  D HEADER
    33         I $E(IOST,1,2)="C-" D LINE Q
    34         W !!,"DELIVERY DATE REQUESTED: ",$$DATE($P(PSAIN,"^",5))
    35         W !,"DATE RECEIVED          : "_$S(+$P(PSAIN,"^",11)&($$DATE(+$P(PSAIN,"^",11))):" ("_$$DATE($P(PSAIN,"^",6))_")",1:$$DATE($P(PSAIN,"^",6)))
    36         I $Y+8>IOSL D:$E(IOST,1,2)="C-" SCREEN Q:$G(PSAOUT)  D HEADER
    37         ;
    38 BUYSHIP W !!,"BUYER INFORMATION:",?40,"SHIPPING INFORMATION:"
    39         S PSABY=$G(^XTMP("PSAPV",PSACTRL,"BY"))
    40         S PSAST=$G(^XTMP("PSAPV",PSACTRL,"ST"))
    41         W !?2,$P(PSABY,"^"),?42,$P(PSAST,"^")
    42         I $P(PSABY,"^",2)'=""!($P(PSAST,"^",2)'="") W ! W:$P(PSABY,"^",2)'="" ?2,$P(PSABY,"^",2) W:$P(PSAST,"^",2)'="" ?42,$P(PSAST,"^",2)
    43         I $P(PSABY,"^",3)'=""!($P(PSAST,"^",3)'="") W ! W:$P(PSABY,"^",3)'="" ?2,$P(PSABY,"^",3) W:$P(PSAST,"^",3)'="" ?42,$P(PSAST,"^",3)
    44         W !?2,$P(PSABY,"^",4)_" "_$P(PSABY,"^",5)_"  ",$P(PSABY,"^",6)
    45         W ?42,$P(PSAST,"^",4)_" "_$P(PSAST,"^",5)_"  ",$P(PSAST,"^",6)
    46         I $Y+8>IOSL D:$E(IOST,1,2)="C-" SCREEN Q:PSAOUT  D HEADER
    47         ;
    48 DISTRIB W !!,"DISTRIBUTOR INFORMATION:"
    49         S PSADS=$G(^XTMP("PSAPV",PSACTRL,"DS"))
    50         W !?2,$P(PSADS,"^")
    51         W:$P(PSADS,"^",2)'="" !?2,$P(PSADS,"^",2)
    52         W:$P(PSADS,"^",3)'="" !?2,$P(PSADS,"^",3)
    53         W !?2,$P(PSADS,"^",4)_" "_$P(PSADS,"^",5)_"  ",$P(PSADS,"^",6)
    54         I $Y+8>IOSL D:$E(IOST,1,2)="C-" SCREEN Q:PSAOUT  D HEADER
    55         D LINE
    56         Q
    57         ;
    58 DATE(PSADATE)           ;convert date
    59         S %=$E(PSADATE,4,5)_"/"_$E(PSADATE,6,7)_"/"_$E(PSADATE,2,3)
    60         I $TR(%,"/")="" S %="UNKNOWN"
    61         Q %
    62         ;
    63 LINE    ;print line items
    64         D LINEHDR
    65         S (PSAICOST,PSALINE,PSATOT)=0 F  S PSALINE=$O(^XTMP("PSAPV",PSACTRL,"IT",PSALINE)) Q:'PSALINE!(PSAOUT)  S PSADATA=^(PSALINE),PSADRG=0 D  Q:PSAOUT
    66         .I $Y+5>IOSL D:$E(IOST,1,2)="C-" SCREEN Q:PSAOUT  D HEADER,LINEHDR
    67         .K PSADJQTY,PSAQDUZ,PSAQDT,PSAQREA,PSADJORD,PSAODUZ,PSAODT,PSAOREA
    68         .W !,PSALINE
    69 DRUG    .;Drug
    70         .I +$P(PSADATA,"^",15) S PSADRG=+$P(PSADATA,"^",15) W ?8,"*"_$P($G(^PSDRUG(+$P(PSADATA,"^",15),0)),"^")_$S(+$P(PSADATA,"^",6)&($P($G(^PSDRUG(+$P(PSADATA,"^",6),0)),"^")'=""):" ("_$P(^PSDRUG(+$P(PSADATA,"^",6),0),"^")_")",1:"") S PSADJDRG=1
    71         .I PSADRG,$D(^PSDRUG(PSADRG,"I")) W !,?5,"** INACTIVE IN DRUG FILE **"
    72         .I '+$P(PSADATA,"^",15) D
    73         ..I +$P(PSADATA,"^",6),$P($G(^PSDRUG(+$P(PSADATA,"^",6),0)),"^")'="" W ?9,$P(^PSDRUG(+$P(PSADATA,"^",6),0),"^") S PSADRG=+$P(PSADATA,"^",6) Q
    74         ..I $P($G(^XTMP("PSAPV",PSACTRL,"IT",PSALINE,"SUP")),"^",3)'="" W ?7,"**"_$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE,"SUP"),"^",3)  S PSADJSUP=1,PSADRG=0 Q
    75         ..W ?9,"DRUG UNKNOWN"
    76         .I $P(PSADATA,"^",19)="CS" 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"
    77         .E  I PSADRG,$P($G(^PSD(58.8,+$P(PSAIN,"^",7),1,PSADRG,0)),"^",14),$P($G(^(0)),"^",14)'>DT W !?5,"*** INACTIVE IN PHARMACY LOCATION"
    78         .;UPC
    79         .I $P($P(PSADATA,"^",26),"~")'="" W !?9,"UPC: "_$P($P(PSADATA,"^",26),"~")
    80         .;NDC
    81         .S PSANDC=$P($P(PSADATA,"^",4),"~")
    82         .I $E(PSANDC)'="S" D
    83         ..W !?9 D PSANDC1^PSAHELP S PSANDC=PSANDCX
    84         ..I PSANDC'="" W PSANDC Q
    85         ..W "NDC UNKNOWN"
    86         .;
    87         .;VSN
    88         .W ?25,$S($P($P(PSADATA,"^",5),"~")'="":$E($P($P(PSADATA,"^",5),"~"),1,14),1:"VSN UNKNOWN")
    89         .;
    90         .;QTY
    91         .;No Adjusted Qty
    92         .S PSAIECST=PSAIECST+($P(PSADATA,"^")*$P(PSADATA,"^",3))
    93         .I $P(PSADATA,"^",8)="" W ?40,$J($P(PSADATA,"^"),6) S PSAECOST=$P(PSADATA,"^")*$P(PSADATA,"^",3),PSAAECST=PSAAECST+PSAECOST
    94         .;Adj. Qty (P)
    95         .I $P(PSADATA,"^",8)'="" D
    96         ..S PSADJQTY=$P(PSADATA,"^",8),PSAQDUZ=$P(PSADATA,"^",9),PSAQDT=$P(PSADATA,"^",10),PSAQREA=$P(PSADATA,"^",11)
    97         ..S PSAECOST=PSADJQTY*$P(PSADATA,"^",3),PSAAECST=PSAAECST+PSAECOST
    98         ..W ?40,$J($P(PSADATA,"^",8),6)_"("_$P(PSADATA,"^")_")"
    99         .;
    100 OU      .;Order Unit
    101         .I '+$P(PSADATA,"^",12) D
    102         ..I +$P($P(PSADATA,"^",2),"~",2),$P($G(^DIC(51.5,+$P($P(PSADATA,"^",2),"~",2),0)),"^")'="" W ?53,$P($G(^DIC(51.5,+$P($P(PSADATA,"^",2),"~",2),0)),"^") Q
    103         ..I $P($G(PSADATA),"^",2)'="",$P($G(PSADATA),"^",2)'["~",'$D(^DIC(51.5,"B",$P(PSADATA,"^",2))) W ?48," ?-> "_$P(PSADATA,"^",2)
    104         ..I $P($P(PSADATA,"^",2),"~")="" D ^PSAHELP
    105         .;Adj. OU (P)
    106         .I +$P(PSADATA,"^",12) S PSADJORD=$P(PSADATA,"^",12),PSAODUZ=$P(PSADATA,"^",13),PSAODT=$P(PSADATA,"^",14) W ?53,$P($G(^DIC(51.5,+$P(PSADATA,"^",12),0)),"^")_"("_$P($P(PSADATA,"^",2),"~")_")"
    107         .;Unit price
    108         .S PSADEC=$S($L($P($P(PSADATA,"^",3),".",2))>1:$L($P($P(PSADATA,"^",3),".",2)),1:2)
    109         .W ?59,$J($P(PSADATA,"^",3),7,PSADEC)
    110         .;Extended cost
    111         .W ?67,$J(PSAECOST,12,2)
    112         .I $Y+9>IOSL,+$P(PSADATA,"^",21),+$P(PSADATA,"^",27) D:$E(IOST,1,2)="C-" SCREEN Q:PSAOUT  D HEADER,LINEHDR
    113         .I $G(PSADRG) D HAVEDRG
    114         .I '$G(PSADRG) W !?9,"STOCK LEVEL  : ",!?9,"REORDER LEVEL: "_$P(PSADATA,"^",21),!?9,"DISPENSE UNITS/ORDER UNIT: " D DISP^PSAP67
    115         .;
    116         .;Print Adj Qty
    117         .I $G(PSADJQTY)'="" D
    118         ..I $Y+5>IOSL D:$E(IOST,1,2)="C-" SCREEN Q:PSAOUT  D HEADER,LINEHDR
    119         ..W !!?9,"ADJUSTED QUANTITY: "_PSADJQTY,!?9,$$DATE(PSAQDT)_" "_$P($G(^VA(200,+PSAQDUZ,0)),"^"),!?11,PSAQREA
    120         .;Print Adj OU
    121         .I +$G(PSADJORD) D
    122         ..I $Y+5>IOSL D:$E(IOST,1,2)="C-" SCREEN Q:PSAOUT  D HEADER,LINEHDR
    123         ..W !!,?9,"ADJUSTED ORDER UNIT: "_$P($G(^DIC(51.5,+PSADJORD,0)),"^")
    124         ..W !?9,$$DATE(PSAODT)_" "_$P($G(^VA(200,+PSAODUZ,0)),"^")_" - "_$P($G(^DIC(51.5,PSADJORD,0)),"^")
    125         .W !
    126         Q:PSAOUT
    127         I $Y+6>IOSL D:$E(IOST,1,2)="C-" SCREEN Q:PSAOUT  D HEADER
    128         W !,PSASLN
    129         W:$G(PSAAECST)'=$G(PSAIECST) !?48,"TOTAL ADUSTED COST",?67,$J(PSAAECST,12,2),!
    130         W !?48,"TOTAL INVOICED COST",?67,$J(PSAIECST,12,2)
    131         S PSAEND=1
    132         I $Y+5>IOSL D:$E(IOST,1,2)="C-" SCREEN Q:PSAOUT  D HEADER
    133         I PSADJDRG,$E(IOST)'="C" W !!,"* THE DRUG WAS MATCHED TO THE DRUG FILE."
    134         I PSADJSUP,$E(IOST)'="C" W !!,"* THE ITEM IS A SUPPLY ITEM."
    135         D:$E(IOST,1,2)="C-" SCREEN
    136         Q
    137         ;
    138 LINEHDR ;item header
    139         W !?50,"ORDER",?62,"COST/",?71,"EXTENDED"
    140         W !,"LINE#",?9,"NDC",?25,"VSN",?43,"QTY",?51,"UNIT",?62,"UNIT",?75,"COST",!,PSADLN,!
    141         Q
    142         ;
    143 HEADER  ;Page header
    144         I PSAFPG&($E(IOST,1,2)="C-") W @IOF G HDR1
    145         S PSAFPG=0
    146         W:'PSAFPG @IOF
    147 HDR1    W !?20,"DRUG ACCOUNTABILITY/INVENTORY INTERFACE"
    148         W !?26,"PRIME VENDOR UPLOAD REPORT",!
    149         W:PSAPAGE'=1 !,"ORDER#: "_$P(PSAIN,"^",4)_"  INVOICE#: "_$P(PSAIN,"^",2)
    150         I $E(IOST,1,2)="C-" W ?(74-$L(PSAPAGE)),"PAGE "_PSAPAGE,!,PSADLN
    151         I $E(IOST)'="C" W !,"RUN: "_PSARUN,?(74-$L(PSAPAGE)),"PAGE "_PSAPAGE,!,PSADLN
    152         S PSAPAGE=PSAPAGE+1
    153         Q
    154 SCREEN  ;Hold on screen
    155         S PSAS=20-$Y I PSAS F PSASS=1:1:PSAS W !
    156         I PSADJDRG,PSAEND W !," * THE DRUG WAS MATCHED TO THE DRUG FILE."
    157         I PSADJSUP,PSAEND W !,"** THE ITEM IS A SUPPLY ITEM."
    158         S DIR(0)="E" D ^DIR K DIR I $G(DIRUT) S PSAOUT=1
    159         Q
    160         ;
    161 HAVEDRG ;Display data if drug is found.
    162         ;DAVE B (PSA*3*20) 7SEP99 ADDED $G TO NEXT LINE
    163         S PSACS=$S($P($G(^PSDRUG(PSADRG,2)),"^",3)["N":1,1:0)
    164         I PSACS D
    165         .I PSAMV,+$P($G(^PSD(58.8,PSAMV,0)),"^",14) D  Q
    166         ..W !?9,"STOCK LEVEL  : "_$S(+$P(PSADATA,"^",27):+$P(PSADATA,"^",27),1:+$P($G(^PSD(58.8,PSAMV,1,PSADRG,0)),"^",3))
    167         ..W !?9,"REORDER LEVEL: "_$S(+$P(PSADATA,"^",21):+$P(PSADATA,"^",21),1:+$P($G(^PSD(58.8,PSAMV,1,PSADRG,0)),"^",5))
    168         .I 'PSAMV W !?9,"STOCK LEVEL  : "_$P(PSADATA,"^",27),!?9,"REORDER LEVEL: "_$P(PSADATA,"^",21)
    169         I 'PSACS D
    170         .I PSAPHARM,+$P($G(^PSD(58.8,PSAPHARM,0)),"^",14) D
    171         ..W !?9,"STOCK LEVEL  : "_$S(+$P(PSADATA,"^",27):+$P(PSADATA,"^",27),1:+$P($G(^PSD(58.8,PSAPHARM,1,PSADRG,0)),"^",3))
    172         ..W !?9,"REORDER LEVEL: "_$S(+$P(PSADATA,"^",21):+$P(PSADATA,"^",21),1:+$P($G(^PSD(58.8,PSAPHARM,1,PSADRG,0)),"^",5))
    173         .I 'PSAPHARM W !?9,"STOCK LEVEL  : "_$P(PSADATA,"^",27),!?9,"REORDER LEVEL: "_$P(PSADATA,"^",21)
    174         W !?9,"DISPENSE UNITS/ORDER UNIT: "
    175         W $S(+$P(PSADATA,"^",20):+$P(PSADATA,"^",20),+$P($G(^PSDRUG(PSADRG,1,+$P(PSADATA,"^",7),0)),"^",7):+$P($G(^PSDRUG(PSADRG,1,+$P(PSADATA,"^",7),0)),"^",7),1:"")
    176         D DISP^PSAP67
    177         Q
     1PSAUP4 ;BIR/JMB-Upload and Process Prime Vendor Invoice Data - CONT'D ;9/19/97
     2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**3,12,20,21**; 10/24/97
     3 ;This routine prints invoices from the ^XTMP global on the screen or
     4 ;to a printer.
     5 ;
     6 ;References to ^PSDRUG( are covered by IA #2095
     7 ;References to ^DIC(51.5( are covered by IA #1931
     8 ;
     9 W !!,"Enter the device which will be used to print",!,"the invoices with all items, errors, and adjustments.",!
     10 S %ZIS="Q" D ^%ZIS I POP S PSAOUT=1 Q
     11 I $D(IO("Q")) S ZTDESC="Drug Acct. - Prime Vendor Invoice Upload Report",ZTRTN="DQ^PSAUP4" D ^%ZTLOAD Q
     12 ;
     13DQ ;queue starts here
     14 S IOM=80
     15 D NOW^%DTC S Y=% D DD^%DT S PSARUN=$E(Y,1,18),$P(PSASLN,"-",80)="",$P(PSADLN,"=",80)="",(PSADJDRG,PSADJSUP,PSAOUT)=0,PSAFPG=1
     16 U IO
     17 S PSACTRL=0 F  S PSACTRL=$O(^XTMP("PSAPV",PSACTRL)) Q:PSACTRL=""!(PSAOUT)  D START
     18 W @IOF D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@" K IO("Q")
     19 ;
     20EXIT ;Kills printing variables only
     21 K %,%ZIS,DIR,DIRUT,PSAAECST,PSABY,PSACS,PSACTRL,PSADATA,PSADATE,PSADEC,PSADRG,PSADJDRG,PSADJORD,PSADJQTY,PSADJSUP,PSADLN,PSADS,PSAECOST,PSAEND,PSAFPG,PSAICOST,PSAIECST
     22 K PSAIN,PSALINE,PSANDC,PSAODT,PSAODUZ,PSAOREA,PSAOUT,PSAPAGE,PSAPHARM,PSAQDT,PSAQDUZ,PSAQREA,PSAMV,PSARUN,PSAS,PSASLN,PSASS,PSAST,PSASTA,PSATOT,Y,ZTDESC,ZTRTN,ZTSK
     23 Q
     24 ;
     25START S PSAPAGE=1,PSAEND=0 D HEADER S PSAIN=$G(^XTMP("PSAPV",PSACTRL,"IN"))
     26 S (PSADJDRG,PSADJSUP,PSAIECST,PSAAECST)=0,PSAPHARM=$P(PSAIN,"^",7),PSAMV=$P(PSAIN,"^",12)
     27 W !,"PRIME VENDOR : ",$S($P($G(^XTMP("PSAPV",PSACTRL,"DS")),"^")'="":$P($G(^("DS")),"^"),1:"UNKNOWN")
     28 W !!,"ORDER#  : "_$P(PSAIN,"^",4),?40,"ORDER DATE  : "_$$DATE($P(PSAIN,"^",3))
     29 W !,"INVOICE#: "_$P(PSAIN,"^",2),?40,"INVOICE DATE: "_$$DATE(+PSAIN)
     30 S PSASTA=$P(PSAIN,"^",8)
     31 W !,"STATUS  : "_$S(PSASTA="":"UPLOADED WITH ERRORS",PSASTA="OK":"UPLOADED WITHOUT ERRORS",PSASTA="P":"PROCESSED",1:"UNKNOWN")_$S($P(PSAIN,"^",13)="SUP":" (SUPPLY INVOICE)",1:"")
     32 I $Y+8>IOSL D:$E(IOST,1,2)="C-" SCREEN Q:PSAOUT  D HEADER
     33 I $E(IOST,1,2)="C-" D LINE Q
     34 W !!,"DELIVERY DATE REQUESTED: ",$$DATE($P(PSAIN,"^",5))
     35 W !,"DATE RECEIVED          : "_$S(+$P(PSAIN,"^",11)&($$DATE(+$P(PSAIN,"^",11))):" ("_$$DATE($P(PSAIN,"^",6))_")",1:$$DATE($P(PSAIN,"^",6)))
     36 I $Y+8>IOSL D:$E(IOST,1,2)="C-" SCREEN Q:$G(PSAOUT)  D HEADER
     37 ;
     38BUYSHIP W !!,"BUYER INFORMATION:",?40,"SHIPPING INFORMATION:"
     39 S PSABY=$G(^XTMP("PSAPV",PSACTRL,"BY"))
     40 S PSAST=$G(^XTMP("PSAPV",PSACTRL,"ST"))
     41 W !?2,$P(PSABY,"^"),?42,$P(PSAST,"^")
     42 I $P(PSABY,"^",2)'=""!($P(PSAST,"^",2)'="") W ! W:$P(PSABY,"^",2)'="" ?2,$P(PSABY,"^",2) W:$P(PSAST,"^",2)'="" ?42,$P(PSAST,"^",2)
     43 I $P(PSABY,"^",3)'=""!($P(PSAST,"^",3)'="") W ! W:$P(PSABY,"^",3)'="" ?2,$P(PSABY,"^",3) W:$P(PSAST,"^",3)'="" ?42,$P(PSAST,"^",3)
     44 W !?2,$P(PSABY,"^",4)_" "_$P(PSABY,"^",5)_"  ",$P(PSABY,"^",6)
     45 W ?42,$P(PSAST,"^",4)_" "_$P(PSAST,"^",5)_"  ",$P(PSAST,"^",6)
     46 I $Y+8>IOSL D:$E(IOST,1,2)="C-" SCREEN Q:PSAOUT  D HEADER
     47 ;
     48DISTRIB W !!,"DISTRIBUTOR INFORMATION:"
     49 S PSADS=$G(^XTMP("PSAPV",PSACTRL,"DS"))
     50 W !?2,$P(PSADS,"^")
     51 W:$P(PSADS,"^",2)'="" !?2,$P(PSADS,"^",2)
     52 W:$P(PSADS,"^",3)'="" !?2,$P(PSADS,"^",3)
     53 W !?2,$P(PSADS,"^",4)_" "_$P(PSADS,"^",5)_"  ",$P(PSADS,"^",6)
     54 I $Y+8>IOSL D:$E(IOST,1,2)="C-" SCREEN Q:PSAOUT  D HEADER
     55 D LINE
     56 Q
     57 ;
     58DATE(PSADATE)         ;convert date
     59 S %=$E(PSADATE,4,5)_"/"_$E(PSADATE,6,7)_"/"_$E(PSADATE,2,3)
     60 I $TR(%,"/")="" S %="UNKNOWN"
     61 Q %
     62 ;
     63LINE ;print line items
     64 D LINEHDR
     65 S (PSAICOST,PSALINE,PSATOT)=0 F  S PSALINE=$O(^XTMP("PSAPV",PSACTRL,"IT",PSALINE)) Q:'PSALINE!(PSAOUT)  S PSADATA=^(PSALINE),PSADRG=0 D  Q:PSAOUT
     66 .I $Y+5>IOSL D:$E(IOST,1,2)="C-" SCREEN Q:PSAOUT  D HEADER,LINEHDR
     67 .K PSADJQTY,PSAQDUZ,PSAQDT,PSAQREA,PSADJORD,PSAODUZ,PSAODT,PSAOREA
     68 .W !,PSALINE
     69DRUG .;Drug
     70 .I +$P(PSADATA,"^",15) S PSADRG=+$P(PSADATA,"^",15) W ?8,"*"_$P($G(^PSDRUG(+$P(PSADATA,"^",15),0)),"^")_$S(+$P(PSADATA,"^",6)&($P($G(^PSDRUG(+$P(PSADATA,"^",6),0)),"^")'=""):" ("_$P(^PSDRUG(+$P(PSADATA,"^",6),0),"^")_")",1:"") S PSADJDRG=1
     71 .I PSADRG,$D(^PSDRUG(PSADRG,"I")) W !,?5,"** INACTIVE IN DRUG FILE **"
     72 .I '+$P(PSADATA,"^",15) D
     73 ..I +$P(PSADATA,"^",6),$P($G(^PSDRUG(+$P(PSADATA,"^",6),0)),"^")'="" W ?9,$P(^PSDRUG(+$P(PSADATA,"^",6),0),"^") S PSADRG=+$P(PSADATA,"^",6) Q
     74 ..I $P($G(^XTMP("PSAPV",PSACTRL,"IT",PSALINE,"SUP")),"^",3)'="" W ?7,"**"_$P(^XTMP("PSAPV",PSACTRL,"IT",PSALINE,"SUP"),"^",3)  S PSADJSUP=1,PSADRG=0 Q
     75 ..W ?9,"DRUG UNKNOWN"
     76 .I $P(PSADATA,"^",19)="CS" 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"
     77 .E  I PSADRG,$P($G(^PSD(58.8,+$P(PSAIN,"^",7),1,PSADRG,0)),"^",14),$P($G(^(0)),"^",14)'>DT W !?5,"*** INACTIVE IN PHARMACY LOCATION"
     78 .;UPC
     79 .I $P($P(PSADATA,"^",26),"~")'="" W !?9,"UPC: "_$P($P(PSADATA,"^",26),"~")
     80 .;NDC
     81 .S PSANDC=$P($P(PSADATA,"^",4),"~")
     82 .I $E(PSANDC)'="S" D
     83 ..W !?9 D PSANDC1^PSAHELP S PSANDC=PSANDCX
     84 ..I PSANDC'="" W PSANDC Q
     85 ..W "NDC UNKNOWN"
     86 .;
     87 .;VSN
     88 .W ?25,$S($P($P(PSADATA,"^",5),"~")'="":$E($P($P(PSADATA,"^",5),"~"),1,14),1:"VSN UNKNOWN")
     89 .;
     90 .;QTY
     91 .;No Adjusted Qty
     92 .S PSAIECST=PSAIECST+($P(PSADATA,"^")*$P(PSADATA,"^",3))
     93 .I $P(PSADATA,"^",8)="" W ?40,$J($P(PSADATA,"^"),6) S PSAECOST=$P(PSADATA,"^")*$P(PSADATA,"^",3),PSAAECST=PSAAECST+PSAECOST
     94 .;Adj. Qty (P)
     95 .I $P(PSADATA,"^",8)'="" D
     96 ..S PSADJQTY=$P(PSADATA,"^",8),PSAQDUZ=$P(PSADATA,"^",9),PSAQDT=$P(PSADATA,"^",10),PSAQREA=$P(PSADATA,"^",11)
     97 ..S PSAECOST=PSADJQTY*$P(PSADATA,"^",3),PSAAECST=PSAAECST+PSAECOST
     98 ..W ?40,$J($P(PSADATA,"^",8),6)_"("_$P(PSADATA,"^")_")"
     99 .;
     100OU .;Order Unit
     101 .I '+$P(PSADATA,"^",12) D
     102 ..I +$P($P(PSADATA,"^",2),"~",2),$P($G(^DIC(51.5,+$P($P(PSADATA,"^",2),"~",2),0)),"^")'="" W ?53,$P($G(^DIC(51.5,+$P($P(PSADATA,"^",2),"~",2),0)),"^") Q
     103 ..I $P($G(PSADATA),"^",2)'="",$P($G(PSADATA),"^",2)'["~",'$D(^DIC(51.5,"B",$P(PSADATA,"^",2))) W ?48," ?-> "_$P(PSADATA,"^",2)
     104 ..I $P($P(PSADATA,"^",2),"~")="" D ^PSAHELP
     105 .;Adj. OU (P)
     106 .I +$P(PSADATA,"^",12) S PSADJORD=$P(PSADATA,"^",12),PSAODUZ=$P(PSADATA,"^",13),PSAODT=$P(PSADATA,"^",14) W ?53,$P($G(^DIC(51.5,+$P(PSADATA,"^",12),0)),"^")_"("_$P($P(PSADATA,"^",2),"~")_")"
     107 .;Unit price
     108 .S PSADEC=$S($L($P($P(PSADATA,"^",3),".",2))>1:$L($P($P(PSADATA,"^",3),".",2)),1:2)
     109 .W ?59,$J($P(PSADATA,"^",3),7,PSADEC)
     110 .;Extended cost
     111 .W ?67,$J(PSAECOST,12,2)
     112 .I $Y+9>IOSL,+$P(PSADATA,"^",21),+$P(PSADATA,"^",27) D:$E(IOST,1,2)="C-" SCREEN Q:PSAOUT  D HEADER,LINEHDR
     113 .I $G(PSADRG) D HAVEDRG
     114 .I '$G(PSADRG) W !?9,"STOCK LEVEL  : ",!?9,"REORDER LEVEL: "_$P(PSADATA,"^",21),!?9,"DISPENSE UNITS/ORDER UNIT: "
     115 .;
     116 .;Print Adj Qty
     117 .I $G(PSADJQTY)'="" D
     118 ..I $Y+5>IOSL D:$E(IOST,1,2)="C-" SCREEN Q:PSAOUT  D HEADER,LINEHDR
     119 ..W !!?9,"ADJUSTED QUANTITY: "_PSADJQTY,!?9,$$DATE(PSAQDT)_" "_$P($G(^VA(200,+PSAQDUZ,0)),"^"),!?11,PSAQREA
     120 .;Print Adj OU
     121 .I +$G(PSADJORD) D
     122 ..I $Y+5>IOSL D:$E(IOST,1,2)="C-" SCREEN Q:PSAOUT  D HEADER,LINEHDR
     123 ..W !!,?9,"ADJUSTED ORDER UNIT: "_$P($G(^DIC(51.5,+PSADJORD,0)),"^")
     124 ..W !?9,$$DATE(PSAODT)_" "_$P($G(^VA(200,+PSAODUZ,0)),"^")_" - "_$P($G(^DIC(51.5,PSADJORD,0)),"^")
     125 .W !
     126 Q:PSAOUT
     127 I $Y+6>IOSL D:$E(IOST,1,2)="C-" SCREEN Q:PSAOUT  D HEADER
     128 W !,PSASLN
     129 W:$G(PSAAECST)'=$G(PSAIECST) !?48,"TOTAL ADUSTED COST",?67,$J(PSAAECST,12,2),!
     130 W !?48,"TOTAL INVOICED COST",?67,$J(PSAIECST,12,2)
     131 S PSAEND=1
     132 I $Y+5>IOSL D:$E(IOST,1,2)="C-" SCREEN Q:PSAOUT  D HEADER
     133 I PSADJDRG,$E(IOST)'="C" W !!,"* THE DRUG WAS MATCHED TO THE DRUG FILE."
     134 I PSADJSUP,$E(IOST)'="C" W !!,"* THE ITEM IS A SUPPLY ITEM."
     135 D:$E(IOST,1,2)="C-" SCREEN
     136 Q
     137 ;
     138LINEHDR ;item header
     139 W !?50,"ORDER",?62,"COST/",?71,"EXTENDED"
     140 W !,"LINE#",?9,"NDC",?25,"VSN",?43,"QTY",?51,"UNIT",?62,"UNIT",?75,"COST",!,PSADLN,!
     141 Q
     142 ;
     143HEADER ;Page header
     144 I PSAFPG&($E(IOST,1,2)="C-") W @IOF G HDR1
     145 S PSAFPG=0
     146 W:'PSAFPG @IOF
     147HDR1 W !?20,"DRUG ACCOUNTABILITY/INVENTORY INTERFACE"
     148 W !?26,"PRIME VENDOR UPLOAD REPORT",!
     149 W:PSAPAGE'=1 !,"ORDER#: "_$P(PSAIN,"^",4)_"  INVOICE#: "_$P(PSAIN,"^",2)
     150 I $E(IOST,1,2)="C-" W ?(74-$L(PSAPAGE)),"PAGE "_PSAPAGE,!,PSADLN
     151 I $E(IOST)'="C" W !,"RUN: "_PSARUN,?(74-$L(PSAPAGE)),"PAGE "_PSAPAGE,!,PSADLN
     152 S PSAPAGE=PSAPAGE+1
     153 Q
     154SCREEN ;Hold on screen
     155 S PSAS=20-$Y I PSAS F PSASS=1:1:PSAS W !
     156 I PSADJDRG,PSAEND W !," * THE DRUG WAS MATCHED TO THE DRUG FILE."
     157 I PSADJSUP,PSAEND W !,"** THE ITEM IS A SUPPLY ITEM."
     158 S DIR(0)="E" D ^DIR K DIR I $G(DIRUT) S PSAOUT=1
     159 Q
     160 ;
     161HAVEDRG ;Display data if drug is found.
     162 ;DAVE B (PSA*3*20) 7SEP99 ADDED $G TO NEXT LINE
     163 S PSACS=$S($P($G(^PSDRUG(PSADRG,2)),"^",3)["N":1,1:0)
     164 I PSACS D
     165 .I PSAMV,+$P($G(^PSD(58.8,PSAMV,0)),"^",14) D  Q
     166 ..W !?9,"STOCK LEVEL  : "_$S(+$P(PSADATA,"^",27):+$P(PSADATA,"^",27),1:+$P($G(^PSD(58.8,PSAMV,1,PSADRG,0)),"^",3))
     167 ..W !?9,"REORDER LEVEL: "_$S(+$P(PSADATA,"^",21):+$P(PSADATA,"^",21),1:+$P($G(^PSD(58.8,PSAMV,1,PSADRG,0)),"^",5))
     168 .I 'PSAMV W !?9,"STOCK LEVEL  : "_$P(PSADATA,"^",27),!?9,"REORDER LEVEL: "_$P(PSADATA,"^",21)
     169 I 'PSACS D
     170 .I PSAPHARM,+$P($G(^PSD(58.8,PSAPHARM,0)),"^",14) D
     171 ..W !?9,"STOCK LEVEL  : "_$S(+$P(PSADATA,"^",27):+$P(PSADATA,"^",27),1:+$P($G(^PSD(58.8,PSAPHARM,1,PSADRG,0)),"^",3))
     172 ..W !?9,"REORDER LEVEL: "_$S(+$P(PSADATA,"^",21):+$P(PSADATA,"^",21),1:+$P($G(^PSD(58.8,PSAPHARM,1,PSADRG,0)),"^",5))
     173 .I 'PSAPHARM W !?9,"STOCK LEVEL  : "_$P(PSADATA,"^",27),!?9,"REORDER LEVEL: "_$P(PSADATA,"^",21)
     174 W !?9,"DISPENSE UNITS/ORDER UNIT: "
     175 W $S(+$P(PSADATA,"^",20):+$P(PSADATA,"^",20),+$P($G(^PSDRUG(PSADRG,1,+$P(PSADATA,"^",7),0)),"^",7):+$P($G(^PSDRUG(PSADRG,1,+$P(PSADATA,"^",7),0)),"^",7),1:"")
     176 Q
Note: See TracChangeset for help on using the changeset viewer.