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

ACRFSCHK.m

Go to the documentation of this file.
  1. ACRFSCHK ;IHS/OIRM/DSD/THL,AEF - CHECK FOR PREVIOUS APPROVALS WHEN DATA IS CHANGED; [ 11/01/2001 9:44 AM ]
  1. ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
  1. ;;ROUTINE TO CHECK FOR PREVIOUS APPROVALS TO A DOCUMENT AND
  1. ;;RESUBMIT FOR APPROVAL IF DATA IS CHANGED
  1. EN I $D(^TMP("ACRSS",$J)) D EN1:$D(^ACRAPVS("AB",ACRDOCDA))
  1. EXIT K ACR,ACRSSDA,ACRX,^TMP("ACRSS",$J)
  1. Q
  1. EN1 ;CHECK IF DOCUMENT HAS PREVIOUSLY BEEN APPROVED
  1. K ACRSCHK
  1. D APCHK
  1. Q:'$D(ACRSCHK)
  1. ;COMPARE DATA WITH CURRENT DATA
  1. K ACRSCHK
  1. S ACRSSDA=0
  1. F S ACRSSDA=$O(^ACRSS(ACRXREF,ACRDOCDA,ACRSSDA)) Q:'ACRSSDA!$D(ACRSCHK) D
  1. .F ACRX=0,"APV","DESC","DT","NMS","NOTES","TRAV","VND","VND1" Q:$D(ACRSCHK) D
  1. ..I $D(^TMP("ACRSS",$J,ACRSSDA,ACRX))#2,^TMP("ACRSS",$J,ACRSSDA,ACRX)'=$G(^ACRSS(ACRSSDA,ACRX)) S ACRSCHK=""
  1. APPROVE ;EP;RESUBMIT DOCUMENT FOR APPROVAL
  1. Q:'$D(ACRSCHK)
  1. Q:'$D(^ACRAPVS("AB",+$G(ACRDOCDA)))
  1. W *7,*7
  1. W !!,"DOCUMENT RESUBMITTED FOR APPROVAL DUE TO CHANGES MADE."
  1. D ^ACRFAPVS
  1. D PAUSE^ACRFWARN
  1. Q
  1. APCHK ;EP;TO CHECK APPROVALS FOR 'APPROVED' STATUS
  1. N X
  1. S X=0
  1. F S X=$O(^ACRAPVS("AB",ACRDOCDA,X)) Q:'X!$D(ACRSCHK) D
  1. .I $E($G(^ACRAPVS(X,"DT")))="A",$P(^ACRDOC(ACRDOCDA,0),U,13)=$P($G(^ACRAPVS(X,0)),U,6) S ACRSCHK=""
  1. Q