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