ACRFPRC2 ;IHS/OIRM/DSD/THL,AEF - PROCESS PENDING DOCUMENTS; [ 11/01/2001 9:44 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
;;CONTINUATION OF ACRFPRCS
CSI ;EP;DISPLAY APPROVAL STATUS
D DISPLAY^ACRFTXTP
D SELECT^ACRFTXTP Q:$D(ACRQUIT)!$D(ACROUT)
S ACRX=0,ACRFDNO(1)=","
F S ACRX=$O(^ACRLOCB("SEC",DUZ,ACRX)) Q:'ACRX S ACRFDNO(1)=ACRFDNO(1)_ACRX_","
I ACRFDNO(1)="," D
.W !!,"YOU DO NOT HAVE ACCESS TO ANY ACCOUNTS."
.H 2
.S ACRQUIT=""
W !!
S ACRAPVT=0
F S ACRAPVT=$O(^ACRAPVS("ANXT",ACRAPVT)) Q:'ACRAPVT D
.S ACRINDV=0
.F S ACRINDV=$O(^ACRAPVS("ANXT",ACRAPVT,ACRINDV)) Q:'ACRINDV D
..S D0=0
..F S D0=$O(^ACRAPVS("ANXT",ACRAPVT,ACRINDV,D0)) Q:'D0!$D(ACRQUIT)!$D(ACROUT) D CSI2
K ACRQUIT
D PPO
Q
I 'ACRJ D
.W !!,"NO ",@ACRON,$P(^ACRTXTYP(ACRTXDA,0),U),@ACROF," PENDING."
.H 2
Q
CSI2 Q:'D0
I '$D(^ACRAPVS(D0,0)),ACRINDV K ^ACRAPVS("ANXT",ACRAPVT,ACRINDV,D0) Q
S ACRDOCDA=+^ACRAPVS(D0,0)
I '$D(^ACRDOC(ACRDOCDA,0)) D Q
.S DA=D0
.S DIK="^ACRAPVS("
.D DIK^ACRFDIC
.K ^ACRAPVS("ANXT",ACRAPVT,ACRINDV,D0)
S ACRLBDA=","_$P(^ACRAPVS(D0,0),U,5)_","
Q:$P(^ACRDOC(ACRDOCDA,0),U,4)'=ACRTXDA!(ACRFDNO(1)'[ACRLBDA)
W !
I '$D(^ACRAPVS("AB",ACRDOCDA)) W !,"DOCUMENT HAS NOT BEEN SUBMITTED FOR APPROVAL."
E D
.S ACRD0=0
.F S ACRD0=$O(^ACRAPVS("AB",ACRDOCDA,ACRD0)) Q:'ACRD0 D
..S ACRAPVT=$P(^ACRAPVS(ACRD0,0),U,3)
..S ACRINDV=$P(^ACRAPVS(ACRD0,"DT"),U,2)
..I $D(^ACRAPVS("ANXT",ACRAPVT,ACRINDV,ACRD0)) D
...S D0=ACRD0
...N DXS,DIP,DC,DN
...D ^ACRPTTS
I $D(ACRD0),'ACRD0 D
.W !,"DOCUMENT PENDING IN PROCUREMENT."
.K ACRD0
K ACRAPVT,ACRINDV
D PAUSE^ACRFWARN
Q
LIST S ACRDOCDA=+^ACRAPVS(D0,0)
LIST1 S ACRJ=ACRJ+1
S ACRDATA=^ACRDOC(ACRDOCDA,0)
S ACRDOC=$P(ACRDATA,U)
S ACRTXTYP=$P(ACRDATA,U,4)
S:$D(ACRPPO1) ACRTXTYP=1
K ACRPPO1
S ACRREF=$P(^ACRTXTYP(ACRTXTYP,0),U,2)
S ACRREF1=$P(^AUTTDOCR(ACRREF,0),U)
S ACRID=$E($P(ACRDATA,U,14),1,15)
S ^TMP("ACRDATA",$J,ACRJ)=ACRDOCDA_U_ACRREF1_U_ACRTXTYP_U_D0_U_ACRDOC_U_ACRID
S ACRDATA1(ACRDOCDA)=""
I $Y#IOSL>19,$E(IOST,1,2)="C-" D PAUSE^ACRFWARN W @IOF
Q
PPO I $D(^TMP("ACRDATA",$J))#2 D
.S ACRX=0
.F S ACRX=$O(^TMP("ACRDATA",$J,ACRX)) Q:'ACRX I '$D(ACRDATA1($P(^TMP("ACRDATA",$J,ACRX),U))) D PPH Q
S ACRX=0
F S ACRX=$O(^ACRDOC("PA",ACRX)) Q:'ACRX D
.S D0=0
.F S D0=$O(^ACRDOC("PA",ACRX,D0)) Q:'D0!$D(ACRQUIT)!$D(ACROUT) D
.I '$D(ACRDATA1(D0)) D
..S ACRDOCDA=D0
..D:$P(^ACROBL(D0,"APV"),U,8)="" PPO1
K ACRQUIT
Q
PPO1 S ACRLBDA=","_$P(^ACRDOC(D0,0),U,6)_","
Q:$P(^ACRDOC(D0,0),U,4)'=11!(ACRFDNO(1)'[ACRLBDA)
S ACRPPO1=""
N DXS,DIP,DC,DN
D ^ACRPTT2,LIST1
I $Y#IOSL>19,$E(IOST,1,2)="C-" D PAUSE^ACRFWARN,PPH
Q
PPH W @IOF
W !,"APPROVED REQUESTS AWAITING FURTHER PROCESSING."
W !!
Q
EXIT ;EP;
K ACRTXDA,ACRESIG,ACRCSI,ACRDAT,ACRX,ACRTXTYP,ACRJJ,ACRAPVT,ACRQUIT,ACRDA,ACR,ACRREF1,ACRMAX,ACRPA,ACRY,ACRAPDA,ACRLBDA,ACRNOW,ACRNUM,ACRORD,ACRSIG,ACRSIGG,ACRSIGP,ACRSIGZ,ACRSIGZZ,ACRFDNO(1),ACRXMY,ACRINDV,ACRAP,ACRATTCH
K ^TMP("ACRDATE",$J),^TMP("ACRALT",$J),^TMP("ACRALTDT",$J),^TMP("ACRDATA",$J)
Q
RESP ;EP;NOTIFITY INITIATOR THAT RESPONSE REQUIRED
K ACRREQX
N X,Y,Z,ACRREQ,J
S X=0
F S X=$O(^ACRAPVS("ANXT",X)) Q:'X D
.W:$E($G(IOST),1,2)="C-" "."
.S Y=0
.F S Y=$O(^ACRAPVS("ANXT",X,Y)) Q:'Y D
..S Z=0
..F S Z=$O(^ACRAPVS("ANXT",X,Y,Z)) Q:'Z D
...S ACRDOCDA=+^ACRAPVS("ANXT",X,Y,Z)
...I $E($G(^ACRDOC(ACRDOCDA,"DT")),1,3)="1^0","^33^35^"[(U_$P($G(^(0)),U,13)_U) D
....S ACRREQ=U_$P($G(^ACRDOC(ACRDOCDA,"REQ")),U,12)_U_$P($G(^ACRDOC(ACRDOCDA,"REQ2")),U,8)_U_$P($G(^ACROBL(ACRDOCDA,0)),U,5)_U
....Q:ACRREQ'[(U_DUZ_U)
....S ACRREQX($P(^ACRDOC(ACRDOCDA,0),U,6),ACRDOCDA)=""
Q:'$D(ACRREQX)
W *7,*7
W !!?5,"The following document(s) were returned for change or clarification."
W !?5,"You must respond before they can be signed and processed further."
W !?5,"Under 'USER MENU' use 'ER' (Edit Pending Request). Select the"
W !?5,"Department Account, make the requested changes AND send the"
W !?5,"REQUIRED response."
W !!?5,"ID NO."
W ?13,"Department Account"
W !?5,"------"
W ?13,"--------------------"
S X=0
F S X=$O(ACRREQX(X)) Q:'X I $D(^ACRLOCB(X,0)) S Z=^(0) D
.W !?5,X
.W ?13,$P($G(^AUTTPRG(+$P(Z,U,5),0)),U)
.W !!?13,"ID NO."
.W ?21,"DOCUMENT"
.W ?58,"IDENTIFIER"
.W !?13,"------"
.W ?21,"------------------------------"
.W ?58,"---------------"
.S Y=0
.F S Y=$O(ACRREQX(X,Y)) Q:'Y I $D(^ACRDOC(Y,0)) S J=^(0) D
..W !?13,Y
..W ?21,$P(J,U)
..W ?$X+2,"(",$P(J,U,2),")"
..W ?58,$P(J,U,14)
D PAUSE^ACRFWARN
Q
ATTACH ;EP;DISPLAY ATTACHMENT MESSAGE
EDIT K ACRRR
S ACRATTCH=$G(^ACRDOC(ACRDOCDA,3))
S ACRATTCH=$P(ACRATTCH,U,9)
I 'ACRATTCH D Q
.W !!,"There are NO attachments for this document"
.D PAUSE^ACRFWARN
.K ACRATTCH
N X
S X=ACRATTCH
W !!,*7,*7,"There ",$S(X>1:"are ",1:"is "),ACRATTCH," physical attachment",$S(X>1:"s",1:"")," which pertain",$S(X>1:"",1:"s")
W " to this request."
W !,"Please find and review ",$S(X>1:"them",1:"it")," if ",$S(X>1:"they",1:"it")," affect",$S(X>1:"",1:"s")," your approval of this request."
I $D(^ACRDOC(ACRDOCDA,10,0)),$P(^(0),U,3)>0 D
.W !!,"Th",$S(X>1:"ese",1:"is")," attachment",$S(X>1:"s",1:""),$S(X>1:" are",1:" is")," described as follows:"
.W !,"--------------------------------------------------------------------------------"
.N X,J
.S X=0
.F J=1:1 S X=$O(^ACRDOC(ACRDOCDA,10,X)) Q:'X I $D(^ACRDOC(ACRDOCDA,10,X,0)) D
..W !,^ACRDOC(ACRDOCDA,10,X,0)
..I J#15=0 D
...S ACRX=X
...D PAUSE^ACRFWARN
...S X=ACRX
Q
ACRFPRC2 ;IHS/OIRM/DSD/THL,AEF - PROCESS PENDING DOCUMENTS; [ 11/01/2001 9:44 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
+2 ;;CONTINUATION OF ACRFPRCS
CSI ;EP;DISPLAY APPROVAL STATUS
+1 DO DISPLAY^ACRFTXTP
+2 DO SELECT^ACRFTXTP
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+3 SET ACRX=0
SET ACRFDNO(1)=","
+4 FOR
SET ACRX=$ORDER(^ACRLOCB("SEC",DUZ,ACRX))
IF 'ACRX
QUIT
SET ACRFDNO(1)=ACRFDNO(1)_ACRX_","
+5 IF ACRFDNO(1)=","
Begin DoDot:1
+6 WRITE !!,"YOU DO NOT HAVE ACCESS TO ANY ACCOUNTS."
+7 HANG 2
+8 SET ACRQUIT=""
End DoDot:1
+9 WRITE !!
+10 SET ACRAPVT=0
+11 FOR
SET ACRAPVT=$ORDER(^ACRAPVS("ANXT",ACRAPVT))
IF 'ACRAPVT
QUIT
Begin DoDot:1
+12 SET ACRINDV=0
+13 FOR
SET ACRINDV=$ORDER(^ACRAPVS("ANXT",ACRAPVT,ACRINDV))
IF 'ACRINDV
QUIT
Begin DoDot:2
+14 SET D0=0
+15 FOR
SET D0=$ORDER(^ACRAPVS("ANXT",ACRAPVT,ACRINDV,D0))
IF 'D0!$DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
DO CSI2
End DoDot:2
End DoDot:1
+16 KILL ACRQUIT
+17 DO PPO
+18 QUIT
+19 IF 'ACRJ
Begin DoDot:1
+20 WRITE !!,"NO ",@ACRON,$PIECE(^ACRTXTYP(ACRTXDA,0),U),@ACROF," PENDING."
+21 HANG 2
End DoDot:1
+22 QUIT
CSI2 IF 'D0
QUIT
+1 IF '$DATA(^ACRAPVS(D0,0))
IF ACRINDV
KILL ^ACRAPVS("ANXT",ACRAPVT,ACRINDV,D0)
QUIT
+2 SET ACRDOCDA=+^ACRAPVS(D0,0)
+3 IF '$DATA(^ACRDOC(ACRDOCDA,0))
Begin DoDot:1
+4 SET DA=D0
+5 SET DIK="^ACRAPVS("
+6 DO DIK^ACRFDIC
+7 KILL ^ACRAPVS("ANXT",ACRAPVT,ACRINDV,D0)
End DoDot:1
QUIT
+8 SET ACRLBDA=","_$PIECE(^ACRAPVS(D0,0),U,5)_","
+9 IF $PIECE(^ACRDOC(ACRDOCDA,0),U,4)'=ACRTXDA!(ACRFDNO(1)'[ACRLBDA)
QUIT
+10 WRITE !
+11 IF '$DATA(^ACRAPVS("AB",ACRDOCDA))
WRITE !,"DOCUMENT HAS NOT BEEN SUBMITTED FOR APPROVAL."
+12 IF '$TEST
Begin DoDot:1
+13 SET ACRD0=0
+14 FOR
SET ACRD0=$ORDER(^ACRAPVS("AB",ACRDOCDA,ACRD0))
IF 'ACRD0
QUIT
Begin DoDot:2
+15 SET ACRAPVT=$PIECE(^ACRAPVS(ACRD0,0),U,3)
+16 SET ACRINDV=$PIECE(^ACRAPVS(ACRD0,"DT"),U,2)
+17 IF $DATA(^ACRAPVS("ANXT",ACRAPVT,ACRINDV,ACRD0))
Begin DoDot:3
+18 SET D0=ACRD0
+19 NEW DXS,DIP,DC,DN
+20 DO ^ACRPTTS
End DoDot:3
End DoDot:2
End DoDot:1
+21 IF $DATA(ACRD0)
IF 'ACRD0
Begin DoDot:1
+22 WRITE !,"DOCUMENT PENDING IN PROCUREMENT."
+23 KILL ACRD0
End DoDot:1
+24 KILL ACRAPVT,ACRINDV
+25 DO PAUSE^ACRFWARN
+26 QUIT
LIST SET ACRDOCDA=+^ACRAPVS(D0,0)
LIST1 SET ACRJ=ACRJ+1
+1 SET ACRDATA=^ACRDOC(ACRDOCDA,0)
+2 SET ACRDOC=$PIECE(ACRDATA,U)
+3 SET ACRTXTYP=$PIECE(ACRDATA,U,4)
+4 IF $DATA(ACRPPO1)
SET ACRTXTYP=1
+5 KILL ACRPPO1
+6 SET ACRREF=$PIECE(^ACRTXTYP(ACRTXTYP,0),U,2)
+7 SET ACRREF1=$PIECE(^AUTTDOCR(ACRREF,0),U)
+8 SET ACRID=$EXTRACT($PIECE(ACRDATA,U,14),1,15)
+9 SET ^TMP("ACRDATA",$JOB,ACRJ)=ACRDOCDA_U_ACRREF1_U_ACRTXTYP_U_D0_U_ACRDOC_U_ACRID
+10 SET ACRDATA1(ACRDOCDA)=""
+11 IF $Y#IOSL>19
IF $EXTRACT(IOST,1,2)="C-"
DO PAUSE^ACRFWARN
WRITE @IOF
+12 QUIT
PPO IF $DATA(^TMP("ACRDATA",$JOB))#2
Begin DoDot:1
+1 SET ACRX=0
+2 FOR
SET ACRX=$ORDER(^TMP("ACRDATA",$JOB,ACRX))
IF 'ACRX
QUIT
IF '$DATA(ACRDATA1($PIECE(^TMP("ACRDATA",$JOB,ACRX),U)))
DO PPH
QUIT
End DoDot:1
+3 SET ACRX=0
+4 FOR
SET ACRX=$ORDER(^ACRDOC("PA",ACRX))
IF 'ACRX
QUIT
Begin DoDot:1
+5 SET D0=0
+6 FOR
SET D0=$ORDER(^ACRDOC("PA",ACRX,D0))
IF 'D0!$DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
Begin DoDot:2
End DoDot:2
+7 IF '$DATA(ACRDATA1(D0))
Begin DoDot:2
+8 SET ACRDOCDA=D0
+9 IF $PIECE(^ACROBL(D0,"APV"),U,8)=""
DO PPO1
End DoDot:2
End DoDot:1
+10 KILL ACRQUIT
+11 QUIT
PPO1 SET ACRLBDA=","_$PIECE(^ACRDOC(D0,0),U,6)_","
+1 IF $PIECE(^ACRDOC(D0,0),U,4)'=11!(ACRFDNO(1)'[ACRLBDA)
QUIT
+2 SET ACRPPO1=""
+3 NEW DXS,DIP,DC,DN
+4 DO ^ACRPTT2
DO LIST1
+5 IF $Y#IOSL>19
IF $EXTRACT(IOST,1,2)="C-"
DO PAUSE^ACRFWARN
DO PPH
+6 QUIT
PPH WRITE @IOF
+1 WRITE !,"APPROVED REQUESTS AWAITING FURTHER PROCESSING."
+2 WRITE !!
+3 QUIT
EXIT ;EP;
+1 KILL ACRTXDA,ACRESIG,ACRCSI,ACRDAT,ACRX,ACRTXTYP,ACRJJ,ACRAPVT,ACRQUIT,ACRDA,ACR,ACRREF1,ACRMAX,ACRPA,ACRY,ACRAPDA,ACRLBDA,ACRNOW,ACRNUM,ACRORD,ACRSIG,ACRSIGG,ACRSIGP,ACRSIGZ,ACRSIGZZ,ACRFDNO(1),ACRXMY,ACRINDV,ACRAP,ACRATTCH
+2 KILL ^TMP("ACRDATE",$JOB),^TMP("ACRALT",$JOB),^TMP("ACRALTDT",$JOB),^TMP("ACRDATA",$JOB)
+3 QUIT
RESP ;EP;NOTIFITY INITIATOR THAT RESPONSE REQUIRED
+1 KILL ACRREQX
+2 NEW X,Y,Z,ACRREQ,J
+3 SET X=0
+4 FOR
SET X=$ORDER(^ACRAPVS("ANXT",X))
IF 'X
QUIT
Begin DoDot:1
+5 IF $EXTRACT($GET(IOST),1,2)="C-"
WRITE "."
+6 SET Y=0
+7 FOR
SET Y=$ORDER(^ACRAPVS("ANXT",X,Y))
IF 'Y
QUIT
Begin DoDot:2
+8 SET Z=0
+9 FOR
SET Z=$ORDER(^ACRAPVS("ANXT",X,Y,Z))
IF 'Z
QUIT
Begin DoDot:3
+10 SET ACRDOCDA=+^ACRAPVS("ANXT",X,Y,Z)
+11 IF $EXTRACT($GET(^ACRDOC(ACRDOCDA,"DT")),1,3)="1^0"
IF "^33^35^"[(U_$PIECE($GET(^(0)),U,13)_U)
Begin DoDot:4
+12 SET ACRREQ=U_$PIECE($GET(^ACRDOC(ACRDOCDA,"REQ")),U,12)_U_$PIECE($GET(^ACRDOC(ACRDOCDA,"REQ2")),U,8)_U_$PIECE($GET(^ACROBL(ACRDOCDA,0)),U,5)_U
+13 IF ACRREQ'[(U_DUZ_U)
QUIT
+14 SET ACRREQX($PIECE(^ACRDOC(ACRDOCDA,0),U,6),ACRDOCDA)=""
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+15 IF '$DATA(ACRREQX)
QUIT
+16 WRITE *7,*7
+17 WRITE !!?5,"The following document(s) were returned for change or clarification."
+18 WRITE !?5,"You must respond before they can be signed and processed further."
+19 WRITE !?5,"Under 'USER MENU' use 'ER' (Edit Pending Request). Select the"
+20 WRITE !?5,"Department Account, make the requested changes AND send the"
+21 WRITE !?5,"REQUIRED response."
+22 WRITE !!?5,"ID NO."
+23 WRITE ?13,"Department Account"
+24 WRITE !?5,"------"
+25 WRITE ?13,"--------------------"
+26 SET X=0
+27 FOR
SET X=$ORDER(ACRREQX(X))
IF 'X
QUIT
IF $DATA(^ACRLOCB(X,0))
SET Z=^(0)
Begin DoDot:1
+28 WRITE !?5,X
+29 WRITE ?13,$PIECE($GET(^AUTTPRG(+$PIECE(Z,U,5),0)),U)
+30 WRITE !!?13,"ID NO."
+31 WRITE ?21,"DOCUMENT"
+32 WRITE ?58,"IDENTIFIER"
+33 WRITE !?13,"------"
+34 WRITE ?21,"------------------------------"
+35 WRITE ?58,"---------------"
+36 SET Y=0
+37 FOR
SET Y=$ORDER(ACRREQX(X,Y))
IF 'Y
QUIT
IF $DATA(^ACRDOC(Y,0))
SET J=^(0)
Begin DoDot:2
+38 WRITE !?13,Y
+39 WRITE ?21,$PIECE(J,U)
+40 WRITE ?$X+2,"(",$PIECE(J,U,2),")"
+41 WRITE ?58,$PIECE(J,U,14)
End DoDot:2
End DoDot:1
+42 DO PAUSE^ACRFWARN
+43 QUIT
ATTACH ;EP;DISPLAY ATTACHMENT MESSAGE
EDIT KILL ACRRR
+1 SET ACRATTCH=$GET(^ACRDOC(ACRDOCDA,3))
+2 SET ACRATTCH=$PIECE(ACRATTCH,U,9)
+3 IF 'ACRATTCH
Begin DoDot:1
+4 WRITE !!,"There are NO attachments for this document"
+5 DO PAUSE^ACRFWARN
+6 KILL ACRATTCH
End DoDot:1
QUIT
+7 NEW X
+8 SET X=ACRATTCH
+9 WRITE !!,*7,*7,"There ",$SELECT(X>1:"are ",1:"is "),ACRATTCH," physical attachment",$SELECT(X>1:"s",1:"")," which pertain",$SELECT(X>1:"",1:"s")
+10 WRITE " to this request."
+11 WRITE !,"Please find and review ",$SELECT(X>1:"them",1:"it")," if ",$SELECT(X>1:"they",1:"it")," affect",$SELECT(X>1:"",1:"s")," your approval of this request."
+12 IF $DATA(^ACRDOC(ACRDOCDA,10,0))
IF $PIECE(^(0),U,3)>0
Begin DoDot:1
+13 WRITE !!,"Th",$SELECT(X>1:"ese",1:"is")," attachment",$SELECT(X>1:"s",1:""),$SELECT(X>1:" are",1:" is")," described as follows:"
+14 WRITE !,"--------------------------------------------------------------------------------"
+15 NEW X,J
+16 SET X=0
+17 FOR J=1:1
SET X=$ORDER(^ACRDOC(ACRDOCDA,10,X))
IF 'X
QUIT
IF $DATA(^ACRDOC(ACRDOCDA,10,X,0))
Begin DoDot:2
+18 WRITE !,^ACRDOC(ACRDOCDA,10,X,0)
+19 IF J#15=0
Begin DoDot:3
+20 SET ACRX=X
+21 DO PAUSE^ACRFWARN
+22 SET X=ACRX
End DoDot:3
End DoDot:2
End DoDot:1
+23 QUIT
