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

PRCHJUTL.m

Go to the documentation of this file.
  1. PRCHJUTL ;OI&T/LKG,KCL-UTILITY FUNCTIONS IFCAP/ECMS INTERFACE ;5/10/13 15:46
  1. ;;5.1;IFCAP;**167,174**;Oct 20, 2000;Build 23
  1. ;Per VHA Directive 2004-38, this routine should not be modified.
  1. ;
  1. ;
  1. ECMS2237(PRCHJDA) ;Checks 2237 to see if processed in eCMS - Returns 1 if
  1. ;processed in eCMS and 0 if not. Check on basis of whether the ECMS
  1. ;ACTIONUID field is populated.
  1. N X S X=($P($G(^PRCS(410,PRCHJDA,1)),U,8)'="")
  1. Q X
  1. ;
  1. UPD443(PRC443R,PRCERR) ;Update file #443 record
  1. ;This function is used to update the following fields in
  1. ;a REQUEST WORKSHEET (#443) record:
  1. ;
  1. ; Field Name Field #
  1. ; ------------------- -------
  1. ; CURRENT STATUS 1.5
  1. ; ACCOUNTABLE OFFICER 2
  1. ; VALIDATION CODE 3
  1. ; ESIG DATE/TIME 4
  1. ;
  1. ; Input:
  1. ; PRC443R - (required) IEN of record in REQUEST WORKSHEET (#443) file
  1. ;
  1. ; Output:
  1. ; Function Value - returns 1 on success, 0 on failure
  1. ; PRCERR - (optional) on failure, an error message is returned,
  1. ; pass by ref
  1. ;
  1. N PRCRSLT ;function result
  1. N PRCIENS ;iens string for FM data array
  1. N PRCFDA ;FM data array
  1. ;
  1. S PRC443R=+$G(PRC443R)
  1. S PRCRSLT=0
  1. S PRCERR="Invalid input parameter"
  1. ;
  1. I PRC443R>0 D
  1. . K PRCERR
  1. . S PRCIENS=PRC443R_","
  1. . S PRCFDA(443,PRCIENS,1.5)=60 ;Pending Accountable Officer Sig.
  1. . S PRCFDA(443,PRCIENS,2)="@" ;delete
  1. . S PRCFDA(443,PRCIENS,3)="@" ;delete
  1. . S PRCFDA(443,PRCIENS,4)="@" ;delete
  1. . D FILE^DIE("K","PRCFDA","PRCERR")
  1. . ;quit if filing error
  1. . I $D(PRCERR) S PRCERR=$G(PRCERR("DIERR","1","TEXT",1)) Q
  1. . ;
  1. . ;success
  1. . S PRCRSLT=1
  1. ;
  1. Q PRCRSLT
  1. ;
  1. ;
  1. UPD410(PRC410R,PRCERR) ;Update file #410 record
  1. ;This function is used to update the following fields in
  1. ;a CONTROL POINT ACTIVITY (#410) record:
  1. ;
  1. ; Field Name Field #
  1. ; ------------------- -------
  1. ; ACCOUNTABLE OFFICER 39
  1. ; AO SIGNATURE DATE 69
  1. ;
  1. ; Input:
  1. ; PRC410R - (required) IEN of record in CONTROL POINT ACTIVITY (#410) file
  1. ;
  1. ; Output:
  1. ; Function Value - returns 1 on success, 0 on failure
  1. ; PRCERR - (optional) on failure, an error message is returned,
  1. ; pass by ref
  1. ;
  1. N PRCRSLT ;function result
  1. N PRCIENS ;iens string for FM data array
  1. N PRCFDA ;FM data array
  1. ;
  1. S PRC410R=+$G(PRC410R)
  1. S PRCRSLT=0
  1. S PRCERR="Invalid input parameter"
  1. ;
  1. I PRC410R>0 D
  1. . K PRCERR
  1. . S PRCIENS=PRC410R_","
  1. . S PRCFDA(410,PRCIENS,39)="@" ;delete
  1. . S PRCFDA(410,PRCIENS,69)="@" ;delete
  1. . D FILE^DIE("K","PRCFDA","PRCERR")
  1. . ;quit if filing error
  1. . I $D(PRCERR) S PRCERR=$G(PRCERR("DIERR","1","TEXT",1)) Q
  1. . ;
  1. . ;success
  1. . S PRCRSLT=1
  1. ;
  1. Q PRCRSLT
  1. ;
  1. ;
  1. ITDES(PRC410R,PRCITIEN) ;Check single line item for a description
  1. ;This function checks a single line item on a 2237 to make sure it has a description.
  1. ;
  1. ; Input:
  1. ; PRC410R - (required) IEN of record in CONTROL POINT ACTIVITY (#410) file
  1. ; PRCITIEN - (required) IEN of record in ITEM (#410.02) sub-file
  1. ;
  1. ; Output:
  1. ; Function value - 1 on success, 0 on failure (no line item description)
  1. ;
  1. N PRCIENS ;iens string for GET1^DIQ
  1. N PRCDESC ;word processing field target array
  1. N PRCRSLT ;function result
  1. ;
  1. ;
  1. S PRC410R=+$G(PRC410R)
  1. S PRCITIEN=+$G(PRCITIEN)
  1. S PRCRSLT=1
  1. ;
  1. ;failure if 2237 record not found in #410 file
  1. I (PRC410R'>0)!('$D(^PRCS(410,PRC410R))) S PRCRSLT=0
  1. ;
  1. ;failure if record not found in ITEM (#410.02) sub-file
  1. I (PRCITIEN'>0)!('$D(^PRCS(410,PRC410R,"IT",PRCITIEN,0))) S PRCRSLT=0
  1. ;
  1. I PRCRSLT D ;drop out of DO block on failure
  1. . ;
  1. . ;attempt to retrieve the contents of word processing Item
  1. . ;Description field and store text in the target array
  1. . K PRCDESC
  1. . S PRCIENS=PRCITIEN_","_PRC410R_","
  1. . S PRCDESC=$$GET1^DIQ(410.02,PRCIENS,1,"Z","PRCDESC")
  1. . ;if no data exists, quit and function result=failure
  1. . I PRCDESC="" S PRCRSLT=0 Q
  1. . ;
  1. . ;strip WP nodes of spaces and tabs; if node still contains data then ok
  1. . N PRCWP,PRCNODE,PRCOK
  1. . S (PRCWP,PRCOK)=0
  1. . F S PRCWP=$O(PRCDESC(PRCWP)) Q:'PRCWP!(PRCOK) D
  1. . . S PRCNODE=$G(PRCDESC(PRCWP,0))
  1. . . S PRCNODE=$TR(PRCNODE," ","") ;strip spaces
  1. . . S PRCNODE=$TR(PRCNODE,$C(9),"") ;strip tabs
  1. . . ;ok, data in the WP node
  1. . . I $L(PRCNODE)>0 S PRCOK=1
  1. . I 'PRCOK S PRCRSLT=0
  1. ;
  1. Q PRCRSLT
  1. ;
  1. ;
  1. ITDESALL(PRC410R,PRCERR) ;Check all line items for description
  1. ;This function checks all line items on a document to make sure they have a description.
  1. ;
  1. ; Input:
  1. ; PRC410R - (required) IEN of record in CONTROL POINT ACTIVITY (#410) file
  1. ;
  1. ; Output:
  1. ; Function value - 1 on success, 0 on failure (one or more line items don't have description)
  1. ; PRCERR - (optional) on failure, an error message array is returned, pass by ref
  1. ; Array format:
  1. ; PRCERR(1)="Line Item #3 Description is missing."
  1. ; PRCERR(2)="Line Item #5 Description is missing."
  1. ; PRCERR(3), etc.
  1. ;
  1. N PRCLINE ;line items
  1. N PRCITIEN ;line item IEN
  1. N PRCLNUM ;Line Item Number
  1. N PRCIDX ;error array subscript
  1. N PRCRSLT ;function result
  1. ;
  1. S PRC410R=+$G(PRC410R)
  1. S PRCRSLT=1
  1. ;
  1. ;quit if 2237 record not found in #410 file
  1. I (PRC410R'>0)!('$D(^PRCS(410,PRC410R))) D Q PRCRSLT
  1. . S PRCRSLT=0
  1. . S PRCERR(1)="Control Point Activity record not found."
  1. ;
  1. S (PRCLINE,PRCITIEN,PRCIDX)=0
  1. ;loop thru "B" index of ITEM multiple
  1. F S PRCLINE=+$O(^PRCS(410,PRC410R,"IT","B",PRCLINE)) Q:'PRCLINE D
  1. . ;
  1. . ;get IEN of record in ITEM (#410.02) sub-file
  1. . S PRCITIEN=0
  1. . S PRCITIEN=+$O(^PRCS(410,PRC410R,"IT","B",$G(PRCLINE),PRCITIEN))
  1. . I 'PRCITIEN D Q
  1. . . S PRCRSLT=0
  1. . . S PRCIDX=PRCIDX+1
  1. . . S PRCERR(PRCIDX)="Item not found in Control Point Activity record."
  1. . ;
  1. . ;does line item have a description?
  1. . I '$$ITDES(PRC410R,$G(PRCITIEN)) D
  1. . . S PRCRSLT=0
  1. . . S PRCLNUM=""
  1. . . S PRCLNUM=$P($G(^PRCS(410,PRC410R,"IT",$G(PRCITIEN),0)),U,1)
  1. . . S PRCIDX=PRCIDX+1
  1. . . S PRCERR(PRCIDX)="Line Item #"_$G(PRCLNUM)_" Description is missing."
  1. ;
  1. Q PRCRSLT
  1. ;
  1. ;
  1. REQCHECK(PRC410R,PRCWARN,PRCQUIET) ;2237 required field checks
  1. ;This function is used to check a document and determine if the following fields
  1. ;are populated:
  1. ; - Requesting Service
  1. ; - Description field for all line items
  1. ;
  1. ; Input:
  1. ; PRC410R - (required) IEN of record in CONTROL POINT ACTIVITY (#410) file
  1. ; PRCQUIET - (optional) 0=silent call, 1=output warning msgs
  1. ;
  1. ; Output:
  1. ; Function value - 1 on success, 0 on failure-field(s) not populated
  1. ; PRCWARN - (optional) on failure, an warning msg array is returned, pass by ref
  1. ; Array format:
  1. ; PRCWARN(1)="Requesting Service is missing."
  1. ; PRCWARN(2)="Line Item #3 Description is missing."
  1. ; PRCWARN(3), etc.
  1. ;
  1. N PRCRSLT ;function result
  1. N PRCERR ;error msg array returned by $$ITDESALL^PRCHJUTL
  1. N PRCI ;error msg array index
  1. N PRCIDX ;warning msg array index
  1. ;
  1. S PRC410R=+$G(PRC410R)
  1. S PRCIDX=0
  1. S PRCRSLT=1
  1. ;
  1. ;check for Requesting Service
  1. I $$GET1^DIQ(410,PRC410R,6.3)']"" D
  1. . S PRCRSLT=0
  1. . S PRCIDX=PRCIDX+1
  1. . S PRCWARN(PRCIDX)="Requesting Service is missing."
  1. ;
  1. ;check all line items for missing description
  1. I '$$ITDESALL^PRCHJUTL(PRC410R,.PRCERR) D
  1. . S PRCRSLT=0
  1. . S PRCI=0
  1. . F S PRCI=$O(PRCERR(PRCI)) Q:'PRCI D
  1. . . S PRCIDX=PRCIDX+1
  1. . . S PRCWARN(PRCIDX)=$G(PRCERR(PRCI))
  1. ;
  1. ;on failure and not silent, output warning
  1. I 'PRCRSLT,$G(PRCQUIET) D
  1. . W !!,"WARNING - Transaction "_$$GET1^DIQ(410,PRC410R,.01)_" is missing required data!",*7
  1. . S PRCIDX=0
  1. . F S PRCIDX=$O(PRCWARN(PRCIDX)) Q:'PRCIDX D
  1. . . W !?2,">>> "_$G(PRCWARN(PRCIDX))
  1. . W !,"The request needs to be edited prior to approval.",!
  1. ;
  1. Q PRCRSLT