- PRCHJS03 ;OI&T/KCL - IFCAP/ECMS INTERFACE RETRIEVE 2237 DATA CONT.;6/12/12 ;1/26/22 12:24
- ;;5.1;IFCAP;**167,227**;Oct 20, 2000;Build 1
- ;Per VHA Directive 6402, this routine should not be modified.
- ;
- GET440(PRC440R,PRCWRK,PRCER) ;Get #440 data
- ;This function is used to retrieve specified data
- ;elements from from the VENDOR (#440) file and places
- ;them into ^TMP work global. Data is placed into the
- ;work global in both internal and external format.
- ;
- ; Input:
- ; PRC440R - (required) IEN of record in VENDOR (#440) file
- ; PRCWRK - (required) name of work global containing data elements
- ;
- ; Output:
- ; Function value - 1 on success, 0 on failure
- ; PRCER - (optional) on failure, an error message is returned,
- ; pass by reference
- ; PRCWRK - work global containing the #440 data elements:
- ;
- ; Subscript Field# Data Element
- ; --------- ------ -------------------
- ; VEDI .2 EDI VENDOR?
- ; VID .4 VENDOR ID NUMBER
- ; VACT 5.1 ACCOUNT NO.
- ; VGDV 5.2 GUARANTEED DELIVERY VENDOR
- ; VPAYCON 17 PAYMENT CONTACT PERSON
- ; VPAYPH 17.2 PAYMENT PHONE NO.
- ; VPAYAD1 17.3 PAYMENT ADDRESS1
- ; VPAYAD2 17.4 PAYMENT ADDRESS2
- ; VPAYAD3 17.5 PAYMENT ADDRESS3
- ; VPAYAD4 17.6 PAYMENT ADDRESS4
- ; VPAYCTY 17.7 PAYMENT CITY
- ; VPAYST 17.8 PAYMENT STATE
- ; VPAYZIP 17.9 PAYMENT ZIP CODE
- ; VDUNS 18.3 DUN & BRADSTREET #
- ; VFMSCD 34 FMS VENDOR CODE
- ; VFMSNM 34.5 FMS VENDOR NAME
- ; VALTADD 35 ALT-ADDR-IND
- ; VFAX 46 FAX #
- ; VUEI 55 UEI
- ;
- N PRCIENS ;iens string for GETS^DIQ
- N PRCFLDS ;results array for GETS^DIQ
- N PRCERR ;error msg for GETS^DIQ
- N PRCRSLT ;function result
- ;
- S PRCRSLT=0
- S PRCER="Vendor record not found"
- ;
- I $G(PRC440R)>0,$D(^PRC(440,PRC440R)) D
- . ;
- . ;retrieve fields
- . S PRCIENS=PRC440R_","
- . D GETS^DIQ(440,PRCIENS,"*","IE","PRCFLDS","PRCERR")
- . I $D(PRCERR) S PRCER="Unable to retrieve Vendor record" Q
- . ;
- . ;place top level #440 fields into work global
- . S @PRCWRK@("VEDI")=$G(PRCFLDS(440,PRCIENS,.2,"I"))_U_$G(PRCFLDS(440,PRCIENS,.2,"E"))
- . S @PRCWRK@("VID")=$G(PRCFLDS(440,PRCIENS,.4,"I"))_U_$G(PRCFLDS(440,PRCIENS,.4,"E"))
- . S @PRCWRK@("VACT")=$G(PRCFLDS(440,PRCIENS,5.1,"I"))_U_$G(PRCFLDS(440,PRCIENS,5.1,"E"))
- . S @PRCWRK@("VGDV")=$G(PRCFLDS(440,PRCIENS,5.2,"I"))_U_$G(PRCFLDS(440,PRCIENS,5.2,"E"))
- . S @PRCWRK@("VPAYCON")=$G(PRCFLDS(440,PRCIENS,17,"I"))_U_$G(PRCFLDS(440,PRCIENS,17,"E"))
- . S @PRCWRK@("VPAYPH")=$G(PRCFLDS(440,PRCIENS,17.2,"I"))_U_$G(PRCFLDS(440,PRCIENS,17.2,"E"))
- . S @PRCWRK@("VPAYAD1")=$G(PRCFLDS(440,PRCIENS,17.3,"I"))_U_$G(PRCFLDS(440,PRCIENS,17.3,"E"))
- . S @PRCWRK@("VPAYAD2")=$G(PRCFLDS(440,PRCIENS,17.4,"I"))_U_$G(PRCFLDS(440,PRCIENS,17.4,"E"))
- . S @PRCWRK@("VPAYAD3")=$G(PRCFLDS(440,PRCIENS,17.5,"I"))_U_$G(PRCFLDS(440,PRCIENS,17.5,"E"))
- . S @PRCWRK@("VPAYAD4")=$G(PRCFLDS(440,PRCIENS,17.6,"I"))_U_$G(PRCFLDS(440,PRCIENS,17.6,"E"))
- . S @PRCWRK@("VPAYCTY")=$G(PRCFLDS(440,PRCIENS,17.7,"I"))_U_$G(PRCFLDS(440,PRCIENS,17.7,"E"))
- . S @PRCWRK@("VPAYST")=$G(PRCFLDS(440,PRCIENS,17.8,"I"))_U_$G(PRCFLDS(440,PRCIENS,17.8,"E"))
- . S @PRCWRK@("VPAYZIP")=$G(PRCFLDS(440,PRCIENS,17.9,"I"))_U_$G(PRCFLDS(440,PRCIENS,17.9,"E"))
- . S @PRCWRK@("VDUNS")=$G(PRCFLDS(440,PRCIENS,18.3,"I"))_U_$G(PRCFLDS(440,PRCIENS,18.3,"E"))
- . S @PRCWRK@("VFMSCD")=$G(PRCFLDS(440,PRCIENS,34,"I"))_U_$G(PRCFLDS(440,PRCIENS,34,"E"))
- . S @PRCWRK@("VFMSNM")=$G(PRCFLDS(440,PRCIENS,34.5,"I"))_U_$G(PRCFLDS(440,PRCIENS,34.5,"E"))
- . S @PRCWRK@("VALTADD")=$G(PRCFLDS(440,PRCIENS,35,"I"))_U_$G(PRCFLDS(440,PRCIENS,35,"E"))
- . S @PRCWRK@("VFAX")=$G(PRCFLDS(440,PRCIENS,46,"I"))_U_$G(PRCFLDS(440,PRCIENS,46,"E"))
- . S @PRCWRK@("VUEI")=$G(PRCFLDS(440,PRCIENS,55,"I"))_U_$G(PRCFLDS(440,PRCIENS,55,"E"))
- . ;
- . ;success
- . S PRCRSLT=1 K PRCER
- ;
- Q PRCRSLT
- ;
- ;
- GET443(PRCTRAN,PRCWRK,PRCER) ;Get #443 data
- ;This function is used to retrieve specified data
- ;elements from the REQUEST WORKSHEET (#443) file for
- ;a 2237 Transaction Number and places them into a
- ;^TMP work global. It also obtains the Title of the
- ;Accountable Officer from the NEW PERSON (#200) file.
- ;Data is placed into the work global in both internal
- ;and external format.
- ;
- ; Supported ICR:
- ; #4329: Allows retrieval of TITLE (#8) field from NEW PERSON (#200)
- ; file using FM read.
- ;
- ; Input:
- ; PRCTRAN - (required) 2237 Transaction Number
- ; PRCWRK - (required) name of work global containing data elements
- ;
- ; Output:
- ; Function value - 1 on success, 0 on failure
- ; PRCER - (optional) on failure, an error message is returned,
- ; pass by ref
- ; PRCWRK - work global containing the #443 & #200 data elements:
- ;
- ; Subscript File,Field# Data Element
- ; --------- ----------- -------------------
- ; AO 443,2 ACCOUNTABLE OFFICER
- ; AOESIG 443,4 ESIG DATE/TIME
- ; EXPEND 443,13 EXPENDABLE/NONEXPENDABLE
- ; AOTITLE 200,8 TITLE
- ;
- N PRCIENS ;iens string for GETS^DIQ
- N PRCFLDS ;results array for GETS^DIQ
- N PRCERR ;FM error array
- N PRCREC ;ien of record in #443 file
- N PRCRSLT ;function result
- ;
- S PRCRSLT=0
- S PRCER="Request Worksheet record not found"
- ;
- ; drops out of DO block on failure
- I $G(PRCTRAN)]"" D
- . ;
- . ;lookup 2237 Transaction Number
- . S PRCREC=$$FIND1^DIC(443,"","X",$G(PRCTRAN),"","","PRCERR")
- . Q:('PRCREC)!($D(PRCERR))
- . ;
- . ;retrieve #443 fields
- . S PRCIENS=+$G(PRCREC)_","
- . D GETS^DIQ(443,PRCIENS,"2;4;13","IE","PRCFLDS","PRCERR")
- . I $D(PRCERR) S PRCER="Unable to retrieve Request Worksheet record" Q
- . ;
- . ;place #443 fields into work global
- . S @PRCWRK@("AO")=$G(PRCFLDS(443,PRCIENS,2,"I"))_U_$G(PRCFLDS(443,PRCIENS,2,"E"))
- . S @PRCWRK@("AOESIG")=$G(PRCFLDS(443,PRCIENS,4,"I"))_U_$G(PRCFLDS(443,PRCIENS,4,"E"))
- . S @PRCWRK@("EXPEND")=$G(PRCFLDS(443,PRCIENS,13,"I"))_U_$G(PRCFLDS(443,PRCIENS,13,"E"))
- . ;
- . ;retrieve Accountable Officer (Title)
- . S PRCIENS=+$G(@PRCWRK@("AO"))_"," ;ptr to #200 file
- . I +$G(PRCIENS) D GETS^DIQ(200,PRCIENS,"8","IE","PRCFLDS","PRCERR")
- . I $D(PRCERR) S PRCER="Unable to retrieve Accountable Officer (Title)" Q
- . S @PRCWRK@("AOTITLE")=$G(PRCFLDS(200,PRCIENS,8,"I"))_U_$G(PRCFLDS(200,PRCIENS,8,"E"))
- . ;
- . ;success
- . S PRCRSLT=1 K PRCER
- ;
- Q PRCRSLT
- ;
- ;
- GET445(PRC445R,PRCWRK,PRCER) ;Get GENERIC INVENTORY (#445) data
- ;This function retrieves 2237 data elements from
- ;the GENERIC INVENTORY (#445) file and places them
- ;into a ^TMP work global. Data is placed into the work
- ;global in both internal and external format.
- ;
- ; Input:
- ; PRC445R - (required) IEN of record in GENERIC INVENTORY (#445) file
- ; PRCWRK - (required) name of work global containing data elements
- ;
- ; Output:
- ; Function value - 1 on success, 0 on failure
- ; PRCER - (optional) on failure, an error message is returned,
- ; pass by reference
- ; PRCWRK - work global containing the #445 data elements:
- ;
- ; Subscript Field# Data Element
- ; --------- ------ -------------------
- ; INVPT .01 INVENTORY POINT
- ; INVABREV .8 ABBREVIATED NAME
- ;
- N PRCIENS ;iens string for GETS^DIQ
- N PRCFLDS ;results array for GETS^DIQ
- N PRCERR ;error array for GETS^DIQ
- N PRCRSLT ;function result
- ;
- S PRCRSLT=0
- S PRCER="Generic Inventory record not found"
- ;
- I $G(PRC445R)>0,$D(^PRCP(445,PRC445R)) D
- . ;
- . ;retrieve data from (#445) file
- . S PRCIENS=PRC445R_","
- . D GETS^DIQ(445,PRCIENS,"*","IE","PRCFLDS","PRCERR")
- . I $D(PRCERR) S PRCER="Unable to retrieve Generic Inventory record" Q
- . ;
- . ;place (#445) fields into work global
- . S @PRCWRK@("INVPT")=$G(PRCFLDS(445,PRCIENS,.01,"I"))_U_$G(PRCFLDS(445,PRCIENS,.01,"E"))
- . S @PRCWRK@("INVABREV")=$G(PRCFLDS(445,PRCIENS,.8,"I"))_U_$G(PRCFLDS(445,PRCIENS,.8,"E"))
- . ;
- . ;success
- . S PRCRSLT=1 K PRCER
- ;
- Q PRCRSLT
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCHJS03 8446 printed Feb 18, 2025@23:34:38 Page 2
- 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
- +2 ;Per VHA Directive 6402, this routine should not be modified.
- +3 ;
- GET440(PRC440R,PRCWRK,PRCER) ;Get #440 data
- +1 ;This function is used to retrieve specified data
- +2 ;elements from from the VENDOR (#440) file and places
- +3 ;them into ^TMP work global. Data is placed into the
- +4 ;work global in both internal and external format.
- +5 ;
- +6 ; Input:
- +7 ; PRC440R - (required) IEN of record in VENDOR (#440) file
- +8 ; PRCWRK - (required) name of work global containing data elements
- +9 ;
- +10 ; Output:
- +11 ; Function value - 1 on success, 0 on failure
- +12 ; PRCER - (optional) on failure, an error message is returned,
- +13 ; pass by reference
- +14 ; PRCWRK - work global containing the #440 data elements:
- +15 ;
- +16 ; Subscript Field# Data Element
- +17 ; --------- ------ -------------------
- +18 ; VEDI .2 EDI VENDOR?
- +19 ; VID .4 VENDOR ID NUMBER
- +20 ; VACT 5.1 ACCOUNT NO.
- +21 ; VGDV 5.2 GUARANTEED DELIVERY VENDOR
- +22 ; VPAYCON 17 PAYMENT CONTACT PERSON
- +23 ; VPAYPH 17.2 PAYMENT PHONE NO.
- +24 ; VPAYAD1 17.3 PAYMENT ADDRESS1
- +25 ; VPAYAD2 17.4 PAYMENT ADDRESS2
- +26 ; VPAYAD3 17.5 PAYMENT ADDRESS3
- +27 ; VPAYAD4 17.6 PAYMENT ADDRESS4
- +28 ; VPAYCTY 17.7 PAYMENT CITY
- +29 ; VPAYST 17.8 PAYMENT STATE
- +30 ; VPAYZIP 17.9 PAYMENT ZIP CODE
- +31 ; VDUNS 18.3 DUN & BRADSTREET #
- +32 ; VFMSCD 34 FMS VENDOR CODE
- +33 ; VFMSNM 34.5 FMS VENDOR NAME
- +34 ; VALTADD 35 ALT-ADDR-IND
- +35 ; VFAX 46 FAX #
- +36 ; VUEI 55 UEI
- +37 ;
- +38 ;iens string for GETS^DIQ
- NEW PRCIENS
- +39 ;results array for GETS^DIQ
- NEW PRCFLDS
- +40 ;error msg for GETS^DIQ
- NEW PRCERR
- +41 ;function result
- NEW PRCRSLT
- +42 ;
- +43 SET PRCRSLT=0
- +44 SET PRCER="Vendor record not found"
- +45 ;
- +46 IF $GET(PRC440R)>0
- IF $DATA(^PRC(440,PRC440R))
- Begin DoDot:1
- +47 ;
- +48 ;retrieve fields
- +49 SET PRCIENS=PRC440R_","
- +50 DO GETS^DIQ(440,PRCIENS,"*","IE","PRCFLDS","PRCERR")
- +51 IF $DATA(PRCERR)
- SET PRCER="Unable to retrieve Vendor record"
- QUIT
- +52 ;
- +53 ;place top level #440 fields into work global
- +54 SET @PRCWRK@("VEDI")=$GET(PRCFLDS(440,PRCIENS,.2,"I"))_U_$GET(PRCFLDS(440,PRCIENS,.2,"E"))
- +55 SET @PRCWRK@("VID")=$GET(PRCFLDS(440,PRCIENS,.4,"I"))_U_$GET(PRCFLDS(440,PRCIENS,.4,"E"))
- +56 SET @PRCWRK@("VACT")=$GET(PRCFLDS(440,PRCIENS,5.1,"I"))_U_$GET(PRCFLDS(440,PRCIENS,5.1,"E"))
- +57 SET @PRCWRK@("VGDV")=$GET(PRCFLDS(440,PRCIENS,5.2,"I"))_U_$GET(PRCFLDS(440,PRCIENS,5.2,"E"))
- +58 SET @PRCWRK@("VPAYCON")=$GET(PRCFLDS(440,PRCIENS,17,"I"))_U_$GET(PRCFLDS(440,PRCIENS,17,"E"))
- +59 SET @PRCWRK@("VPAYPH")=$GET(PRCFLDS(440,PRCIENS,17.2,"I"))_U_$GET(PRCFLDS(440,PRCIENS,17.2,"E"))
- +60 SET @PRCWRK@("VPAYAD1")=$GET(PRCFLDS(440,PRCIENS,17.3,"I"))_U_$GET(PRCFLDS(440,PRCIENS,17.3,"E"))
- +61 SET @PRCWRK@("VPAYAD2")=$GET(PRCFLDS(440,PRCIENS,17.4,"I"))_U_$GET(PRCFLDS(440,PRCIENS,17.4,"E"))
- +62 SET @PRCWRK@("VPAYAD3")=$GET(PRCFLDS(440,PRCIENS,17.5,"I"))_U_$GET(PRCFLDS(440,PRCIENS,17.5,"E"))
- +63 SET @PRCWRK@("VPAYAD4")=$GET(PRCFLDS(440,PRCIENS,17.6,"I"))_U_$GET(PRCFLDS(440,PRCIENS,17.6,"E"))
- +64 SET @PRCWRK@("VPAYCTY")=$GET(PRCFLDS(440,PRCIENS,17.7,"I"))_U_$GET(PRCFLDS(440,PRCIENS,17.7,"E"))
- +65 SET @PRCWRK@("VPAYST")=$GET(PRCFLDS(440,PRCIENS,17.8,"I"))_U_$GET(PRCFLDS(440,PRCIENS,17.8,"E"))
- +66 SET @PRCWRK@("VPAYZIP")=$GET(PRCFLDS(440,PRCIENS,17.9,"I"))_U_$GET(PRCFLDS(440,PRCIENS,17.9,"E"))
- +67 SET @PRCWRK@("VDUNS")=$GET(PRCFLDS(440,PRCIENS,18.3,"I"))_U_$GET(PRCFLDS(440,PRCIENS,18.3,"E"))
- +68 SET @PRCWRK@("VFMSCD")=$GET(PRCFLDS(440,PRCIENS,34,"I"))_U_$GET(PRCFLDS(440,PRCIENS,34,"E"))
- +69 SET @PRCWRK@("VFMSNM")=$GET(PRCFLDS(440,PRCIENS,34.5,"I"))_U_$GET(PRCFLDS(440,PRCIENS,34.5,"E"))
- +70 SET @PRCWRK@("VALTADD")=$GET(PRCFLDS(440,PRCIENS,35,"I"))_U_$GET(PRCFLDS(440,PRCIENS,35,"E"))
- +71 SET @PRCWRK@("VFAX")=$GET(PRCFLDS(440,PRCIENS,46,"I"))_U_$GET(PRCFLDS(440,PRCIENS,46,"E"))
- +72 SET @PRCWRK@("VUEI")=$GET(PRCFLDS(440,PRCIENS,55,"I"))_U_$GET(PRCFLDS(440,PRCIENS,55,"E"))
- +73 ;
- +74 ;success
- +75 SET PRCRSLT=1
- KILL PRCER
- End DoDot:1
- +76 ;
- +77 QUIT PRCRSLT
- +78 ;
- +79 ;
- GET443(PRCTRAN,PRCWRK,PRCER) ;Get #443 data
- +1 ;This function is used to retrieve specified data
- +2 ;elements from the REQUEST WORKSHEET (#443) file for
- +3 ;a 2237 Transaction Number and places them into a
- +4 ;^TMP work global. It also obtains the Title of the
- +5 ;Accountable Officer from the NEW PERSON (#200) file.
- +6 ;Data is placed into the work global in both internal
- +7 ;and external format.
- +8 ;
- +9 ; Supported ICR:
- +10 ; #4329: Allows retrieval of TITLE (#8) field from NEW PERSON (#200)
- +11 ; file using FM read.
- +12 ;
- +13 ; Input:
- +14 ; PRCTRAN - (required) 2237 Transaction Number
- +15 ; PRCWRK - (required) name of work global containing data elements
- +16 ;
- +17 ; Output:
- +18 ; Function value - 1 on success, 0 on failure
- +19 ; PRCER - (optional) on failure, an error message is returned,
- +20 ; pass by ref
- +21 ; PRCWRK - work global containing the #443 & #200 data elements:
- +22 ;
- +23 ; Subscript File,Field# Data Element
- +24 ; --------- ----------- -------------------
- +25 ; AO 443,2 ACCOUNTABLE OFFICER
- +26 ; AOESIG 443,4 ESIG DATE/TIME
- +27 ; EXPEND 443,13 EXPENDABLE/NONEXPENDABLE
- +28 ; AOTITLE 200,8 TITLE
- +29 ;
- +30 ;iens string for GETS^DIQ
- NEW PRCIENS
- +31 ;results array for GETS^DIQ
- NEW PRCFLDS
- +32 ;FM error array
- NEW PRCERR
- +33 ;ien of record in #443 file
- NEW PRCREC
- +34 ;function result
- NEW PRCRSLT
- +35 ;
- +36 SET PRCRSLT=0
- +37 SET PRCER="Request Worksheet record not found"
- +38 ;
- +39 ; drops out of DO block on failure
- +40 IF $GET(PRCTRAN)]""
- Begin DoDot:1
- +41 ;
- +42 ;lookup 2237 Transaction Number
- +43 SET PRCREC=$$FIND1^DIC(443,"","X",$GET(PRCTRAN),"","","PRCERR")
- +44 if ('PRCREC)!($DATA(PRCERR))
- QUIT
- +45 ;
- +46 ;retrieve #443 fields
- +47 SET PRCIENS=+$GET(PRCREC)_","
- +48 DO GETS^DIQ(443,PRCIENS,"2;4;13","IE","PRCFLDS","PRCERR")
- +49 IF $DATA(PRCERR)
- SET PRCER="Unable to retrieve Request Worksheet record"
- QUIT
- +50 ;
- +51 ;place #443 fields into work global
- +52 SET @PRCWRK@("AO")=$GET(PRCFLDS(443,PRCIENS,2,"I"))_U_$GET(PRCFLDS(443,PRCIENS,2,"E"))
- +53 SET @PRCWRK@("AOESIG")=$GET(PRCFLDS(443,PRCIENS,4,"I"))_U_$GET(PRCFLDS(443,PRCIENS,4,"E"))
- +54 SET @PRCWRK@("EXPEND")=$GET(PRCFLDS(443,PRCIENS,13,"I"))_U_$GET(PRCFLDS(443,PRCIENS,13,"E"))
- +55 ;
- +56 ;retrieve Accountable Officer (Title)
- +57 ;ptr to #200 file
- SET PRCIENS=+$GET(@PRCWRK@("AO"))_","
- +58 IF +$GET(PRCIENS)
- DO GETS^DIQ(200,PRCIENS,"8","IE","PRCFLDS","PRCERR")
- +59 IF $DATA(PRCERR)
- SET PRCER="Unable to retrieve Accountable Officer (Title)"
- QUIT
- +60 SET @PRCWRK@("AOTITLE")=$GET(PRCFLDS(200,PRCIENS,8,"I"))_U_$GET(PRCFLDS(200,PRCIENS,8,"E"))
- +61 ;
- +62 ;success
- +63 SET PRCRSLT=1
- KILL PRCER
- End DoDot:1
- +64 ;
- +65 QUIT PRCRSLT
- +66 ;
- +67 ;
- GET445(PRC445R,PRCWRK,PRCER) ;Get GENERIC INVENTORY (#445) data
- +1 ;This function retrieves 2237 data elements from
- +2 ;the GENERIC INVENTORY (#445) file and places them
- +3 ;into a ^TMP work global. Data is placed into the work
- +4 ;global in both internal and external format.
- +5 ;
- +6 ; Input:
- +7 ; PRC445R - (required) IEN of record in GENERIC INVENTORY (#445) file
- +8 ; PRCWRK - (required) name of work global containing data elements
- +9 ;
- +10 ; Output:
- +11 ; Function value - 1 on success, 0 on failure
- +12 ; PRCER - (optional) on failure, an error message is returned,
- +13 ; pass by reference
- +14 ; PRCWRK - work global containing the #445 data elements:
- +15 ;
- +16 ; Subscript Field# Data Element
- +17 ; --------- ------ -------------------
- +18 ; INVPT .01 INVENTORY POINT
- +19 ; INVABREV .8 ABBREVIATED NAME
- +20 ;
- +21 ;iens string for GETS^DIQ
- NEW PRCIENS
- +22 ;results array for GETS^DIQ
- NEW PRCFLDS
- +23 ;error array for GETS^DIQ
- NEW PRCERR
- +24 ;function result
- NEW PRCRSLT
- +25 ;
- +26 SET PRCRSLT=0
- +27 SET PRCER="Generic Inventory record not found"
- +28 ;
- +29 IF $GET(PRC445R)>0
- IF $DATA(^PRCP(445,PRC445R))
- Begin DoDot:1
- +30 ;
- +31 ;retrieve data from (#445) file
- +32 SET PRCIENS=PRC445R_","
- +33 DO GETS^DIQ(445,PRCIENS,"*","IE","PRCFLDS","PRCERR")
- +34 IF $DATA(PRCERR)
- SET PRCER="Unable to retrieve Generic Inventory record"
- QUIT
- +35 ;
- +36 ;place (#445) fields into work global
- +37 SET @PRCWRK@("INVPT")=$GET(PRCFLDS(445,PRCIENS,.01,"I"))_U_$GET(PRCFLDS(445,PRCIENS,.01,"E"))
- +38 SET @PRCWRK@("INVABREV")=$GET(PRCFLDS(445,PRCIENS,.8,"I"))_U_$GET(PRCFLDS(445,PRCIENS,.8,"E"))
- +39 ;
- +40 ;success
- +41 SET PRCRSLT=1
- KILL PRCER
- End DoDot:1
- +42 ;
- +43 QUIT PRCRSLT