- 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
