Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRCHJS03

PRCHJS03.m

Go to the documentation of this file.
  1. PRCHJS03 ;OI&T/KCL - IFCAP/ECMS INTERFACE RETRIEVE 2237 DATA CONT.;6/12/12 ;1/26/22 12:24
  1. ;;5.1;IFCAP;**167,227**;Oct 20, 2000;Build 1
  1. ;Per VHA Directive 6402, this routine should not be modified.
  1. ;
  1. GET440(PRC440R,PRCWRK,PRCER) ;Get #440 data
  1. ;This function is used to retrieve specified data
  1. ;elements from from the VENDOR (#440) file and places
  1. ;them into ^TMP work global. Data is placed into the
  1. ;work global in both internal and external format.
  1. ;
  1. ; Input:
  1. ; PRC440R - (required) IEN of record in VENDOR (#440) file
  1. ; PRCWRK - (required) name of work global containing data elements
  1. ;
  1. ; Output:
  1. ; Function value - 1 on success, 0 on failure
  1. ; PRCER - (optional) on failure, an error message is returned,
  1. ; pass by reference
  1. ; PRCWRK - work global containing the #440 data elements:
  1. ;
  1. ; Subscript Field# Data Element
  1. ; --------- ------ -------------------
  1. ; VEDI .2 EDI VENDOR?
  1. ; VID .4 VENDOR ID NUMBER
  1. ; VACT 5.1 ACCOUNT NO.
  1. ; VGDV 5.2 GUARANTEED DELIVERY VENDOR
  1. ; VPAYCON 17 PAYMENT CONTACT PERSON
  1. ; VPAYPH 17.2 PAYMENT PHONE NO.
  1. ; VPAYAD1 17.3 PAYMENT ADDRESS1
  1. ; VPAYAD2 17.4 PAYMENT ADDRESS2
  1. ; VPAYAD3 17.5 PAYMENT ADDRESS3
  1. ; VPAYAD4 17.6 PAYMENT ADDRESS4
  1. ; VPAYCTY 17.7 PAYMENT CITY
  1. ; VPAYST 17.8 PAYMENT STATE
  1. ; VPAYZIP 17.9 PAYMENT ZIP CODE
  1. ; VDUNS 18.3 DUN & BRADSTREET #
  1. ; VFMSCD 34 FMS VENDOR CODE
  1. ; VFMSNM 34.5 FMS VENDOR NAME
  1. ; VALTADD 35 ALT-ADDR-IND
  1. ; VFAX 46 FAX #
  1. ; VUEI 55 UEI
  1. ;
  1. N PRCIENS ;iens string for GETS^DIQ
  1. N PRCFLDS ;results array for GETS^DIQ
  1. N PRCERR ;error msg for GETS^DIQ
  1. N PRCRSLT ;function result
  1. ;
  1. S PRCRSLT=0
  1. S PRCER="Vendor record not found"
  1. ;
  1. I $G(PRC440R)>0,$D(^PRC(440,PRC440R)) D
  1. . ;
  1. . ;retrieve fields
  1. . S PRCIENS=PRC440R_","
  1. . D GETS^DIQ(440,PRCIENS,"*","IE","PRCFLDS","PRCERR")
  1. . I $D(PRCERR) S PRCER="Unable to retrieve Vendor record" Q
  1. . ;
  1. . ;place top level #440 fields into work global
  1. . S @PRCWRK@("VEDI")=$G(PRCFLDS(440,PRCIENS,.2,"I"))_U_$G(PRCFLDS(440,PRCIENS,.2,"E"))
  1. . S @PRCWRK@("VID")=$G(PRCFLDS(440,PRCIENS,.4,"I"))_U_$G(PRCFLDS(440,PRCIENS,.4,"E"))
  1. . S @PRCWRK@("VACT")=$G(PRCFLDS(440,PRCIENS,5.1,"I"))_U_$G(PRCFLDS(440,PRCIENS,5.1,"E"))
  1. . S @PRCWRK@("VGDV")=$G(PRCFLDS(440,PRCIENS,5.2,"I"))_U_$G(PRCFLDS(440,PRCIENS,5.2,"E"))
  1. . S @PRCWRK@("VPAYCON")=$G(PRCFLDS(440,PRCIENS,17,"I"))_U_$G(PRCFLDS(440,PRCIENS,17,"E"))
  1. . S @PRCWRK@("VPAYPH")=$G(PRCFLDS(440,PRCIENS,17.2,"I"))_U_$G(PRCFLDS(440,PRCIENS,17.2,"E"))
  1. . S @PRCWRK@("VPAYAD1")=$G(PRCFLDS(440,PRCIENS,17.3,"I"))_U_$G(PRCFLDS(440,PRCIENS,17.3,"E"))
  1. . S @PRCWRK@("VPAYAD2")=$G(PRCFLDS(440,PRCIENS,17.4,"I"))_U_$G(PRCFLDS(440,PRCIENS,17.4,"E"))
  1. . S @PRCWRK@("VPAYAD3")=$G(PRCFLDS(440,PRCIENS,17.5,"I"))_U_$G(PRCFLDS(440,PRCIENS,17.5,"E"))
  1. . S @PRCWRK@("VPAYAD4")=$G(PRCFLDS(440,PRCIENS,17.6,"I"))_U_$G(PRCFLDS(440,PRCIENS,17.6,"E"))
  1. . S @PRCWRK@("VPAYCTY")=$G(PRCFLDS(440,PRCIENS,17.7,"I"))_U_$G(PRCFLDS(440,PRCIENS,17.7,"E"))
  1. . S @PRCWRK@("VPAYST")=$G(PRCFLDS(440,PRCIENS,17.8,"I"))_U_$G(PRCFLDS(440,PRCIENS,17.8,"E"))
  1. . S @PRCWRK@("VPAYZIP")=$G(PRCFLDS(440,PRCIENS,17.9,"I"))_U_$G(PRCFLDS(440,PRCIENS,17.9,"E"))
  1. . S @PRCWRK@("VDUNS")=$G(PRCFLDS(440,PRCIENS,18.3,"I"))_U_$G(PRCFLDS(440,PRCIENS,18.3,"E"))
  1. . S @PRCWRK@("VFMSCD")=$G(PRCFLDS(440,PRCIENS,34,"I"))_U_$G(PRCFLDS(440,PRCIENS,34,"E"))
  1. . S @PRCWRK@("VFMSNM")=$G(PRCFLDS(440,PRCIENS,34.5,"I"))_U_$G(PRCFLDS(440,PRCIENS,34.5,"E"))
  1. . S @PRCWRK@("VALTADD")=$G(PRCFLDS(440,PRCIENS,35,"I"))_U_$G(PRCFLDS(440,PRCIENS,35,"E"))
  1. . S @PRCWRK@("VFAX")=$G(PRCFLDS(440,PRCIENS,46,"I"))_U_$G(PRCFLDS(440,PRCIENS,46,"E"))
  1. . S @PRCWRK@("VUEI")=$G(PRCFLDS(440,PRCIENS,55,"I"))_U_$G(PRCFLDS(440,PRCIENS,55,"E"))
  1. . ;
  1. . ;success
  1. . S PRCRSLT=1 K PRCER
  1. ;
  1. Q PRCRSLT
  1. ;
  1. ;
  1. GET443(PRCTRAN,PRCWRK,PRCER) ;Get #443 data
  1. ;This function is used to retrieve specified data
  1. ;elements from the REQUEST WORKSHEET (#443) file for
  1. ;a 2237 Transaction Number and places them into a
  1. ;^TMP work global. It also obtains the Title of the
  1. ;Accountable Officer from the NEW PERSON (#200) file.
  1. ;Data is placed into the work global in both internal
  1. ;and external format.
  1. ;
  1. ; Supported ICR:
  1. ; #4329: Allows retrieval of TITLE (#8) field from NEW PERSON (#200)
  1. ; file using FM read.
  1. ;
  1. ; Input:
  1. ; PRCTRAN - (required) 2237 Transaction Number
  1. ; PRCWRK - (required) name of work global containing data elements
  1. ;
  1. ; Output:
  1. ; Function value - 1 on success, 0 on failure
  1. ; PRCER - (optional) on failure, an error message is returned,
  1. ; pass by ref
  1. ; PRCWRK - work global containing the #443 & #200 data elements:
  1. ;
  1. ; Subscript File,Field# Data Element
  1. ; --------- ----------- -------------------
  1. ; AO 443,2 ACCOUNTABLE OFFICER
  1. ; AOESIG 443,4 ESIG DATE/TIME
  1. ; EXPEND 443,13 EXPENDABLE/NONEXPENDABLE
  1. ; AOTITLE 200,8 TITLE
  1. ;
  1. N PRCIENS ;iens string for GETS^DIQ
  1. N PRCFLDS ;results array for GETS^DIQ
  1. N PRCERR ;FM error array
  1. N PRCREC ;ien of record in #443 file
  1. N PRCRSLT ;function result
  1. ;
  1. S PRCRSLT=0
  1. S PRCER="Request Worksheet record not found"
  1. ;
  1. ; drops out of DO block on failure
  1. I $G(PRCTRAN)]"" D
  1. . ;
  1. . ;lookup 2237 Transaction Number
  1. . S PRCREC=$$FIND1^DIC(443,"","X",$G(PRCTRAN),"","","PRCERR")
  1. . Q:('PRCREC)!($D(PRCERR))
  1. . ;
  1. . ;retrieve #443 fields
  1. . S PRCIENS=+$G(PRCREC)_","
  1. . D GETS^DIQ(443,PRCIENS,"2;4;13","IE","PRCFLDS","PRCERR")
  1. . I $D(PRCERR) S PRCER="Unable to retrieve Request Worksheet record" Q
  1. . ;
  1. . ;place #443 fields into work global
  1. . S @PRCWRK@("AO")=$G(PRCFLDS(443,PRCIENS,2,"I"))_U_$G(PRCFLDS(443,PRCIENS,2,"E"))
  1. . S @PRCWRK@("AOESIG")=$G(PRCFLDS(443,PRCIENS,4,"I"))_U_$G(PRCFLDS(443,PRCIENS,4,"E"))
  1. . S @PRCWRK@("EXPEND")=$G(PRCFLDS(443,PRCIENS,13,"I"))_U_$G(PRCFLDS(443,PRCIENS,13,"E"))
  1. . ;
  1. . ;retrieve Accountable Officer (Title)
  1. . S PRCIENS=+$G(@PRCWRK@("AO"))_"," ;ptr to #200 file
  1. . I +$G(PRCIENS) D GETS^DIQ(200,PRCIENS,"8","IE","PRCFLDS","PRCERR")
  1. . I $D(PRCERR) S PRCER="Unable to retrieve Accountable Officer (Title)" Q
  1. . S @PRCWRK@("AOTITLE")=$G(PRCFLDS(200,PRCIENS,8,"I"))_U_$G(PRCFLDS(200,PRCIENS,8,"E"))
  1. . ;
  1. . ;success
  1. . S PRCRSLT=1 K PRCER
  1. ;
  1. Q PRCRSLT
  1. ;
  1. ;
  1. GET445(PRC445R,PRCWRK,PRCER) ;Get GENERIC INVENTORY (#445) data
  1. ;This function retrieves 2237 data elements from
  1. ;the GENERIC INVENTORY (#445) file and places them
  1. ;into a ^TMP work global. Data is placed into the work
  1. ;global in both internal and external format.
  1. ;
  1. ; Input:
  1. ; PRC445R - (required) IEN of record in GENERIC INVENTORY (#445) file
  1. ; PRCWRK - (required) name of work global containing data elements
  1. ;
  1. ; Output:
  1. ; Function value - 1 on success, 0 on failure
  1. ; PRCER - (optional) on failure, an error message is returned,
  1. ; pass by reference
  1. ; PRCWRK - work global containing the #445 data elements:
  1. ;
  1. ; Subscript Field# Data Element
  1. ; --------- ------ -------------------
  1. ; INVPT .01 INVENTORY POINT
  1. ; INVABREV .8 ABBREVIATED NAME
  1. ;
  1. N PRCIENS ;iens string for GETS^DIQ
  1. N PRCFLDS ;results array for GETS^DIQ
  1. N PRCERR ;error array for GETS^DIQ
  1. N PRCRSLT ;function result
  1. ;
  1. S PRCRSLT=0
  1. S PRCER="Generic Inventory record not found"
  1. ;
  1. I $G(PRC445R)>0,$D(^PRCP(445,PRC445R)) D
  1. . ;
  1. . ;retrieve data from (#445) file
  1. . S PRCIENS=PRC445R_","
  1. . D GETS^DIQ(445,PRCIENS,"*","IE","PRCFLDS","PRCERR")
  1. . I $D(PRCERR) S PRCER="Unable to retrieve Generic Inventory record" Q
  1. . ;
  1. . ;place (#445) fields into work global
  1. . S @PRCWRK@("INVPT")=$G(PRCFLDS(445,PRCIENS,.01,"I"))_U_$G(PRCFLDS(445,PRCIENS,.01,"E"))
  1. . S @PRCWRK@("INVABREV")=$G(PRCFLDS(445,PRCIENS,.8,"I"))_U_$G(PRCFLDS(445,PRCIENS,.8,"E"))
  1. . ;
  1. . ;success
  1. . S PRCRSLT=1 K PRCER
  1. ;
  1. Q PRCRSLT