Routine: ACRFDISA

ACRFDISA ;IHS/OIRM/DSD/THL,AEF - DISPLAY DISAPPROVALS AND APPROVAL COMMENTS; [ 09/23/2005   9:44 AM ]

 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**19**;NOV 05, 2001

 ;;ROUTINE USED TO DISPLAY DISAPPROVALS AND APPROVAL COMMENTS

EN D EN1

EXIT K ACRINDVA,ACRINAM,ACRIANAM,ACRNO

EN1 K ACRQUIT

 N ACRAPDA,ACRYES

 S (ACRAPDA,ACRYES)=0

 F  S ACRAPDA=$O(^ACRAPVS("AB",ACRDOCDA,ACRAPDA)) Q:'ACRAPDA  D

 . Q:'$D(^ACRAPVS(ACRAPDA,0))

 . Q:'$D(^ACRAPVS(ACRAPDA,"DT"))

 . Q:$G(^ACRAPVS(ACRAPDA,"RSN"))']""!($G(^ACRAPVS(ACRAPDA,"CNG"))']"")!($G(^ACRAPVS(ACRAPDA,"RESP"))']"")!($P(^ACRAPVS(ACRAPDA,"DT"),U)'="D")!'$D(^ACRAPVS(ACRAPDA,1,0))

 . S ACRYES=1

 I $G(ACRYES) D YES

 I $D(ACRQUIT)!$D(ACROUT) K ACRQUIT Q

 N ACRRSN,ACRCNG,ACRRESP,ACRX,ACRI,ACRINDV,ACRDATE

 S ACRAPDA=0

 F  S ACRAPDA=$O(^ACRAPVS("AB",ACRDOCDA,ACRAPDA)) Q:'ACRAPDA  D

 . Q:'$D(^ACRAPVS(ACRAPDA,0))

 . Q:'$D(^ACRAPVS(ACRAPDA,"DT"))

 . Q:$G(^ACRAPVS(ACRAPDA,"RSN"))']""!($G(^ACRAPVS(ACRAPDA,"CNG"))']"")!($G(^ACRAPVS(ACRAPDA,"RESP"))']"")!($P(^ACRAPVS(ACRAPDA,"DT"),U)'="D")!'$D(^ACRAPVS(ACRAPDA,1,0))

 . D APDA

 S ACRRSN=$G(^ACROBL(ACRDOCDA,"RSN"))

 S ACRCNG=$G(^ACROBL(ACRDOCDA,"CNG"))

 S ACRRESP=$G(^ACROBL(ACRDOCDA,"RESP"))

 I ACRRSN]""!(ACRCNG]"")!(ACRRESP]"") D

 .S ACRZ=$G(ACRZ)+1,ACR0=""

 .D MESS

YES S DIR(0)="YOA"

 S DIR("A")="Review APPROVAL COMMENTS or reason for DISAPPROVAL: "

 S DIR("B")="NO"

W !

 D DIR^ACRFDIC

 I Y'=1 S ACRQUIT=""

APDA ;EP;TO DISPLAY REMARKS FOR SELECTED APPROVAL

 W @IOF

 W !!?10,"COMMENTS REGARDING THIS APPROVAL"

 W !?10,"--------------------------------"

 S ACRRSN=$G(^ACRAPVS(ACRAPDA,"RSN"))

 S ACRCNG=$G(^ACRAPVS(ACRAPDA,"CNG"))

 S ACRRESP=$G(^ACRAPVS(ACRAPDA,"RESP"))

 S ACRNO=$G(^ACRAPVS(ACRAPDA,"DT"))

 S ACRDATE=$P(ACRNO,U,4)

 S ACRINDV=$P(ACRNO,U,2)

 S ACRINDVA=$P(ACRNO,U,6)

 S:ACRRSN="" ACRRSN=$G(^ACROBL(ACRDOCDA,"RSN"))

 S:ACRCNG="" ACRCNG=$G(^ACROBL(ACRDOCDA,"CNG"))

 S:ACRRESP="" ACRRESP=$G(^ACROBL(ACRDOCDA,"RESP"))

 ;I ACRINDVA,ACRINDVA'=ACRINDV S ACRIANAM=$P($P($P(^VA(200,ACRINDVA,0),U),",",2)," ")_" "_$P($P(^(0),U),",")  ;ACR*2.1*19.02 IM16848

 ;S ACRINAM=$P($P($P(^VA(200,ACRINDV,0),U),",",2)," ")_" "_$P($P(^(0),U),",")  ;ACR*2.1*19.02 IM16848

 I ACRINDVA,ACRINDVA'=ACRINDV S ACRIANAM=$$NAME3^ACRFUTL1(ACRINDVA)   ;ACR*2.1*19.02 IM16848

 S ACRINAM=$$NAME3^ACRFUTL1(ACRINDV)  ;ACR*2.1*19.02 IM16848

 S ACRNO=$P(ACRNO,U)

 W !?10

 I ACRNO="D" W $S($P(^ACRAPVS(ACRAPDA,0),U,11):"TRAVEL ADVANCE ",1:"")_"DISAPPROVED BY "

 E  W "SIGNED/REVIEWED BY: "

 I $D(ACRIANAM) W ACRIANAM," FOR "

 W ACRINAM

 I ACRNO="D" D

 .W " ON "

 .S Y=ACRDATE

 .X ^DD("DD")

 .W Y

