- 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 Feb 18, 2025@23:46:27 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