| [613] | 1 | PRCHAAC3 ;WIFO/TN/CR-CONT. OF IFCAP HL7 MESSAGE TO AUSTIN ;4/28/05 2:43 PM
|
|---|
| 2 | ;;5.1;IFCAP;**79**;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;This function is called from the routine PRCHAAC.
|
|---|
| 5 | ;
|
|---|
| 6 | LIDT(PRCPO) ;This function goes through all the line items on a PO
|
|---|
| 7 | ; to get information on the item with the highest dollar amount.
|
|---|
| 8 | ; If there is a problem with the PO, the function will return
|
|---|
| 9 | ; a zero
|
|---|
| 10 | ;
|
|---|
| 11 | ; 1 2 3 4 5 6
|
|---|
| 12 | ; PO Number^PO Total^Description^item amount^contract number^FSC
|
|---|
| 13 | ; FSC - FEDERAL SUPPLY CLASSIFICATION
|
|---|
| 14 | ;
|
|---|
| 15 | N AMT,AMT1,CNT,DESC,ITEM,ITEM1,PO,REC,REC1,REC2,TOTAL
|
|---|
| 16 | I '$D(^PRC(442,PRCPO,2,0)) QUIT 0 ;No line items
|
|---|
| 17 | ;
|
|---|
| 18 | ;Get line item with the highest cost
|
|---|
| 19 | S AMT="",ITEM1=0
|
|---|
| 20 | F S ITEM1=$O(^PRC(442,PRCPO,2,ITEM1)) Q:'ITEM1 D
|
|---|
| 21 | . S REC=$G(^PRC(442,PRCPO,2,ITEM1,2)) ;Get item record
|
|---|
| 22 | . QUIT:REC=""
|
|---|
| 23 | . S REC=$P(REC,U,1,3) ;Get the 1st 3 fields
|
|---|
| 24 | . S AMT1=+REC ;Cost of the item
|
|---|
| 25 | . I AMT1<AMT QUIT ;Get the next record
|
|---|
| 26 | . S AMT=AMT1
|
|---|
| 27 | . S ITEM=ITEM1
|
|---|
| 28 | . S REC2=REC ;Save record with highest dollar amount
|
|---|
| 29 | ;
|
|---|
| 30 | I 'AMT QUIT 0 ;No dollar amount
|
|---|
| 31 | S REC1=^PRC(442,PRCPO,0)
|
|---|
| 32 | S PO=$P(REC1,U) ;Get PO number
|
|---|
| 33 | S TOTAL=$P(REC1,U,15) ;Get PO total
|
|---|
| 34 | S DESC=^PRC(442,PRCPO,2,ITEM,1,1,0) ;Get item description
|
|---|
| 35 | ; Clean the HL7 message of any '^,~,&,\, or |'.
|
|---|
| 36 | T I DESC["^"!(DESC["|")!(DESC["~")!(DESC["&")!(DESC["\") S DESC=$$STRIP^XLFSTR(DESC,"^~|&\")
|
|---|
| 37 | S PO=PO_"^"_TOTAL_"^"_$E(DESC,1,50)_"^"_REC2 ;Setup return data
|
|---|
| 38 | ;
|
|---|
| 39 | QUIT PO
|
|---|