W !

 S (ACRI,ACRZ)=0

 F  S ACRZ=$O(^ACRAPVS(ACRAPDA,1,ACRZ)) Q:'ACRZ  D

 .S ACR0=$G(^ACRAPVS(ACRAPDA,1,ACRZ,0))

 .S:$G(^ACRAPVS(ACRAPDA,1,ACRZ,"CNG"))]"" ACRCNG=^("CNG")

 .S:$G(^ACRAPVS(ACRAPDA,1,ACRZ,"RSN"))]"" ACRRSN=^("RSN")

 .S ACRRESP=$G(^ACRAPVS(ACRAPDA,1,ACRZ,"RESP"))

 .D:ACRCNG]""!(ACRRSN]"")!(ACRRESP]"") MESS

 I '$D(^ACRAPVS(ACRAPDA,1)),ACRCNG]""!(ACRRSN]"")!(ACRRESP]"") D

 .S ACR0=$P(^ACRAPVS(ACRAPDA,"DT"),U,3)_U_$S($P(^("DT"),U,6):$P(^("DT"),U,6),1:$P(^("DT"),U,2))

 .D MESS

 S ACRZ=ACRI

MESS ;EP;TO PRINT MESSAGE

 S Y=$P(ACR0,U)

 X ^DD("DD")

 W !!?4,"MESSAGE NO.: ",ACRZ

 W !?4,"DATE: ",Y

 ;W:$P(ACR0,U,2) ?40,"FROM: ",$P(^VA(200,$P(ACR0,U,2),0),U)  ;ACR*2.1*19.02 IM16848

 W:$P(ACR0,U,2) ?40,"FROM: ",$$NAME2^ACRFUTL1($P(ACR0,U,2))  ;ACR*2.1*19.02 IM16848

 W !?10,"----------"

 W ?46,"------------------------------"

 F ACRX="ACRCNG","ACRRSN" D

 .F ACRI=1:1:5 W:$P(@ACRX,U,ACRI)]"" !?10,$P(@ACRX,U,ACRI)

 I ACRRESP]"" D

 .S Y=$P(ACR0,U,4)

 .X ^DD("DD")

 .W !!?4,"RESPONSE"

 .W !?4,"DATE: ",Y

 .;W:$P(ACR0,U,3) ?40,"FROM: ",$P(^VA(200,$P(ACR0,U,3),0),U)  ;ACR*2.1*19.02 IM16848

 .W:$P(ACR0,U,3) ?40,"FROM: ",$$NAME2^ACRFUTL1($P(ACR0,U,3))  ;ACR*2.1*19.02 IM16848

 .W !?10,"-------------------------------------------"

 .F ACRI=1:1:5 W:$P(ACRRESP,U,ACRI)]"" !?10,$P(ACRRESP,U,ACRI)

 D PAUSE^ACRFWARN

 S ACRI=ACRZ

ACRFDISA  ;IHS/OIRM/DSD/THL,AEF - DISPLAY DISAPPROVALS AND APPROVAL COMMENTS; [ 09/23/2005   9:44 AM ]

 +1       ;;2.1;ADMIN RESOURCE MGT SYSTEM;**19**;NOV 05, 2001

 +2       ;;ROUTINE USED TO DISPLAY DISAPPROVALS AND APPROVAL COMMENTS

EN         DO EN1

EXIT       KILL ACRINDVA,ACRINAM,ACRIANAM,ACRNO

 +1        QUIT

