ACRFSCHK.m

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