source: FOIAVistA/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHAAC3.m@ 1119

Last change on this file since 1119 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 1.6 KB
Line 
1PRCHAAC3 ;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 ;
6LIDT(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 |'.
36T 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
Note: See TracBrowser for help on using the repository browser.