EN1        KILL ACRQUIT

 +1        NEW ACRAPDA,ACRYES

 +2        SET (ACRAPDA,ACRYES)=0

 +3        FOR

               SET ACRAPDA=$ORDER(^ACRAPVS("AB",ACRDOCDA,ACRAPDA))

               IF 'ACRAPDA

                   QUIT

               Begin DoDot:1

 +4                IF '$DATA(^ACRAPVS(ACRAPDA,0))

                       QUIT

 +5                IF '$DATA(^ACRAPVS(ACRAPDA,"DT"))

                       QUIT

 +6                IF $GET(^ACRAPVS(ACRAPDA,"RSN"))']""!($GET(^ACRAPVS(ACRAPDA,"CNG"))']"")!($GET(^ACRAPVS(ACRAPDA,"RESP"))']"")!($PIECE(^ACRAPVS(ACRAPDA,"DT"),U)'="D")!'$DATA(^ACRAPVS(ACRAPDA,1,0))

                       QUIT

 +7                SET ACRYES=1

               End DoDot:1

 +8        IF $GET(ACRYES)

               DO YES

 +9        IF $DATA(ACRQUIT)!$DATA(ACROUT)

               KILL ACRQUIT

               QUIT

 +10       NEW ACRRSN,ACRCNG,ACRRESP,ACRX,ACRI,ACRINDV,ACRDATE

 +11       SET ACRAPDA=0

 +12       FOR

               SET ACRAPDA=$ORDER(^ACRAPVS("AB",ACRDOCDA,ACRAPDA))

               IF 'ACRAPDA

                   QUIT

               Begin DoDot:1

 +13               IF '$DATA(^ACRAPVS(ACRAPDA,0))

                       QUIT

 +14               IF '$DATA(^ACRAPVS(ACRAPDA,"DT"))

                       QUIT

 +15               IF $GET(^ACRAPVS(ACRAPDA,"RSN"))']""!($GET(^ACRAPVS(ACRAPDA,"CNG"))']"")!($GET(^ACRAPVS(ACRAPDA,"RESP"))']"")!($PIECE(^ACRAPVS(ACRAPDA,"DT"),U)'="D")!'$DATA(^ACRAPVS(ACRAPDA,1,0))

                       QUIT

 +16               DO APDA

               End DoDot:1

 +17       SET ACRRSN=$GET(^ACROBL(ACRDOCDA,"RSN"))

 +18       SET ACRCNG=$GET(^ACROBL(ACRDOCDA,"CNG"))

 +19       SET ACRRESP=$GET(^ACROBL(ACRDOCDA,"RESP"))

 +20       IF ACRRSN]""!(ACRCNG]"")!(ACRRESP]"")

               Begin DoDot:1

 +21               SET ACRZ=$GET(ACRZ)+1

                   SET ACR0=""

 +22               DO MESS

               End DoDot:1

 +23       QUIT

YES        SET DIR(0)="YOA"

 +1        SET DIR("A")="Review APPROVAL COMMENTS or reason for DISAPPROVAL: "

 +2        SET DIR("B")="NO"

 +3        WRITE !

 +4        DO DIR^ACRFDIC

 +5        IF Y'=1

               SET ACRQUIT=""

 +6        QUIT

