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
Q
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
Q
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=""
Q
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
Q
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
Q
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
