| 1 | PRCPDAPI ;WISC/RFJ-drug accountability/prime vendor (check item) ;15 Mar 94
|
|---|
| 2 | ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | ;
|
|---|
| 7 | ITEM ; check line item, item master file for errors
|
|---|
| 8 | ; major errors in format or upload
|
|---|
| 9 | I '$P(DATA,"^",2) D ERROR^PRCPDAPE("'IT1' ITEM DATA, INVOICE LINE NUMBER (piece 2) NOT DEFINED") Q
|
|---|
| 10 | I $D(^TMP($J,"PRCPDAPV SET",STCTRL,"IT",+$P(DATA,"^",2))) D ERROR^PRCPDAPE("'IT1' ITEM DATA, INVOICE NUMBER (piece 2) APPEARS ON THE INVOICE MORE THAN ONCE") Q
|
|---|
| 11 | I $P(DATA,"^",6)'="DS" D ERROR^PRCPDAPE("'IT1' ITEM DATA, UNIT PRICE CODE (piece 6) SHOULD EQUAL 'DS' FOR DISCOUNT") Q
|
|---|
| 12 | I $P(DATA,"^",7)'="ND" D ERROR^PRCPDAPE("'IT1' ITEM DATA, ITEM IDENTIFIER (piece 7) SHOULD EQUAL 'ND' FOR NATIONAL DRUG CODE") Q
|
|---|
| 13 | ;
|
|---|
| 14 | ; no major errors in format or upload
|
|---|
| 15 | S LINEITEM=+$P(DATA,"^",2),NDC=$P(DATA,"^",8),VDC=$P(DATA,"^",10)
|
|---|
| 16 | S ^TMP($J,"PRCPDAPV SET",STCTRL,"IT",LINEITEM)=+$P(DATA,"^",3)_"^"_$P(DATA,"^",4)_"^"_(+$P(DATA,"^",5))_"^"_NDC_"^"_VDC
|
|---|
| 17 | ;
|
|---|
| 18 | ; get item master file and vendor entry
|
|---|
| 19 | D GETITEM
|
|---|
| 20 | I 'ITEMDA S:VDC="" VDC=" " S ITEMDA=+$O(^PRC(441,"D",VDC,0)) I ITEMDA S VENDA=+$O(^PRC(441,"D",VDC,ITEMDA,0))
|
|---|
| 21 | I 'ITEMDA S VDC="#"_VDC,ITEMDA=+$O(^PRC(441,"D",VDC,0)) I ITEMDA S VENDA=+$O(^PRC(441,"D",VDC,ITEMDA,0))
|
|---|
| 22 | I 'ITEMDA S ^TMP($J,"PRCPDAPV SET",STCTRL,"IT",LINEITEM,"E")="ERROR: ITEM NOT STORED IN ITEM MASTER FILE (#441).",^TMP($J,"PRCPDAPV SET",STCTRL,"E")=1,PRCPFERR=1 Q
|
|---|
| 23 | ; check item master file errors
|
|---|
| 24 | I ITEMDA,$L(NDC) S %=+$O(^PRC(441,"F",NDC,ITEMDA)) I % S ^TMP($J,"PRCPDAPV SET",STCTRL,"IT",LINEITEM,"E1")="ERROR: THE NDC ["_NDC_"] IS A DUPLICATE WITH ITEM MASTER #"_%,^TMP($J,"PRCPDAPV SET",STCTRL,"E")=1,PRCPFERR=1
|
|---|
| 25 | I '$D(^PRC(441,ITEMDA,2,PRCPVEND,0)) S ^TMP($J,"PRCPDAPV SET",STCTRL,"IT",LINEITEM,"E2")="ERROR: THE PRIME VENDOR IS NOT A VENDOR IN THE ITEM MASTER FILE (#441).",^TMP($J,"PRCPDAPV SET",STCTRL,"E")=1,PRCPFERR=1
|
|---|
| 26 | S $P(^TMP($J,"PRCPDAPV SET",STCTRL,"IT",LINEITEM),"^",6)=ITEMDA_"^"_VENDA
|
|---|
| 27 | Q
|
|---|
| 28 | ;
|
|---|
| 29 | ;
|
|---|
| 30 | GETITEM ; lookup item on ndc with all combinations
|
|---|
| 31 | ; requires ndc
|
|---|
| 32 | ; returns itemda, ndc found, vendor
|
|---|
| 33 | N END,END0,FRO,FRO0,MID,MID0
|
|---|
| 34 | ;
|
|---|
| 35 | S END=$E(NDC,$L(NDC)-1,$L(NDC)),FRO=$E(NDC,1,$L(NDC)-2)
|
|---|
| 36 | S MID=$E(FRO,$L(FRO)-3,$L(FRO)),FRO=$E(FRO,1,$L(FRO)-4)
|
|---|
| 37 | ;
|
|---|
| 38 | S FRO0=FRO,MID0=MID,END0=END
|
|---|
| 39 | F D Q:ITEMDA
|
|---|
| 40 | . D LOOKUP(FRO0,MID0,END0) Q:ITEMDA
|
|---|
| 41 | . ;
|
|---|
| 42 | . I $E(FRO0)=0 S FRO0=$E(FRO0,2,99) Q
|
|---|
| 43 | . I $E(MID0)=0 S FRO0=FRO,MID0=$E(MID0,2,99) Q
|
|---|
| 44 | . I $E(END0)=0 S FRO0=FRO,MID0=MID,END0=$E(END0,2,99) Q
|
|---|
| 45 | . S ITEMDA=-1
|
|---|
| 46 | I ITEMDA=-1 S ITEMDA=0
|
|---|
| 47 | Q
|
|---|
| 48 | ;
|
|---|
| 49 | ;
|
|---|
| 50 | LOOKUP(FRO,MID,END) ; lookup item by NDC (fro-mid-end)
|
|---|
| 51 | S NDC=FRO_"-"_MID_"-"_END
|
|---|
| 52 | S ITEMDA=+$O(^PRC(441,"F",NDC,0))
|
|---|
| 53 | I ITEMDA S VENDA=+$O(^PRC(441,"F",NDC,ITEMDA,0))
|
|---|
| 54 | Q
|
|---|
