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

    r613 r623  
    1 PSABRKU3        ;BIR/JMB/PDW-Upload and Process Prime Vendor Invoice Data - CONT'D ;8/13/97
    2         ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**26,41,47,67**; 10/24/97;Build 15
    3         ;Checking the X12 invoice data.
    4         S (PSASTCNT,PSAITCNT,PSACTRL(1))=0
    5         K ^TMP($J,"PSAPV SET"),PSAERR
    6         S PSALAST=""
    7         S PSALINE=0 F  S PSALINE=$O(^TMP($J,"PSAPVS",PSALINE)) Q:PSALINE=""  S PSADATA=^(PSALINE) D
    8         .;check segment order
    9         .D ^PSABRKU5 S PSALAST=$P(PSADATA,"^")
    10 ISA     .;control header
    11         .I PSALAST="ISA" D  Q
    12         ..S PSASTCNT=0
    13         ..S PSAISA=PSADATA,PSACTRL="" I $L($P(PSADATA,"^",14))'=9 S PSASEG="ISA" D MSG^PSABRKU8
    14         .;
    15 IEA     .;control trailer
    16         .I PSALAST="IEA" D  Q
    17         ..I $P(PSADATA,"^",3)'=$P(PSAISA,"^",14) S PSASEG="IEA" D MSG^PSABRKU8
    18         .;
    19 GS      .;group header
    20         .I PSALAST="GS" S PSAGS=PSADATA D  Q
    21         ..F %=3,4 S PSAPC=$S(%=3:7,1:9) I $P(PSADATA,"^",%)'=$TR($P(PSAISA,"^",PSAPC)," ") S PSASEG="GS" D MSG^PSABRKU8
    22         .;
    23 GE      .;group trailer
    24         .I PSALAST="GE" D  Q
    25         ..I $P(PSADATA,"^",3)'=$P($G(PSAGS),"^",7) S PSASEG="GE" D MSG^PSABRKU8
    26         .;
    27 ST      .;set header
    28         .I PSALAST="ST" D  Q
    29         ..S PSAST=PSADATA,PSACTRL=$P(PSADATA,"^",3),PSASTCNT=1,PSAITCNT=0,PSANTYPE=""
    30         ..I $L(PSACTRL)<4!($L(PSACTRL)>10) S PSASEG="ST" D MSG^PSABRKU8 Q
    31         .. I PSACTRL="0001" S PSACTRL=0 D RESETST
    32         ..;PSA*3*41 - McKesson probability of multiple files, may have to
    33         ..;increment transaction set control numbers in 'ST' & 'SE'
    34         ..I $D(^TMP($J,"PSAPV SET",PSACTRL,"IN")) D RESETST
    35         ..I $D(^XTMP("PSAPV",PSACTRL)) D RESETST ;may already be on file
    36         .;
    37 SE      .;set trailer
    38         .I PSALAST="SE" S PSASTCNT=PSASTCNT+1 D  Q
    39         ..I $G(PSACTRL(1))'>0,$P(PSADATA,"^",3)'=PSACTRL S PSASEG="SE1" D MSG^PSABRKU8 Q
    40         ..I PSASTCNT'=$P(PSADATA,"^",2) S PSASEG="SE2" D MSG^PSABRKU8
    41         .;
    42 BIG     .;beginning segment for invoice
    43         .I PSALAST="BIG" S PSASTCNT=PSASTCNT+1 D  Q
    44         ..I $P(PSADATA,"^",4)="" S $P(PSADATA,"^",4)=$P(PSADATA,"^",2)
    45         ..S $P(PSADATA,"^",5)=$TR($P(PSADATA,"^",5)," ")
    46         ..S ^TMP($J,"PSAPV SET",PSACTRL,"IN")=$P(PSADATA,"^",2,5)
    47         .;
    48 REF     .;(not used)
    49         .I PSALAST="REF" S PSASTCNT=PSASTCNT+1 Q
    50         .;
    51         .;buyer, seller, shipping addresses
    52 N1      .I PSALAST="N1" S PSASTCNT=PSASTCNT+1,PSANTYPE=$P(PSADATA,"^",2) D  Q
    53         ..I PSANTYPE'="BY",PSANTYPE'="DS",PSANTYPE'="ST" S PSASEG="N1" D MSG^PSABRKU8 Q
    54         ..S ^TMP($J,"PSAPV SET",PSACTRL,PSANTYPE)=$P(PSADATA,"^",3)
    55         .;
    56 N2      .I PSALAST="N2" D  Q
    57         ..D:PSANTYPE="" NTYPE
    58         ..S $P(^TMP($J,"PSAPV SET",PSACTRL,PSANTYPE),"^",2)=$P(PSADATA,"^",2) S PSASTCNT=PSASTCNT+1
    59         .;
    60 N3      .I PSALAST="N3" D  Q
    61         ..D:PSANTYPE="" NTYPE
    62         ..S $P(^TMP($J,"PSAPV SET",PSACTRL,PSANTYPE),"^",3)=$P(PSADATA,"^",2) S PSASTCNT=PSASTCNT+1
    63         .;
    64 N4      .I PSALAST="N4" D  Q
    65         ..D:PSANTYPE="" NTYPE
    66         ..S $P(^TMP($J,"PSAPV SET",PSACTRL,PSANTYPE),"^",4,6)=$P(PSADATA,"^",2,4) S PSASTCNT=PSASTCNT+1,PSANTYPE=""
    67         .;
    68 DTM     .;date time reference
    69         .I PSALAST="DTM" S PSASTCNT=PSASTCNT+1 D  Q
    70         ..S %=$S($P(PSADATA,"^",2)="002":5,$P(PSADATA,"^",2)="035":6,1:0) I '% Q
    71         ..S $P(^TMP($J,"PSAPV SET",PSACTRL,"IN"),"^",%)=$P(PSADATA,"^",3)
    72         .;
    73 IT1     .;invoice line item
    74         .I PSALAST="IT1" S PSASTCNT=PSASTCNT+1,PSAITCNT=PSAITCNT+1 D ITEM Q
    75         .;BGN PSA*3*67
    76 PID     .;generic vendor item name
    77         .I PSALAST="PID" S PSASTCNT=PSASTCNT+1,$P(^TMP($J,"PSAPV SET",PSACTRL,"IT",PSAITEM),"^",29)=$S($P(PSADATA,"^",6)=$P(^TMP($J,"PSAPV SET",PSACTRL,"IT",PSAITEM),"^",28):"Unknown",1:$P(PSADATA,"^",6)) Q
    78 PO4     .;DESCRIPTION OF ITEM
    79         .I PSALAST="PO4" S PSASTCNT=PSASTCNT+1,$P(^TMP($J,"PSAPV SET",PSACTRL,"IT",PSAITEM),"^",30)=$P(PSADATA,"^",3)_"^"_$P(PSADATA,"^",9) D  Q
    80         .;END PSA*3*67
    81 CTT     .;item count
    82         .I PSALAST="CTT" S PSASTCNT=PSASTCNT+1 D  Q
    83         ..I PSAITCNT'=$P(PSADATA,"^",2) S PSASEG="CTT" D MSG^PSABRKU8
    84         .;
    85 UNKNOWN .;Segment we don't use
    86         .S PSASTCNT=PSASTCNT+1
    87         ;
    88 ERROR   S PSASEG=$O(PSAERR("")) D:PSASEG'="" ERROR^PSABRKU8
    89         Q
    90         ;
    91 NTYPE   S PSASEG="NONTYPE" D NONTYPE^PSABRKU8
    92         Q
    93         ;
    94 ITEM    ;check line item
    95         I '$P(PSADATA,"^",2) S PSASEG="IT1-1" D MSG^PSABRKU8 Q
    96         I $P(PSADATA,"^",6)'="DS" S PSASEG="IT1-2" D MSG^PSABRKU8 Q
    97         I $P(PSADATA,"^",8)="",$P(PSADATA,"^",10)="",$P(PSADATA,"^",12)="" S PSASEG="IT1-3" D MSG^PSABRKU8 Q
    98         ;"IT1" Seg=Qty Invoiced ^ Unit of Measure ^ Unit Price ^ Basic Unit Code "DS" ^ NDC ^ VSN
    99         S PSAITEM=+$P(PSADATA,"^",2),^TMP($J,"PSAPV SET",PSACTRL,"IT",PSAITEM)=+$P(PSADATA,"^",3)_"^"_$P(PSADATA,"^",4)_"^"_$P(PSADATA,"^",5)_"^"_$P(PSADATA,"^",8)_"^"_$P(PSADATA,"^",10)
    100         I $P(PSADATA,"^",12)'="",$P(PSADATA,"^",11)="UP" S $P(^TMP($J,"PSAPV SET",PSACTRL,"IT",PSAITEM),"^",26)=$P(PSADATA,"^",12)
    101         ;Next line to add vendor Generic Description
    102         I $P(PSADATA,"^",14)'="" S $P(^TMP($J,"PSAPV SET",PSACTRL,"IT",PSAITEM),"^",28)=$P(PSADATA,"^",14)
    103         ;Eop67
    104         Q
    105 RESETST ;Reset PSACTRL
    106         S PSACTRL(1)=+PSACTRL+1,X1=PSACTRL(1)
    107         S PSACTRL=X1 I $D(^TMP($J,"PSAPV SET",PSACTRL)) G RESETST
    108         I $D(^XTMP("PSAPV",PSACTRL)) G RESETST
    109         Q
     1PSABRKU3 ;BIR/JMB/PDW-Upload and Process Prime Vendor Invoice Data - CONT'D ;8/13/97
     2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;**26,41,47**; 10/24/97
     3 ;Checking the X12 invoice data.
     4 S (PSASTCNT,PSAITCNT,PSACTRL(1))=0
     5 K ^TMP($J,"PSAPV SET"),PSAERR
     6 S PSALAST=""
     7 S PSALINE=0 F  S PSALINE=$O(^TMP($J,"PSAPVS",PSALINE)) Q:PSALINE=""  S PSADATA=^(PSALINE) D
     8 .;check segment order
     9 .D ^PSABRKU5 S PSALAST=$P(PSADATA,"^")
     10ISA .;control header
     11 .I PSALAST="ISA" D  Q
     12 ..S PSASTCNT=0
     13 ..S PSAISA=PSADATA,PSACTRL="" I $L($P(PSADATA,"^",14))'=9 S PSASEG="ISA" D MSG^PSABRKU8
     14 .;
     15IEA .;control trailer
     16 .I PSALAST="IEA" D  Q
     17 ..I $P(PSADATA,"^",3)'=$P(PSAISA,"^",14) S PSASEG="IEA" D MSG^PSABRKU8
     18 .;
     19GS .;group header
     20 .I PSALAST="GS" S PSAGS=PSADATA D  Q
     21 ..F %=3,4 S PSAPC=$S(%=3:7,1:9) I $P(PSADATA,"^",%)'=$TR($P(PSAISA,"^",PSAPC)," ") S PSASEG="GS" D MSG^PSABRKU8
     22 .;
     23GE .;group trailer
     24 .I PSALAST="GE" D  Q
     25 ..I $P(PSADATA,"^",3)'=$P($G(PSAGS),"^",7) S PSASEG="GE" D MSG^PSABRKU8
     26 .;
     27ST .;set header
     28 .I PSALAST="ST" D  Q
     29 ..S PSAST=PSADATA,PSACTRL=$P(PSADATA,"^",3),PSASTCNT=1,PSAITCNT=0,PSANTYPE=""
     30 ..I $L(PSACTRL)<4!($L(PSACTRL)>10) S PSASEG="ST" D MSG^PSABRKU8 Q
     31 .. I PSACTRL="0001" S PSACTRL=0 D RESETST
     32 ..;PSA*3*41 - McKesson probability of multiple files, may have to
     33 ..;increment transaction set control numbers in 'ST' & 'SE'
     34 ..I $D(^TMP($J,"PSAPV SET",PSACTRL,"IN")) D RESETST
     35 ..I $D(^XTMP("PSAPV",PSACTRL)) D RESETST ;may already be on file
     36 .;
     37SE .;set trailer
     38 .I PSALAST="SE" S PSASTCNT=PSASTCNT+1 D  Q
     39 ..I $G(PSACTRL(1))'>0,$P(PSADATA,"^",3)'=PSACTRL S PSASEG="SE1" D MSG^PSABRKU8 Q
     40 ..I PSASTCNT'=$P(PSADATA,"^",2) S PSASEG="SE2" D MSG^PSABRKU8
     41 .;
     42BIG .;beginning segment for invoice
     43 .I PSALAST="BIG" S PSASTCNT=PSASTCNT+1 D  Q
     44 ..I $P(PSADATA,"^",4)="" S $P(PSADATA,"^",4)=$P(PSADATA,"^",2)
     45 ..S $P(PSADATA,"^",5)=$TR($P(PSADATA,"^",5)," ")
     46 ..S ^TMP($J,"PSAPV SET",PSACTRL,"IN")=$P(PSADATA,"^",2,5)
     47 .;
     48REF .;(not used)
     49 .I PSALAST="REF" S PSASTCNT=PSASTCNT+1 Q
     50 .;
     51 .;buyer, seller, shipping addresses
     52N1 .I PSALAST="N1" S PSASTCNT=PSASTCNT+1,PSANTYPE=$P(PSADATA,"^",2) D  Q
     53 ..I PSANTYPE'="BY",PSANTYPE'="DS",PSANTYPE'="ST" S PSASEG="N1" D MSG^PSABRKU8 Q
     54 ..S ^TMP($J,"PSAPV SET",PSACTRL,PSANTYPE)=$P(PSADATA,"^",3)
     55 .;
     56N2 .I PSALAST="N2" D  Q
     57 ..D:PSANTYPE="" NTYPE
     58 ..S $P(^TMP($J,"PSAPV SET",PSACTRL,PSANTYPE),"^",2)=$P(PSADATA,"^",2) S PSASTCNT=PSASTCNT+1
     59 .;
     60N3 .I PSALAST="N3" D  Q
     61 ..D:PSANTYPE="" NTYPE
     62 ..S $P(^TMP($J,"PSAPV SET",PSACTRL,PSANTYPE),"^",3)=$P(PSADATA,"^",2) S PSASTCNT=PSASTCNT+1
     63 .;
     64N4 .I PSALAST="N4" D  Q
     65 ..D:PSANTYPE="" NTYPE
     66 ..S $P(^TMP($J,"PSAPV SET",PSACTRL,PSANTYPE),"^",4,6)=$P(PSADATA,"^",2,4) S PSASTCNT=PSASTCNT+1,PSANTYPE=""
     67 .;
     68DTM .;date time reference
     69 .I PSALAST="DTM" S PSASTCNT=PSASTCNT+1 D  Q
     70 ..S %=$S($P(PSADATA,"^",2)="002":5,$P(PSADATA,"^",2)="035":6,1:0) I '% Q
     71 ..S $P(^TMP($J,"PSAPV SET",PSACTRL,"IN"),"^",%)=$P(PSADATA,"^",3)
     72 .;
     73IT1 .;invoice line item
     74 .I PSALAST="IT1" S PSASTCNT=PSASTCNT+1,PSAITCNT=PSAITCNT+1 D ITEM Q
     75CTT .;item count
     76 .I PSALAST="CTT" S PSASTCNT=PSASTCNT+1 D  Q
     77 ..I PSAITCNT'=$P(PSADATA,"^",2) S PSASEG="CTT" D MSG^PSABRKU8
     78 .;
     79UNKNOWN .;Segment we don't use
     80 .S PSASTCNT=PSASTCNT+1
     81 ;
     82ERROR S PSASEG=$O(PSAERR("")) D:PSASEG'="" ERROR^PSABRKU8
     83 Q
     84 ;
     85NTYPE S PSASEG="NONTYPE" D NONTYPE^PSABRKU8
     86 Q
     87 ;
     88ITEM ;check line item
     89 I '$P(PSADATA,"^",2) S PSASEG="IT1-1" D MSG^PSABRKU8 Q
     90 I $P(PSADATA,"^",6)'="DS" S PSASEG="IT1-2" D MSG^PSABRKU8 Q
     91 I $P(PSADATA,"^",8)="",$P(PSADATA,"^",10)="",$P(PSADATA,"^",12)="" S PSASEG="IT1-3" D MSG^PSABRKU8 Q
     92 ;"IT1" Seg=Qty Invoiced ^ Unit of Measure ^ Unit Price ^ Basic Unit Code "DS" ^ NDC ^ VSN
     93 S PSAITEM=+$P(PSADATA,"^",2),^TMP($J,"PSAPV SET",PSACTRL,"IT",PSAITEM)=+$P(PSADATA,"^",3)_"^"_$P(PSADATA,"^",4)_"^"_$P(PSADATA,"^",5)_"^"_$P(PSADATA,"^",8)_"^"_$P(PSADATA,"^",10)
     94 I $P(PSADATA,"^",12)'="",$P(PSADATA,"^",11)="UP" S $P(^TMP($J,"PSAPV SET",PSACTRL,"IT",PSAITEM),"^",26)=$P(PSADATA,"^",12)
     95 Q
     96RESETST ;Reset PSACTRL
     97 S PSACTRL(1)=+PSACTRL+1,X1=PSACTRL(1)
     98 S PSACTRL=X1 I $D(^TMP($J,"PSAPV SET",PSACTRL)) G RESETST
     99 I $D(^XTMP("PSAPV",PSACTRL)) G RESETST
     100 Q
Note: See TracChangeset for help on using the changeset viewer.