PRCVIT ;WOIFO/DST - Send ITEM master file update to DYNAMED ; 3/2/05 5:07pm
;;5.1;IFCAP;**81**;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
;
Q
NITECHK ;
; Once a day check
; Compare a checksum and set a record to update
;
; If not DynaMed, don't do it
Q:'$$GET^XPAR("SYS","PRCV COTS INVENTORY",1,"Q")
;
N PRCND,PRCVL,PRCVP,PRCVAL,PRCVIT,PRCVN,PRCVSTN
N PRCVFN
S PRCVP=67280421310721,PRCVN=99999
S PRCVFN=$O(^PRCV(414.04,"D","ITEM",0))
; Clear old flag
K ^TMP("PRCVIT",$J)
S PRCVSTN=$$GET1^DIQ(4,$$KSP^XUPARAM("INST")_",",99)
F S PRCVN=$O(^PRC(441,PRCVN)) Q:'PRCVN D
. S PRCVAL=$$CHKSUM()
. ; Compare to existing CheckSum
. ; Kick off HL7 interface message to DynaMed, if not the same
. I PRCVAL,PRCVAL'=$P($G(^PRCV(414.04,PRCVFN,1,PRCVN,0)),U,2) D
.. S ^PRCV(414.04,PRCVFN,1,PRCVN,0)=PRCVN_U_PRCVAL
.. D GETDATA(PRCVN)
.. I $D(^TMP("PRCVIT",$J,PRCVN)) D EN^PRCVIMF(PRCVN)
.. Q
. Q
K ^TMP("PRCVIT",$J)
Q
;
ONECHK(PRCVN) ;
; Checksum to one ITEM only
Q:PRCVN<99999
N PRCND,PRCVL,PRCVFN,PRCVP,PRCVAL,PRCVIT
K ^TMP("PRCVIT",$J,PRCVN)
S PRCVP=67280421310721
S PRCVFN=$O(^PRCV(414.04,"D","ITEM",0))
S PRCVAL=$$CHKSUM()
; If checksum not equal 0, get data to DynaMed
I PRCVAL,PRCVAL'=$P($G(^PRCV(414.04,PRCVFN,1,PRCVN,0)),U,2) D
. D GETDATA(PRCVN)
. S ^PRCV(414.04,PRCVFN,1,PRCVN,0)=PRCVN_U_PRCVAL
. I $D(^TMP("PRCVIT",$J,PRCVN)) D EN^PRCVIMF(PRCVN)
. Q
K ^TMP("PRCVIT",$J,PRCVN)
Q
INIT ;
; Initialize checksum global at installation
N PRCVN,PRCVP,RESULT,FDA
;
S FDA(414.04,"?+1,",.01)="ITEM"
S FDA(414.04,"?+1,",.02)=441
S FDA(414.04,"?+1,",.03)="Item file checksum (on partial field)"
D UPDATE^DIE("E","FDA","RESULT")
S PRCVP=67280421310721,PRCVN=99999
F S PRCVN=$O(^PRC(441,PRCVN)) Q:'PRCVN D
. S FDA(414.41,"?+1,"_RESULT(1)_",",.01)=PRCVN
. S FDA(414.41,"?+1,"_RESULT(1)_",",1)=$$CHKSUM()
. D UPDATE^DIE("E","FDA")
Q
;
CHKSUM() ;
N PRCVST
S PRCVAL=0
; Node 0
S PRCVIT=$G(^PRC(441,PRCVN,0))
; Piece 1 - ITEM Number
; Piece 2 - ITEM Short Description
; Piece 3 - FSC - Federal Supply Classification
; Piece 4 - Last vendor ordered
; Piece 5 - NSN - National Stock Number
; Piece 6 - Case/Cart Tray/instrument kit
; Piece 8 - Mandatory Source
; Piece 9 - Date Item Created
; Piece 10 - BOC
; Piece 11 - DUZ
; Piece 13 - Reusable Item
; Piece 14 - Hazardous material
; Piece 15 - NIF ITEM number
S PRCVI=0
F PRCVI=1:1:6,8:1:11,13:1:15 D
. S PRCVST=$P(PRCVIT,U,PRCVI)
. S PRCVAL=$$CKINC(PRCVAL,PRCVST)
. Q
; Node 1 - Description
;
S PRCVI=0
F S PRCVI=$O(^PRC(441,PRCVN,1,PRCVI)) Q:'PRCVI D
. S PRCVST=^PRC(441,PRCVN,1,PRCVI,0)
. S PRCVAL=$$CKINC(PRCVAL,PRCVST)
. Q
; Node 2 - Vendors
S PRCVI=0
F S PRCVI=$O(^PRC(441,PRCVN,2,PRCVI)) Q:'PRCVI D
. S PRCVST=^PRC(441,PRCVN,2,PRCVI,0)
. S PRCVAL=$$CKINC(PRCVAL,PRCVST)
. Q
; Node 3
; Piece 1 - Inactivated ITEM?
; Piece 2 - Date Inactivated
; Piece 3 - Inactivated By
; Piece 4 - Replacement Item
; Piece 5 - MFG Part No.
; Piece 6 - NSN Verified
; Piece 7 - Food Group
; Piece 8 - SKU
; Piece 9 - Drug Type Code
; Piece 10 - SIC Code
;
; Check the whole node 3
;
S PRCVST=$G(^PRC(441,PRCVN,3))
I PRCVST]"" S PRCVAL=$$CKINC(PRCVAL,PRCVST)
;
; Node 4 - Fund Control Point
S PRCVI=0
F S PRCVI=$O(^PRC(441,PRCVN,4,PRCVI)) Q:'PRCVI D
. S PRCVST=$G(^PRC(441,PRCVN,4,PRCVI,0))
. S PRCVAL=$$CKINC(PRCVAL,PRCVST)
. Q
; Node 6 - Pre_NIF Long Description
S PRCVI=0
F S PRCVI=$O(^PRC(441,PRCVN,6,PRCVI)) Q:'PRCVI D
. S PRCVST=^PRC(441,PRCVN,6,PRCVI,0)
. S PRCVAL=$$CKINC(PRCVAL,PRCVST)
. Q
;
Q PRCVAL
;
GETDATA(PRCVNM) ;
; Get all field required,
; Node 0
;
N PRCVND,PRCVI,PRCVJ,PRCVCON,PRCVERR
S PRCVERR=0
S PRCVIT=$G(^PRC(441,PRCVNM,0))
S PRCVND=$P(PRCVIT,U,1,6)
S PRCVJ=6
F PRCVI=8:1:11,13,14,15 D
. S PRCVJ=PRCVJ+1
. S $P(PRCVND,U,PRCVJ)=$P(PRCVIT,U,PRCVI)
. Q
S $P(PRCVND,U,11)="N"
S:$P(PRCVIT,U,13)="Y"!("y") $P(PRCVND,U,11)="Y"
S ^TMP("PRCVIT",$J,PRCVNM,0)=PRCVND
;
; Node 1 - Description
S PRCVI=0
F S PRCVI=$O(^PRC(441,PRCVNM,1,PRCVI)) Q:'PRCVI D
. S ^TMP("PRCVIT",$J,PRCVNM,1,PRCVI)=^PRC(441,PRCVNM,1,PRCVI,0)
. Q
; Node 2 - Vendors
S PRCVI=0
F S PRCVI=$O(^PRC(441,PRCVNM,2,PRCVI)) Q:'PRCVI D
. S PRCVND=^PRC(441,PRCVNM,2,PRCVI,0)
. ; Check if the contract exists in Vendor File
. ; If not, send a message to Control Point officer
. I $P(PRCVND,U)']"" S $P(PRCVND,U)=0
. I $P(PRCVND,U,3)']"" S $P(PRCVND,U,3)=0
. S PRCVCON=$G(^PRC(440,$P(PRCVND,U),4,$P(PRCVND,U,3),0))
. I $P(PRCVND,U)>0,($P(PRCVND,U,3)>0),($P(PRCVCON,U)']"") D
.. S PRCVERR=PRCVERR+1
.. S PRCVERR(PRCVERR)="Contract # "_$P(PRCVND,U,3)_" of VENDOR - "_$P(PRCVND,U)_", "_$P($G(^PRC(440,$P(PRCVND,U),0)),U)_", for ITEM # "_PRCVNM_" does not exist in IFCAP Vendor file."
.. S $P(PRCVND,U,3)=""
.. Q
. ; Check exp. date of contract, QUIT if expired more than 365 days
. I $P(PRCVCON,U,3)]"",($P(PRCVCON,U,3)<$$FMADD^XLFDT(DT,-365)) S $P(PRCVND,U,3)=""
. ; Conversion on PRCVND
. S:$P(PRCVND,U,2)="" $P(PRCVND,U,2)=0
. S:$P(PRCVND,U,8)="" $P(PRCVND,U,8)=1
. S ^TMP("PRCVIT",$J,PRCVNM,2,PRCVI)=PRCVND
. Q
; Node 3
I $D(^PRC(441,PRCVNM,3)) S ^TMP("PRCVIT",$J,PRCVNM,3)=^PRC(441,PRCVNM,3)
;
; Node 4 - Fund Control Point
S PRCVI=0
F S PRCVI=$O(^PRC(441,PRCVNM,4,PRCVI)) Q:'PRCVI D
. S PRCVND=^PRC(441,PRCVNM,4,PRCVI,0)
. S $P(PRCVND,U)=$E($P(PRCVND,U),4,7)
. S ^TMP("PRCVIT",$J,PRCVNM,4,PRCVI)=PRCVND
. Q
;
; Node 6 - Pre_NIF Long Description
S PRCVI=0
F S PRCVI=$O(^PRC(441,PRCVNM,6,PRCVI)) Q:'PRCVI D
. S ^TMP("PRCVIT",$J,PRCVNM,6,PRCVI)=^PRC(441,PRCVNM,6,PRCVI,0)
. Q
; If there are error(s), inform user by e-mail
I PRCVERR>0 D XMD
Q
;
XMD ; Send a message to Control Point officer/clerk for data mismatch
;
N XMDUZ,XMMG,XMSUB,XMTEXT,XMY,XMZ
S XMSUB="Inventory System ITEM Update Info "_$$HTE^XLFDT($H)
S XMDUZ="IFCAP/COTS Inventory Interface"
S XMTEXT="PRCVERR("
; S PRCVERR(1)="Contract "_PRCVCON_" of VENDOR # "_$P(PRCVND,U)_" for ITEM # "_PRCVNM_" does not existed in IFCAP Vendor file."
S XMY("G.PRCV Item Vendor Edits")=""
D ^XMD
Q
;
CKINC(PRCVF,PRCVS) ;incremental checksum
N LEN,FIB,C,I,PRCVAL,TEST
S TEST=PRCVF
S PRCVF=+$G(PRCVF)
S PRCVS=$G(PRCVS)
;No change on null input
Q:PRCVS="" PRCVF
S LEN=$L(PRCVS)
S PRCVAL=0
S FIB(1)=1,FIB(2)=1
F I=1:1:LEN D
.S C=$E(PRCVS,I)
.S:I>2 FIB(I)=FIB(I-1)+FIB(I-2)#2147483647
.S PRCVAL=(PRCVF+PRCVAL+($A(C)*FIB(I)))#PRCVP
Q PRCVAL
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCVIT 6792 printed Oct 16, 2024@18:20:49 Page 2
PRCVIT ;WOIFO/DST - Send ITEM master file update to DYNAMED ; 3/2/05 5:07pm
+1 ;;5.1;IFCAP;**81**;Oct 20, 2000
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
+4 QUIT
NITECHK ;
+1 ; Once a day check
+2 ; Compare a checksum and set a record to update
+3 ;
+4 ; If not DynaMed, don't do it
+5 if '$$GET^XPAR("SYS","PRCV COTS INVENTORY",1,"Q")
QUIT
+6 ;
+7 NEW PRCND,PRCVL,PRCVP,PRCVAL,PRCVIT,PRCVN,PRCVSTN
+8 NEW PRCVFN
+9 SET PRCVP=67280421310721
SET PRCVN=99999
+10 SET PRCVFN=$ORDER(^PRCV(414.04,"D","ITEM",0))
+11 ; Clear old flag
+12 KILL ^TMP("PRCVIT",$JOB)
+13 SET PRCVSTN=$$GET1^DIQ(4,$$KSP^XUPARAM("INST")_",",99)
+14 FOR
SET PRCVN=$ORDER(^PRC(441,PRCVN))
if 'PRCVN
QUIT
Begin DoDot:1
+15 SET PRCVAL=$$CHKSUM()
+16 ; Compare to existing CheckSum
+17 ; Kick off HL7 interface message to DynaMed, if not the same
+18 IF PRCVAL
IF PRCVAL'=$PIECE($GET(^PRCV(414.04,PRCVFN,1,PRCVN,0)),U,2)
Begin DoDot:2
+19 SET ^PRCV(414.04,PRCVFN,1,PRCVN,0)=PRCVN_U_PRCVAL
+20 DO GETDATA(PRCVN)
+21 IF $DATA(^TMP("PRCVIT",$JOB,PRCVN))
DO EN^PRCVIMF(PRCVN)
+22 QUIT
End DoDot:2
+23 QUIT
End DoDot:1
+24 KILL ^TMP("PRCVIT",$JOB)
+25 QUIT
+26 ;
ONECHK(PRCVN) ;
+1 ; Checksum to one ITEM only
+2 if PRCVN<99999
QUIT
+3 NEW PRCND,PRCVL,PRCVFN,PRCVP,PRCVAL,PRCVIT
+4 KILL ^TMP("PRCVIT",$JOB,PRCVN)
+5 SET PRCVP=67280421310721
+6 SET PRCVFN=$ORDER(^PRCV(414.04,"D","ITEM",0))
+7 SET PRCVAL=$$CHKSUM()
+8 ; If checksum not equal 0, get data to DynaMed
+9 IF PRCVAL
IF PRCVAL'=$PIECE($GET(^PRCV(414.04,PRCVFN,1,PRCVN,0)),U,2)
Begin DoDot:1
+10 DO GETDATA(PRCVN)
+11 SET ^PRCV(414.04,PRCVFN,1,PRCVN,0)=PRCVN_U_PRCVAL
+12 IF $DATA(^TMP("PRCVIT",$JOB,PRCVN))
DO EN^PRCVIMF(PRCVN)
+13 QUIT
End DoDot:1
+14 KILL ^TMP("PRCVIT",$JOB,PRCVN)
+15 QUIT
INIT ;
+1 ; Initialize checksum global at installation
+2 NEW PRCVN,PRCVP,RESULT,FDA
+3 ;
+4 SET FDA(414.04,"?+1,",.01)="ITEM"
+5 SET FDA(414.04,"?+1,",.02)=441
+6 SET FDA(414.04,"?+1,",.03)="Item file checksum (on partial field)"
+7 DO UPDATE^DIE("E","FDA","RESULT")
+8 SET PRCVP=67280421310721
SET PRCVN=99999
+9 FOR
SET PRCVN=$ORDER(^PRC(441,PRCVN))
if 'PRCVN
QUIT
Begin DoDot:1
+10 SET FDA(414.41,"?+1,"_RESULT(1)_",",.01)=PRCVN
+11 SET FDA(414.41,"?+1,"_RESULT(1)_",",1)=$$CHKSUM()
+12 DO UPDATE^DIE("E","FDA")
End DoDot:1
+13 QUIT
+14 ;
CHKSUM() ;
+1 NEW PRCVST
+2 SET PRCVAL=0
+3 ; Node 0
+4 SET PRCVIT=$GET(^PRC(441,PRCVN,0))
+5 ; Piece 1 - ITEM Number
+6 ; Piece 2 - ITEM Short Description
+7 ; Piece 3 - FSC - Federal Supply Classification
+8 ; Piece 4 - Last vendor ordered
+9 ; Piece 5 - NSN - National Stock Number
+10 ; Piece 6 - Case/Cart Tray/instrument kit
+11 ; Piece 8 - Mandatory Source
+12 ; Piece 9 - Date Item Created
+13 ; Piece 10 - BOC
+14 ; Piece 11 - DUZ
+15 ; Piece 13 - Reusable Item
+16 ; Piece 14 - Hazardous material
+17 ; Piece 15 - NIF ITEM number
+18 SET PRCVI=0
+19 FOR PRCVI=1:1:6,8:1:11,13:1:15
Begin DoDot:1
+20 SET PRCVST=$PIECE(PRCVIT,U,PRCVI)
+21 SET PRCVAL=$$CKINC(PRCVAL,PRCVST)
+22 QUIT
End DoDot:1
+23 ; Node 1 - Description
+24 ;
+25 SET PRCVI=0
+26 FOR
SET PRCVI=$ORDER(^PRC(441,PRCVN,1,PRCVI))
if 'PRCVI
QUIT
Begin DoDot:1
+27 SET PRCVST=^PRC(441,PRCVN,1,PRCVI,0)
+28 SET PRCVAL=$$CKINC(PRCVAL,PRCVST)
+29 QUIT
End DoDot:1
+30 ; Node 2 - Vendors
+31 SET PRCVI=0
+32 FOR
SET PRCVI=$ORDER(^PRC(441,PRCVN,2,PRCVI))
if 'PRCVI
QUIT
Begin DoDot:1
+33 SET PRCVST=^PRC(441,PRCVN,2,PRCVI,0)
+34 SET PRCVAL=$$CKINC(PRCVAL,PRCVST)
+35 QUIT
End DoDot:1
+36 ; Node 3
+37 ; Piece 1 - Inactivated ITEM?
+38 ; Piece 2 - Date Inactivated
+39 ; Piece 3 - Inactivated By
+40 ; Piece 4 - Replacement Item
+41 ; Piece 5 - MFG Part No.
+42 ; Piece 6 - NSN Verified
+43 ; Piece 7 - Food Group
+44 ; Piece 8 - SKU
+45 ; Piece 9 - Drug Type Code
+46 ; Piece 10 - SIC Code
+47 ;
+48 ; Check the whole node 3
+49 ;
+50 SET PRCVST=$GET(^PRC(441,PRCVN,3))
+51 IF PRCVST]""
SET PRCVAL=$$CKINC(PRCVAL,PRCVST)
+52 ;
+53 ; Node 4 - Fund Control Point
+54 SET PRCVI=0
+55 FOR
SET PRCVI=$ORDER(^PRC(441,PRCVN,4,PRCVI))
if 'PRCVI
QUIT
Begin DoDot:1
+56 SET PRCVST=$GET(^PRC(441,PRCVN,4,PRCVI,0))
+57 SET PRCVAL=$$CKINC(PRCVAL,PRCVST)
+58 QUIT
End DoDot:1
+59 ; Node 6 - Pre_NIF Long Description
+60 SET PRCVI=0
+61 FOR
SET PRCVI=$ORDER(^PRC(441,PRCVN,6,PRCVI))
if 'PRCVI
QUIT
Begin DoDot:1
+62 SET PRCVST=^PRC(441,PRCVN,6,PRCVI,0)
+63 SET PRCVAL=$$CKINC(PRCVAL,PRCVST)
+64 QUIT
End DoDot:1
+65 ;
+66 QUIT PRCVAL
+67 ;
GETDATA(PRCVNM) ;
+1 ; Get all field required,
+2 ; Node 0
+3 ;
+4 NEW PRCVND,PRCVI,PRCVJ,PRCVCON,PRCVERR
+5 SET PRCVERR=0
+6 SET PRCVIT=$GET(^PRC(441,PRCVNM,0))
+7 SET PRCVND=$PIECE(PRCVIT,U,1,6)
+8 SET PRCVJ=6
+9 FOR PRCVI=8:1:11,13,14,15
Begin DoDot:1
+10 SET PRCVJ=PRCVJ+1
+11 SET $PIECE(PRCVND,U,PRCVJ)=$PIECE(PRCVIT,U,PRCVI)
+12 QUIT
End DoDot:1
+13 SET $PIECE(PRCVND,U,11)="N"
+14 if $PIECE(PRCVIT,U,13)="Y"!("y")
SET $PIECE(PRCVND,U,11)="Y"
+15 SET ^TMP("PRCVIT",$JOB,PRCVNM,0)=PRCVND
+16 ;
+17 ; Node 1 - Description
+18 SET PRCVI=0
+19 FOR
SET PRCVI=$ORDER(^PRC(441,PRCVNM,1,PRCVI))
if 'PRCVI
QUIT
Begin DoDot:1
+20 SET ^TMP("PRCVIT",$JOB,PRCVNM,1,PRCVI)=^PRC(441,PRCVNM,1,PRCVI,0)
+21 QUIT
End DoDot:1
+22 ; Node 2 - Vendors
+23 SET PRCVI=0
+24 FOR
SET PRCVI=$ORDER(^PRC(441,PRCVNM,2,PRCVI))
if 'PRCVI
QUIT
Begin DoDot:1
+25 SET PRCVND=^PRC(441,PRCVNM,2,PRCVI,0)
+26 ; Check if the contract exists in Vendor File
+27 ; If not, send a message to Control Point officer
+28 IF $PIECE(PRCVND,U)']""
SET $PIECE(PRCVND,U)=0
+29 IF $PIECE(PRCVND,U,3)']""
SET $PIECE(PRCVND,U,3)=0
+30 SET PRCVCON=$GET(^PRC(440,$PIECE(PRCVND,U),4,$PIECE(PRCVND,U,3),0))
+31 IF $PIECE(PRCVND,U)>0
IF ($PIECE(PRCVND,U,3)>0)
IF ($PIECE(PRCVCON,U)']"")
Begin DoDot:2
+32 SET PRCVERR=PRCVERR+1
+33 SET PRCVERR(PRCVERR)="Contract # "_$PIECE(PRCVND,U,3)_" of VENDOR - "_$PIECE(PRCVND,U)_", "_$PIECE($GET(^PRC(440,$PIECE(PRCVND,U),0)),U)_", for ITEM # "_PRCVNM_" does not exist in IFCAP Vendor file."
+34 SET $PIECE(PRCVND,U,3)=""
+35 QUIT
End DoDot:2
+36 ; Check exp. date of contract, QUIT if expired more than 365 days
+37 IF $PIECE(PRCVCON,U,3)]""
IF ($PIECE(PRCVCON,U,3)<$$FMADD^XLFDT(DT,-365))
SET $PIECE(PRCVND,U,3)=""
+38 ; Conversion on PRCVND
+39 if $PIECE(PRCVND,U,2)=""
SET $PIECE(PRCVND,U,2)=0
+40 if $PIECE(PRCVND,U,8)=""
SET $PIECE(PRCVND,U,8)=1
+41 SET ^TMP("PRCVIT",$JOB,PRCVNM,2,PRCVI)=PRCVND
+42 QUIT
End DoDot:1
+43 ; Node 3
+44 IF $DATA(^PRC(441,PRCVNM,3))
SET ^TMP("PRCVIT",$JOB,PRCVNM,3)=^PRC(441,PRCVNM,3)
+45 ;
+46 ; Node 4 - Fund Control Point
+47 SET PRCVI=0
+48 FOR
SET PRCVI=$ORDER(^PRC(441,PRCVNM,4,PRCVI))
if 'PRCVI
QUIT
Begin DoDot:1
+49 SET PRCVND=^PRC(441,PRCVNM,4,PRCVI,0)
+50 SET $PIECE(PRCVND,U)=$EXTRACT($PIECE(PRCVND,U),4,7)
+51 SET ^TMP("PRCVIT",$JOB,PRCVNM,4,PRCVI)=PRCVND
+52 QUIT
End DoDot:1
+53 ;
+54 ; Node 6 - Pre_NIF Long Description
+55 SET PRCVI=0
+56 FOR
SET PRCVI=$ORDER(^PRC(441,PRCVNM,6,PRCVI))
if 'PRCVI
QUIT
Begin DoDot:1
+57 SET ^TMP("PRCVIT",$JOB,PRCVNM,6,PRCVI)=^PRC(441,PRCVNM,6,PRCVI,0)
+58 QUIT
End DoDot:1
+59 ; If there are error(s), inform user by e-mail
+60 IF PRCVERR>0
DO XMD
+61 QUIT
+62 ;
XMD ; Send a message to Control Point officer/clerk for data mismatch
+1 ;
+2 NEW XMDUZ,XMMG,XMSUB,XMTEXT,XMY,XMZ
+3 SET XMSUB="Inventory System ITEM Update Info "_$$HTE^XLFDT($HOROLOG)
+4 SET XMDUZ="IFCAP/COTS Inventory Interface"
+5 SET XMTEXT="PRCVERR("
+6 ; S PRCVERR(1)="Contract "_PRCVCON_" of VENDOR # "_$P(PRCVND,U)_" for ITEM # "_PRCVNM_" does not existed in IFCAP Vendor file."
+7 SET XMY("G.PRCV Item Vendor Edits")=""
+8 DO ^XMD
+9 QUIT
+10 ;
CKINC(PRCVF,PRCVS) ;incremental checksum
+1 NEW LEN,FIB,C,I,PRCVAL,TEST
+2 SET TEST=PRCVF
+3 SET PRCVF=+$GET(PRCVF)
+4 SET PRCVS=$GET(PRCVS)
+5 ;No change on null input
+6 if PRCVS=""
QUIT PRCVF
+7 SET LEN=$LENGTH(PRCVS)
+8 SET PRCVAL=0
+9 SET FIB(1)=1
SET FIB(2)=1
+10 FOR I=1:1:LEN
Begin DoDot:1
+11 SET C=$EXTRACT(PRCVS,I)
+12 if I>2
SET FIB(I)=FIB(I-1)+FIB(I-2)#2147483647
+13 SET PRCVAL=(PRCVF+PRCVAL+($ASCII(C)*FIB(I)))#PRCVP
End DoDot:1
+14 QUIT PRCVAL
