| [613] | 1 | PRCHL6 ;VACO/HNC/VAC - ITEM DETAIL GRID ; 1/31/07 3:38pm
|
|---|
| 2 | ;;5.1;IFCAP;**103**;Oct 20, 2000;Build 25
|
|---|
| 3 | ;Per VHA Directive 2004-038, this routine should not be modified
|
|---|
| 4 | ;DBIA# 4345 giving permission to reference Prosthetics data
|
|---|
| 5 | ;VAC - Limit number of PO line items to 80 or less
|
|---|
| 6 | ;
|
|---|
| 7 | ;piece 1 - line item number
|
|---|
| 8 | ;piece 2 - Item Master number
|
|---|
| 9 | ;piece 3 - qty
|
|---|
| 10 | ;piece 4 - unit of purchase
|
|---|
| 11 | ;piece 5 - BOC
|
|---|
| 12 | ;piece 6 - contract BOA
|
|---|
| 13 | ;piece 7 - actual unit cost
|
|---|
| 14 | ;piece 8 - fed supply classification
|
|---|
| 15 | ;piece 9 - vendor stock number
|
|---|
| 16 | ;piece 10 - unit conversion factor
|
|---|
| 17 | ;piece 11 - total cost
|
|---|
| 18 | ;piece 12 - nif number
|
|---|
| 19 | ;piece 13 - item master short description 441- .05
|
|---|
| 20 | ;
|
|---|
| 21 | ;roll and scroll testing entry point
|
|---|
| 22 | A1(IEN) G A2
|
|---|
| 23 | ;
|
|---|
| 24 | EN(RESULTS,IEN) ;broker entry point
|
|---|
| 25 | A2 ;
|
|---|
| 26 | I IEN="" S RESULTS(0)="No Data"_U_"No Items Found for this PO" Q
|
|---|
| 27 | ;First check number of line items on PO, stop if more than 80
|
|---|
| 28 | I $P(^PRC(442,IEN,0),U,14)>80 S RESULTS(0)="MORE THAN 80^TOO MANY" Q
|
|---|
| 29 | S CNT=0
|
|---|
| 30 | D GETS^DIQ(442,IEN,"40*;.01","EN","ITM")
|
|---|
| 31 | S PRCHPO=$G(ITM("442",IEN_",",".01","E"))
|
|---|
| 32 | S PRCHPIEN=""
|
|---|
| 33 | I PRCHPO'="" S PRCHPIEN=$O(^RMPR(664,"G",$P(PRCHPO,"-",2),PRCHPIEN))
|
|---|
| 34 | I PRCHPIEN'="" D GETS^DIQ(664,PRCHPIEN,"2*;11;12","E","PITMSTR")
|
|---|
| 35 | I $D(PITMSTR) D
|
|---|
| 36 | .;Prosthetic item
|
|---|
| 37 | .S PRCHB="" F S PRCHB=$O(PITMSTR(664.02,PRCHB)) Q:'PRCHB D
|
|---|
| 38 | . .S QTY=$G(PITMSTR(664.02,PRCHB,3,"E"))
|
|---|
| 39 | . .S UOP=$G(PITMSTR(664.02,PRCHB,4,"E"))
|
|---|
| 40 | . .S CBOA=$G(PITMSTR(664.02,PRCHB,13,"E"))
|
|---|
| 41 | . .S ITMD=$G(PITMSTR(664.02,PRCHB,1,"E"))
|
|---|
| 42 | . .S AUC=$G(PITMSTR(664.02,PRCHB,6,"E"))
|
|---|
| 43 | . .I AUC="" S AUC=$G(PITMSTR(664.02,PRCHB,2,"E"))
|
|---|
| 44 | . .S HCPCS=$G(PITMSTR(664.02,PRCHB,16,"E"))
|
|---|
| 45 | . .S VSN=$G(PITMSTR(664.02,PRCHB,15.4,"E"))
|
|---|
| 46 | . .S TCST=QTY*AUC
|
|---|
| 47 | . .S CNT=CNT+1
|
|---|
| 48 | . .S RESULTS(CNT)="P "_CNT_U_HCPCS_U_QTY_U_UOP_U_""_U_CBOA_U_AUC_U_""_U_""_U_1_U_TCST_U_""_U_ITMD
|
|---|
| 49 | . S SHIP="",SHIPF=""
|
|---|
| 50 | . S SHIP=$G(PITMSTR(664,PRCHPIEN_",",11,"E"))
|
|---|
| 51 | . S SHIPF=$G(PITMSTR(664,PRCHPIEN_",",12,"E"))
|
|---|
| 52 | . I SHIPF'="" S SHIP=SHIPF
|
|---|
| 53 | . I SHIP'="" S CNT=CNT+1,RESULTS(CNT)="P "_CNT_U_"SHIPPING"_U_""_U_""_U_""_U_""_U_""_U_""_U_""_U_1_U_SHIP_U_""_U_"Shipping Cost"
|
|---|
| 54 | S B="" F S B=$O(ITM(442.01,B)) Q:'B D
|
|---|
| 55 | . S IFITM=$G(ITM(442.01,B,1.5,"E"))
|
|---|
| 56 | . D GETS^DIQ(441,IFITM,".01;.05;51","E","ITMSTR")
|
|---|
| 57 | . S ITMD=$G(ITMSTR(441,IFITM_",",.05,"E"))
|
|---|
| 58 | . S IFITM1=$G(ITMSTR(441,IFITM_",",.01,"E"))
|
|---|
| 59 | . S NIF=$G(ITMSTR(441,IFITM_",",51,"E"))
|
|---|
| 60 | . S LICNT=$P(B,",",1)
|
|---|
| 61 | . S QTY=$G(ITM(442.01,B,2,"E"))
|
|---|
| 62 | . S UOP=$G(ITM(442.01,B,3,"E"))
|
|---|
| 63 | . S BOC=$G(ITM(442.01,B,3.5,"E"))
|
|---|
| 64 | . S CBOA=$G(ITM(442.01,B,4,"E"))
|
|---|
| 65 | . S AUC=$TR($G(ITM(442.01,B,5,"E")),"$","")
|
|---|
| 66 | . S FSC=$G(ITM(442.01,B,8,"E"))
|
|---|
| 67 | . S VSN=$G(ITM(442.01,B,9,"E"))
|
|---|
| 68 | . S UCF=$G(ITM(442.01,B,9.7,"E"))
|
|---|
| 69 | . S TCST=$G(ITM(442.01,B,15,"E"))
|
|---|
| 70 | . S ITMDD=$G(ITM(442.01,B,1,1))
|
|---|
| 71 | . I ITMD'="" S ITMD=ITMD_" "
|
|---|
| 72 | . S ITMD=ITMD_"1st Line: "_ITMDD
|
|---|
| 73 | . K ITMDD
|
|---|
| 74 | . S CNT=CNT+1
|
|---|
| 75 | . S RESULTS(CNT)="I "_LICNT_U_IFITM1_U_QTY_U_UOP_U_BOC_U_CBOA_U_AUC_U_FSC_U_VSN_U_UCF_U_TCST_U_NIF_U_ITMD
|
|---|
| 76 | END I '$D(RESULTS) S RESULTS(1)="No Data"_U_"No Item Detail"
|
|---|
| 77 | K IEN,CNT,ITM,ITMSTR,IFITM,ITMD,IFITM1,LICNT,QTY,UOP,BOC,CBOA,AUC,FSC,VSN,UCF,TCST,NIF,B,PRCHPO,PITMSTR,PRCHB,PRCHPIEN,HCPCS,SHIP,SHIPF
|
|---|
| 78 | Q
|
|---|
| 79 | ;END
|
|---|