APDA      ;EP;TO DISPLAY REMARKS FOR SELECTED APPROVAL

 +1        WRITE @IOF

 +2        WRITE !!?10,"COMMENTS REGARDING THIS APPROVAL"

 +3        WRITE !?10,"--------------------------------"

 +4        SET ACRRSN=$GET(^ACRAPVS(ACRAPDA,"RSN"))

 +5        SET ACRCNG=$GET(^ACRAPVS(ACRAPDA,"CNG"))

 +6        SET ACRRESP=$GET(^ACRAPVS(ACRAPDA,"RESP"))

 +7        SET ACRNO=$GET(^ACRAPVS(ACRAPDA,"DT"))

 +8        SET ACRDATE=$PIECE(ACRNO,U,4)

 +9        SET ACRINDV=$PIECE(ACRNO,U,2)

 +10       SET ACRINDVA=$PIECE(ACRNO,U,6)

 +11       IF ACRRSN=""

               SET ACRRSN=$GET(^ACROBL(ACRDOCDA,"RSN"))

 +12       IF ACRCNG=""

               SET ACRCNG=$GET(^ACROBL(ACRDOCDA,"CNG"))

 +13       IF ACRRESP=""

               SET ACRRESP=$GET(^ACROBL(ACRDOCDA,"RESP"))

 +14      ;I ACRINDVA,ACRINDVA'=ACRINDV S ACRIANAM=$P($P($P(^VA(200,ACRINDVA,0),U),",",2)," ")_" "_$P($P(^(0),U),",")  ;ACR*2.1*19.02 IM16848

 +15      ;S ACRINAM=$P($P($P(^VA(200,ACRINDV,0),U),",",2)," ")_" "_$P($P(^(0),U),",")  ;ACR*2.1*19.02 IM16848

 +16      ;ACR*2.1*19.02 IM16848

           IF ACRINDVA

               IF ACRINDVA'=ACRINDV

                   SET ACRIANAM=$$NAME3^ACRFUTL1(ACRINDVA)

 +17      ;ACR*2.1*19.02 IM16848

           SET ACRINAM=$$NAME3^ACRFUTL1(ACRINDV)

 +18       SET ACRNO=$PIECE(ACRNO,U)

 +19       WRITE !?10

 +20       IF ACRNO="D"

               WRITE $SELECT($PIECE(^ACRAPVS(ACRAPDA,0),U,11):"TRAVEL ADVANCE ",1:"")_"DISAPPROVED BY "

 +21      IF '$TEST

               WRITE "SIGNED/REVIEWED BY: "

 +22       IF $DATA(ACRIANAM)

               WRITE ACRIANAM," FOR "

 +23       WRITE ACRINAM

 +24       IF ACRNO="D"

               Begin DoDot:1

 +25               WRITE " ON "

 +26               SET Y=ACRDATE

 +27               XECUTE ^DD("DD")

 +28               WRITE Y

               End DoDot:1

 +29       WRITE !

 +30       SET (ACRI,ACRZ)=0

 +31       FOR

               SET ACRZ=$ORDER(^ACRAPVS(ACRAPDA,1,ACRZ))

               IF 'ACRZ

                   QUIT

               Begin DoDot:1

 +32               SET ACR0=$GET(^ACRAPVS(ACRAPDA,1,ACRZ,0))

 +33               IF $GET(^ACRAPVS(ACRAPDA,1,ACRZ,"CNG"))]""

                       SET ACRCNG=^("CNG")

 +34               IF $GET(^ACRAPVS(ACRAPDA,1,ACRZ,"RSN"))]""

                       SET ACRRSN=^("RSN")

 +35               SET ACRRESP=$GET(^ACRAPVS(ACRAPDA,1,ACRZ,"RESP"))

 +36               IF ACRCNG]""!(ACRRSN]"")!(ACRRESP]"")

                       DO MESS

               End DoDot:1

 +37       IF '$DATA(^ACRAPVS(ACRAPDA,1))

               IF ACRCNG]""!(ACRRSN]"")!(ACRRESP]"")

                   Begin DoDot:1

 +38                   SET ACR0=$PIECE(^ACRAPVS(ACRAPDA,"DT"),U,3)_U_$SELECT($PIECE(^("DT"),U,6):$PIECE(^("DT"),U,6),1:$PIECE(^("DT"),U,2))

 +39                   DO MESS

                   End DoDot:1

 +40       SET ACRZ=ACRI

 +41       QUIT

MESS      ;EP;TO PRINT MESSAGE

 +1        SET Y=$PIECE(ACR0,U)

 +2        XECUTE ^DD("DD")

 +3        WRITE !!?4,"MESSAGE NO.: ",ACRZ

 +4        WRITE !?4,"DATE: ",Y

 +5       ;W:$P(ACR0,U,2) ?40,"FROM: ",$P(^VA(200,$P(ACR0,U,2),0),U)  ;ACR*2.1*19.02 IM16848

 +6       ;ACR*2.1*19.02 IM16848

           IF $PIECE(ACR0,U,2)

               WRITE ?40,"FROM: ",$$NAME2^ACRFUTL1($PIECE(ACR0,U,2))

 +7        WRITE !?10,"----------"

 +8        WRITE ?46,"------------------------------"

 +9        FOR ACRX="ACRCNG","ACRRSN"

               Begin DoDot:1

 +10               FOR ACRI=1:1:5

                       IF $PIECE(@ACRX,U,ACRI)]""

                           WRITE !?10,$PIECE(@ACRX,U,ACRI)

               End DoDot:1

 +11       IF ACRRESP]""

               Begin DoDot:1

 +12               SET Y=$PIECE(ACR0,U,4)

 +13               XECUTE ^DD("DD")

 +14               WRITE !!?4,"RESPONSE"

 +15               WRITE !?4,"DATE: ",Y

 +16      ;W:$P(ACR0,U,3) ?40,"FROM: ",$P(^VA(200,$P(ACR0,U,3),0),U)  ;ACR*2.1*19.02 IM16848

 +17      ;ACR*2.1*19.02 IM16848

                   IF $PIECE(ACR0,U,3)

                       WRITE ?40,"FROM: ",$$NAME2^ACRFUTL1($PIECE(ACR0,U,3))

 +18               WRITE !?10,"-------------------------------------------"

 +19               FOR ACRI=1:1:5

                       IF $PIECE(ACRRESP,U,ACRI)]""

                           WRITE !?10,$PIECE(ACRRESP,U,ACRI)

               End DoDot:1

 +20       DO PAUSE^ACRFWARN

 +21       SET ACRI=ACRZ

 +22       QUIT

ACRFDISA.m