- ACRFSCHK ;IHS/OIRM/DSD/THL,AEF - CHECK FOR PREVIOUS APPROVALS WHEN DATA IS CHANGED; [ 11/01/2001 9:44 AM ]
- ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
- ;;ROUTINE TO CHECK FOR PREVIOUS APPROVALS TO A DOCUMENT AND
- ;;RESUBMIT FOR APPROVAL IF DATA IS CHANGED
- EN I $D(^TMP("ACRSS",$J)) D EN1:$D(^ACRAPVS("AB",ACRDOCDA))
- EXIT K ACR,ACRSSDA,ACRX,^TMP("ACRSS",$J)
- Q
- EN1 ;CHECK IF DOCUMENT HAS PREVIOUSLY BEEN APPROVED
- K ACRSCHK
- D APCHK
- Q:'$D(ACRSCHK)
- ;COMPARE DATA WITH CURRENT DATA
- K ACRSCHK
- S ACRSSDA=0
- F S ACRSSDA=$O(^ACRSS(ACRXREF,ACRDOCDA,ACRSSDA)) Q:'ACRSSDA!$D(ACRSCHK) D
- .F ACRX=0,"APV","DESC","DT","NMS","NOTES","TRAV","VND","VND1" Q:$D(ACRSCHK) D
- ..I $D(^TMP("ACRSS",$J,ACRSSDA,ACRX))#2,^TMP("ACRSS",$J,ACRSSDA,ACRX)'=$G(^ACRSS(ACRSSDA,ACRX)) S ACRSCHK=""
- APPROVE ;EP;RESUBMIT DOCUMENT FOR APPROVAL
- Q:'$D(ACRSCHK)
- Q:'$D(^ACRAPVS("AB",+$G(ACRDOCDA)))
- W *7,*7
- W !!,"DOCUMENT RESUBMITTED FOR APPROVAL DUE TO CHANGES MADE."
- D ^ACRFAPVS
- D PAUSE^ACRFWARN
- Q
- APCHK ;EP;TO CHECK APPROVALS FOR 'APPROVED' STATUS
- N X
- S X=0
- F S X=$O(^ACRAPVS("AB",ACRDOCDA,X)) Q:'X!$D(ACRSCHK) D
- .I $E($G(^ACRAPVS(X,"DT")))="A",$P(^ACRDOC(ACRDOCDA,0),U,13)=$P($G(^ACRAPVS(X,0)),U,6) S ACRSCHK=""
- Q
- 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
- +2 ;;ROUTINE TO CHECK FOR PREVIOUS APPROVALS TO A DOCUMENT AND
- +3 ;;RESUBMIT FOR APPROVAL IF DATA IS CHANGED
- EN IF $DATA(^TMP("ACRSS",$JOB))
- IF $DATA(^ACRAPVS("AB",ACRDOCDA))
- DO EN1
- EXIT KILL ACR,ACRSSDA,ACRX,^TMP("ACRSS",$JOB)
- +1 QUIT
- EN1 ;CHECK IF DOCUMENT HAS PREVIOUSLY BEEN APPROVED
- +1 KILL ACRSCHK
- +2 DO APCHK
- +3 IF '$DATA(ACRSCHK)
- QUIT
- +4 ;COMPARE DATA WITH CURRENT DATA
- +5 KILL ACRSCHK
- +6 SET ACRSSDA=0
- +7 FOR
- SET ACRSSDA=$ORDER(^ACRSS(ACRXREF,ACRDOCDA,ACRSSDA))
- IF 'ACRSSDA!$DATA(ACRSCHK)
- QUIT
- Begin DoDot:1
- +8 FOR ACRX=0,"APV","DESC","DT","NMS","NOTES","TRAV","VND","VND1"
- IF $DATA(ACRSCHK)
- QUIT
- Begin DoDot:2
- +9 IF $DATA(^TMP("ACRSS",$JOB,ACRSSDA,ACRX))#2
- IF ^TMP("ACRSS",$JOB,ACRSSDA,ACRX)'=$GET(^ACRSS(ACRSSDA,ACRX))
- SET ACRSCHK=""
- End DoDot:2
- End DoDot:1
- APPROVE ;EP;RESUBMIT DOCUMENT FOR APPROVAL
- +1 IF '$DATA(ACRSCHK)
- QUIT
- +2 IF '$DATA(^ACRAPVS("AB",+$GET(ACRDOCDA)))
- QUIT
- +3 WRITE *7,*7
- +4 WRITE !!,"DOCUMENT RESUBMITTED FOR APPROVAL DUE TO CHANGES MADE."
- +5 DO ^ACRFAPVS
- +6 DO PAUSE^ACRFWARN
- +7 QUIT
- APCHK ;EP;TO CHECK APPROVALS FOR 'APPROVED' STATUS
- +1 NEW X
- +2 SET X=0
- +3 FOR
- SET X=$ORDER(^ACRAPVS("AB",ACRDOCDA,X))
- IF 'X!$DATA(ACRSCHK)
- QUIT
- Begin DoDot:1
- +4 IF $EXTRACT($GET(^ACRAPVS(X,"DT")))="A"
- IF $PIECE(^ACRDOC(ACRDOCDA,0),U,13)=$PIECE($GET(^ACRAPVS(X,0)),U,6)
- SET ACRSCHK=""
- End DoDot:1
- +5 QUIT