ACRFALT ;IHS/OIRM/DSD/THL,AEF - PROCESS SIGNATURES AS ACTING; [ 09/22/2005 9:44 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;**19**;NOV 05, 2001
;;ROUTINE TO DISPLAY, SELECT AND PROCESS DOCUMENTS PENDING FOR
;;ALTERNATE'S SIGNATURE
EN ;EP;TO DISPLAY, SELECT AND PROCESS DOCUMENTS PENDING FOR ALTERNATES
;SIGNATURE
F D EN1 Q:$D(ACRQUIT)!$D(ACROUT)
EXIT K ACR,ACRALTY,ACRJ,ACRALTX,ACRQUIT
Q
EN1 W @IOF
W !,"Documents are pending for:"
W !
D DISP
I ACRJ<2 D Q
.S ACRQUIT=""
.W !,"You have no more documents to sign as an alternate."
.H 2
D SELECT
Q
SELECT ;SELECT INDIVIDUAL FOR WHOM USER WILL SIGN AS ALTERNATE
S DIR(0)="NO^1:"_(ACRJ-1)
S DIR("A")="Which one"
W !!,"Indicate number of the individual for whom you are an authorized"
W !,"alternate and for whom you want to review/authorize for incumbent."
W !
D DIR^ACRFDIC
Q:$D(ACRQUIT)!$D(ACROUT)
S ACRALTY=Y
S ACRDUZ=ACRALTX(ACRALTY)
D RELIST
F D SIGS Q:$D(ACRQUIT)!$D(ACROUT)
K ACRQUIT
Q
DISP ;DISPLAYS LIST OF ALL INDIVIDUALS FOR WHOM CURRENT USER IS ALTERNATE
I $D(^TMP("ACRALTDT",$J)) D R1
S ACR=0
F ACRJ=1:1 S ACR=$O(^TMP("ACRALT",$J,ACR)) Q:'ACR D
.I $D(^VA(200,ACR,0)) D
..N X
..;S X=$P(^VA(200,ACR,0),U) ;ACR*2.1*19.02 IM16848
..S X=$$NAME2^ACRFUTL1(ACR) ;ACR*2.1*19.02 IM16848
..S ACRNAM=$P($P(X,",",2)," ")_" "_$P(X,",")
..S ACRALTX(ACRJ)=ACR
..W !?10,ACRJ
..W ?15,ACRNAM
Q
SIGS ;PROCESS DOCUMENTS PENDING FOR USER TO SIGN AS ALTERNATE
S ACRDUZ=ACRALTX(ACRALTY)
S ACRI=0
D LIST2^ACRFPRCS
D EN21^ACRFPRCS:'$D(ACRQUIT)
D RELIST:'$D(ACRQUIT)
Q
XY ;SETS LOCAL ARRAY 'ACRDATA'
S %X="^TMP(""ACRALT"","_$J_","_ACRDUZ_","
S %Y="^TMP(""ACRDATA"","_$J_","_ACRDUZ_","
D %XY^%RCR
K %X,%Y
Q
RELIST ;RELISTS DOCUMENTS WHICH CURRENT USER NEEDS TO SIGN
I $D(^TMP("ACRALTDT",$J)) D Q
.D R1
.D XY
K ACR
S ACR=0
F ACRJ=1:1 S ACR=$O(^TMP("ACRALT",$J,ACRDUZ,ACR)) Q:'ACR!($L(ACR)>8) I ACRJ<ACR D
.S ^TMP("ACRALT",$J,ACRDUZ,ACRJ)=^TMP("ACRALT",$J,ACRDUZ,ACR)
.N ACRDOC
.S ACRDOC=$P(^TMP("ACRALT",$J,ACRDUZ,ACR),U,5)
.S ^TMP("ACRALT",$J,ACRDUZ,ACRDOC)=^TMP("ACRALT",$J,ACRDUZ,ACR)
.S $P(^TMP("ACRALT",$J,ACRDUZ,ACRDOC),U,10)=ACRJ
.K ^TMP("ACRALT",$J,ACRDUZ,ACR),^TMP("ACRDATA",$J,ACRDUZ,ACR)
D XY
Q
R1 ;CHANGE DATE ORDER ARRAY OF DOCS TO BE SIGNED TO NUMERIC ORDERED ARRAY
N ACRDUZ,ACR,ACRI,ACR1
S ACRDUZ=0
F S ACRDUZ=$O(^TMP("ACRALTDT",$J,ACRDUZ)) Q:'ACRDUZ D
.S (ACR,ACRI)=0
.F S ACR=$O(^TMP("ACRALTDT",$J,ACRDUZ,ACR)) Q:'ACR D
..S ACR1=0
..F S ACR1=$O(^TMP("ACRALTDT",$J,ACRDUZ,ACR,ACR1)) Q:'ACR1 D
...S ACRI=ACRI+1
...S ^TMP("ACRALT",$J,ACRDUZ,ACRI)=^TMP("ACRALTDT",$J,ACRDUZ,ACR,ACR1)
...N ACRDOC
...S ACRDOC=$P(^TMP("ACRALTDT",$J,ACRDUZ,ACR,ACR1),U,5)
...S ^TMP("ACRALT",$J,ACRDUZ,ACRDOC)=^TMP("ACRALTDT",$J,ACRDUZ,ACR,ACR1)
...S $P(^TMP("ACRALT",$J,ACRDUZ,ACRDOC),U,10)=ACRI
...K ^TMP("ACRALTDT",$J,ACRDUZ,ACR,ACR1)
K ^TMP("ACRALTDT",$J)
Q
ACRFALT ;IHS/OIRM/DSD/THL,AEF - PROCESS SIGNATURES AS ACTING; [ 09/22/2005 9:44 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**19**;NOV 05, 2001
+2 ;;ROUTINE TO DISPLAY, SELECT AND PROCESS DOCUMENTS PENDING FOR
+3 ;;ALTERNATE'S SIGNATURE
EN ;EP;TO DISPLAY, SELECT AND PROCESS DOCUMENTS PENDING FOR ALTERNATES
+1 ;SIGNATURE
+2 FOR
DO EN1
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
EXIT KILL ACR,ACRALTY,ACRJ,ACRALTX,ACRQUIT
+1 QUIT
EN1 WRITE @IOF
+1 WRITE !,"Documents are pending for:"
+2 WRITE !
+3 DO DISP
+4 IF ACRJ<2
Begin DoDot:1
+5 SET ACRQUIT=""
+6 WRITE !,"You have no more documents to sign as an alternate."
+7 HANG 2
End DoDot:1
QUIT
+8 DO SELECT
+9 QUIT
SELECT ;SELECT INDIVIDUAL FOR WHOM USER WILL SIGN AS ALTERNATE
+1 SET DIR(0)="NO^1:"_(ACRJ-1)
+2 SET DIR("A")="Which one"
+3 WRITE !!,"Indicate number of the individual for whom you are an authorized"
+4 WRITE !,"alternate and for whom you want to review/authorize for incumbent."
+5 WRITE !
+6 DO DIR^ACRFDIC
+7 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+8 SET ACRALTY=Y
+9 SET ACRDUZ=ACRALTX(ACRALTY)
+10 DO RELIST
+11 FOR
DO SIGS
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+12 KILL ACRQUIT
+13 QUIT
DISP ;DISPLAYS LIST OF ALL INDIVIDUALS FOR WHOM CURRENT USER IS ALTERNATE
+1 IF $DATA(^TMP("ACRALTDT",$JOB))
DO R1
+2 SET ACR=0
+3 FOR ACRJ=1:1
SET ACR=$ORDER(^TMP("ACRALT",$JOB,ACR))
IF 'ACR
QUIT
Begin DoDot:1
+4 IF $DATA(^VA(200,ACR,0))
Begin DoDot:2
+5 NEW X
+6 ;S X=$P(^VA(200,ACR,0),U) ;ACR*2.1*19.02 IM16848
+7 ;ACR*2.1*19.02 IM16848
SET X=$$NAME2^ACRFUTL1(ACR)
+8 SET ACRNAM=$PIECE($PIECE(X,",",2)," ")_" "_$PIECE(X,",")
+9 SET ACRALTX(ACRJ)=ACR
+10 WRITE !?10,ACRJ
+11 WRITE ?15,ACRNAM
End DoDot:2
End DoDot:1
+12 QUIT
SIGS ;PROCESS DOCUMENTS PENDING FOR USER TO SIGN AS ALTERNATE
+1 SET ACRDUZ=ACRALTX(ACRALTY)
+2 SET ACRI=0
+3 DO LIST2^ACRFPRCS
+4 IF '$DATA(ACRQUIT)
DO EN21^ACRFPRCS
+5 IF '$DATA(ACRQUIT)
DO RELIST
+6 QUIT
XY ;SETS LOCAL ARRAY 'ACRDATA'
+1 SET %X="^TMP(""ACRALT"","_$JOB_","_ACRDUZ_","
+2 SET %Y="^TMP(""ACRDATA"","_$JOB_","_ACRDUZ_","
+3 DO %XY^%RCR
+4 KILL %X,%Y
+5 QUIT
RELIST ;RELISTS DOCUMENTS WHICH CURRENT USER NEEDS TO SIGN
+1 IF $DATA(^TMP("ACRALTDT",$JOB))
Begin DoDot:1
+2 DO R1
+3 DO XY
End DoDot:1
QUIT
+4 KILL ACR
+5 SET ACR=0
+6 FOR ACRJ=1:1
SET ACR=$ORDER(^TMP("ACRALT",$JOB,ACRDUZ,ACR))
IF 'ACR!($LENGTH(ACR)>8)
QUIT
IF ACRJ<ACR
Begin DoDot:1
+7 SET ^TMP("ACRALT",$JOB,ACRDUZ,ACRJ)=^TMP("ACRALT",$JOB,ACRDUZ,ACR)
+8 NEW ACRDOC
+9 SET ACRDOC=$PIECE(^TMP("ACRALT",$JOB,ACRDUZ,ACR),U,5)
+10 SET ^TMP("ACRALT",$JOB,ACRDUZ,ACRDOC)=^TMP("ACRALT",$JOB,ACRDUZ,ACR)
+11 SET $PIECE(^TMP("ACRALT",$JOB,ACRDUZ,ACRDOC),U,10)=ACRJ
+12 KILL ^TMP("ACRALT",$JOB,ACRDUZ,ACR),^TMP("ACRDATA",$JOB,ACRDUZ,ACR)
End DoDot:1
+13 DO XY
+14 QUIT
R1 ;CHANGE DATE ORDER ARRAY OF DOCS TO BE SIGNED TO NUMERIC ORDERED ARRAY
+1 NEW ACRDUZ,ACR,ACRI,ACR1
+2 SET ACRDUZ=0
+3 FOR
SET ACRDUZ=$ORDER(^TMP("ACRALTDT",$JOB,ACRDUZ))
IF 'ACRDUZ
QUIT
Begin DoDot:1
+4 SET (ACR,ACRI)=0
+5 FOR
SET ACR=$ORDER(^TMP("ACRALTDT",$JOB,ACRDUZ,ACR))
IF 'ACR
QUIT
Begin DoDot:2
+6 SET ACR1=0
+7 FOR
SET ACR1=$ORDER(^TMP("ACRALTDT",$JOB,ACRDUZ,ACR,ACR1))
IF 'ACR1
QUIT
Begin DoDot:3
+8 SET ACRI=ACRI+1
+9 SET ^TMP("ACRALT",$JOB,ACRDUZ,ACRI)=^TMP("ACRALTDT",$JOB,ACRDUZ,ACR,ACR1)
+10 NEW ACRDOC
+11 SET ACRDOC=$PIECE(^TMP("ACRALTDT",$JOB,ACRDUZ,ACR,ACR1),U,5)
+12 SET ^TMP("ACRALT",$JOB,ACRDUZ,ACRDOC)=^TMP("ACRALTDT",$JOB,ACRDUZ,ACR,ACR1)
+13 SET $PIECE(^TMP("ACRALT",$JOB,ACRDUZ,ACRDOC),U,10)=ACRI
+14 KILL ^TMP("ACRALTDT",$JOB,ACRDUZ,ACR,ACR1)
End DoDot:3
End DoDot:2
End DoDot:1
+15 KILL ^TMP("ACRALTDT",$JOB)
+16 QUIT
