ACRFUP1 ;IHS/OIRM/DSD/THL,AEF - ARMS USER PROFILES; [ 07/20/2006 9:44 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;**19,20**;NOV 05, 2001
;;CONTINUATION OF ACRFUP
PS1 ;EP;TO PRINT ARMS USER SUMMARY DATA
I $E($G(IOST),1,2)="C-" W @IOF
D NAME
W !!?5
I D0,$D(^VA(200,D0,20)) W $S($P(^(20),U,4)="":"NO ",1:"")
E W "NO "
W "Electronic Signature Code has been assigned."
I $P($G(^ACRAU(D0,1)),U,6) W !?5,"Government ATM card has been authorized."
N ACRDA
S ACRDA=0
K ACRAPVT
F S ACRDA=$O(^ACRAPL("B",ACRDUZ,ACRDA)) Q:'ACRDA!$D(ACRQUIT)!$D(ACROUT) D
.S ACR=$P(^ACRAPL(ACRDA,0),U,2)
.I 'ACR D Q
..S DA=ACRDA
..S DIK="^ACRAPL("
..D DIK^ACRFDIC
.S ACRCAT=$P(^ACRAPVT(ACR,0),U,6)
.S ACRORD=$P(^ACRAPVT(ACR,0),U,4)
.I ACRCAT,ACRORD S ACRAPVT(ACRCAT,ACRORD,ACR)=$G(^ACRAPL(ACRDA,"DT"))
S ACR1=0
F S ACR1=$O(^ACRAPL("ALT",ACR1)) Q:'ACR1!$D(ACRQUIT)!$D(ACROUT) D
.S ACR=0
.F S ACR=$O(^ACRAPL("ALT",ACR1,ACR)) Q:'ACR D
..S ACRCAT=$P(^ACRAPVT(ACR,0),U,6),ACRORD=$P(^(0),U,4) I $D(^ACRAPL("ALT",ACR1,ACR,ACRDUZ)),ACRCAT,ACRORD S ACRAPVT(ACRCAT,ACRORD,ACR,ACR1)=""
I '$D(ACRAPVT) W !!?5,"NO Signature Authorities assigned."
I $D(ACRAPVT) D
.N ACRCAT,ACRCATX
.S (ACRCAT,ACRCATX)=$O(ACRAPVT(0))
.D SIGHEAD
.S ACRCAT=0
.F S ACRCAT=$O(ACRAPVT(ACRCAT)) Q:'ACRCAT!$D(ACRQUIT)!$D(ACROUT) D
..I ACRCAT'=ACRCATX D SIGHEAD S ACRCATX=ACRCAT
..S ACRORD=0
..F S ACRORD=$O(ACRAPVT(ACRCAT,ACRORD)) Q:'ACRORD!$D(ACRQUIT)!$D(ACROUT) D
...S ACR=0
...F S ACR=$O(ACRAPVT(ACRCAT,ACRORD,ACR)) Q:'ACR!$D(ACRQUIT)!$D(ACROUT) D
....W !?5,$E($P(^ACRAPVT(ACR,0),U),1,25)
....S (ACRALT,ACRII)=0
....F ACRI=1:1 S ACRALT=$O(ACRAPVT(ACRCAT,ACRORD,ACR,ACRALT)) Q:'ACRALT&($S($D(ACRAPVT(ACRCAT,ACRORD,ACR))#2:$P(ACRAPVT(ACRCAT,ACRORD,ACR),U,ACRI)="",1:'ACRALT)) D
.....S:ACRALT="" ACRALT=999999
.....I $D(ACRAPVT(ACRCAT,ACRORD,ACR))#2,$P(ACRAPVT(ACRCAT,ACRORD,ACR),U,ACRI)]"" S ACRALTDA=$P(ACRAPVT(ACRCAT,ACRORD,ACR),U,ACRI) I ACRALTDA,$D(^VA(200,ACRALTDA,0)) D I 1
......;S ACRII=ACRII+1,ACRALTX=$P(^VA(200,ACRALTDA,0),U),ACRALTX=$P($P(ACRALTX,",",2)," ")_" "_$P(ACRALTX,",") W:ACRI>1 ! W ?31,$E(ACRALTX,1,23) ;ACR*2.1*19.02 IM16848
......S ACRII=ACRII+1 W:ACRI>1 ! W ?31,$E($$NAME3^ACRFUTL1(ACRALTDA),1,23) ;ACR*2.1*19.02 IM16848
.....E I ACRI<5 W:ACRI>1 ! W ?31,"_________________________" S ACRII=ACRII+1
.....E W:ACRI>1 !
.....;I ACRALT]"",$D(^VA(200,ACRALT,0)) S ACRALTX=$P(^(0),U),ACRALTX=$P($P(ACRALTX,",",2)," ")_" "_$P(ACRALTX,",") W ?57,$E(ACRALTX,1,25) ;ACR*2.1*19.02 IM16848
.....I ACRALT]"",$D(^VA(200,ACRALT,0)) W ?57,$E($$NAME3^ACRFUTL1(ACRALT),1,25) ;ACR*2.1*19.02 IM16848
....I ACRII<5 F ACRI=ACRII:1:3 W:ACRI>0 ! W ?31,"_________________________"
....W !
....I $D(IOSL),$Y>(IOSL-10) D PAUSE^ACRFWARN W @IOF D SIGHEAD
..I $E($G(IOST),1,2)="P-",$D(IOSL),$Y>(IOSL-10) W @IOF D NAME
Q:$D(ACRQUIT)!$D(ACROUT)
K ACR,ACRCAT,ACRALT,ACRALTX,ACRORD,ACRAPVT
I $D(^ACRUAL("LVL",ACRDUZ)) D I 1
.S ACRLVL=$O(^ACRUAL("LVL",ACRDUZ,0))
.I ACRLVL,$D(^ACRACC(ACRLVL,0)) D
..W !!?5,"ARMS SYSTEM ACCESS LEVEL ",$P(^ACRACC(ACRLVL,0),U,2)," (",$P(^(0),U,3),")"
E W !!?5,"NO ACCESS LEVEL ASSIGNED."
I $E($G(IOST),1,2)="P-",$D(IOSL),$Y>(IOSL-4) W @IOF D NAME
I '$D(^ACRLOCB("SEC",ACRDUZ)) W !!?5,ACRUSER," does not have access to any Department Accounts."
I $D(^ACRLOCB("SEC",ACRDUZ)) D
.D ACCHEAD
.S ACR=999999999
.F S ACR=$O(^ACRLOCB("SEC",ACRDUZ,ACR),-1) Q:'ACR!$D(ACRQUIT)!$D(ACROUT) D
..;Q:'$G(^ACRLOCB(ACR,0)) ;ACR*2.1*19.04 IM17697 ; ACR*2.1*20.09 IM18831
..Q:$G(^ACRLOCB(ACR,0))="" ; ACR*2.1*20.09 IM18831
..S ACRDEPT=$P(^ACRLOCB(ACR,0),U,5)
..S ACRSADA=$P(^ACRLOCB(ACR,0),U,4)
..S ACRSSADA=$P(^ACRLOCB(ACR,"DT"),U,8)
..S ACRFY=$P(^ACRLOCB(ACR,"DT"),U)
..Q:'$D(^AUTTPRG(+ACRDEPT,0))
..W !,ACRSADA,"-",ACR
..W ?15,$P(^AUTTPRG(ACRDEPT,0),U)
..W ?50,ACRFY
..I ACRSSADA,$D(^AUTTSSA(ACRSSADA,0)) W ?54,$P(^(0),U,4)
..I IOSL-4<$Y D
...D PAUSE^ACRFWARN
...D ACCHEAD:'$D(ACRQUIT)&'$D(ACROUT)
W !
D PAUSE^ACRFWARN
W !
D ^ACRFCAN
Q
ACCHEAD W @IOF
W !!,"Department Account access for: ",ACRUSER
W !!,"ID NO (SA/DA)"
W ?15,"ACCOUNT"
W ?50,"FY"
W ?54,"SUB-SUB-ACTIVITY"
W !,"-------------"
W ?15,"---------------------------------"
W ?50,"--"
W ?54,"----------------"
Q
NAME S D0=ACRDUZ
I '$D(^ACRAU(D0,0)) D
.S (X,DINUM)=D0
.S DIC="^ACRAU("
.S DIC(0)="L"
.D FILE^ACRFDIC
.S D0=ACRDUZ
N DXS,DIP,DC,DN
I D0,$D(^VA(200,D0,0)) D
.S Y=DT
.X ^DD("DD")
.W !?10,"ARMS USER PROFILE"
.W ?53,"DATE: ",Y
.W !?10,"-----------------"
.W ?59,"-----------"
.W !!
.D ^ACRPER
Q
SIGHEAD Q:$D(ACRQUIT)!$D(ACROUT)
W !!?5,"Your ",$P($P($P(^DD(9002190.5,.06,0),U,3),ACRCAT_":",2),";")
W !?5,"Signature Authorities"
W ?31,"Your alternates are:"
W ?57,"You may sign for:"
W !?5,"-------------------------"
W ?31,"-------------------------"
W ?57,"-----------------------"
Q
ACRFUP1 ;IHS/OIRM/DSD/THL,AEF - ARMS USER PROFILES; [ 07/20/2006 9:44 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**19,20**;NOV 05, 2001
+2 ;;CONTINUATION OF ACRFUP
PS1 ;EP;TO PRINT ARMS USER SUMMARY DATA
+1 IF $EXTRACT($GET(IOST),1,2)="C-"
WRITE @IOF
+2 DO NAME
+3 WRITE !!?5
+4 IF D0
IF $DATA(^VA(200,D0,20))
WRITE $SELECT($PIECE(^(20),U,4)="":"NO ",1:"")
+5 IF '$TEST
WRITE "NO "
+6 WRITE "Electronic Signature Code has been assigned."
+7 IF $PIECE($GET(^ACRAU(D0,1)),U,6)
WRITE !?5,"Government ATM card has been authorized."
+8 NEW ACRDA
+9 SET ACRDA=0
+10 KILL ACRAPVT
+11 FOR
SET ACRDA=$ORDER(^ACRAPL("B",ACRDUZ,ACRDA))
IF 'ACRDA!$DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
Begin DoDot:1
+12 SET ACR=$PIECE(^ACRAPL(ACRDA,0),U,2)
+13 IF 'ACR
Begin DoDot:2
+14 SET DA=ACRDA
+15 SET DIK="^ACRAPL("
+16 DO DIK^ACRFDIC
End DoDot:2
QUIT
+17 SET ACRCAT=$PIECE(^ACRAPVT(ACR,0),U,6)
+18 SET ACRORD=$PIECE(^ACRAPVT(ACR,0),U,4)
+19 IF ACRCAT
IF ACRORD
SET ACRAPVT(ACRCAT,ACRORD,ACR)=$GET(^ACRAPL(ACRDA,"DT"))
End DoDot:1
+20 SET ACR1=0
+21 FOR
SET ACR1=$ORDER(^ACRAPL("ALT",ACR1))
IF 'ACR1!$DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
Begin DoDot:1
+22 SET ACR=0
+23 FOR
SET ACR=$ORDER(^ACRAPL("ALT",ACR1,ACR))
IF 'ACR
QUIT
Begin DoDot:2
+24 SET ACRCAT=$PIECE(^ACRAPVT(ACR,0),U,6)
SET ACRORD=$PIECE(^(0),U,4)
IF $DATA(^ACRAPL("ALT",ACR1,ACR,ACRDUZ))
IF ACRCAT
IF ACRORD
SET ACRAPVT(ACRCAT,ACRORD,ACR,ACR1)=""
End DoDot:2
End DoDot:1
+25 IF '$DATA(ACRAPVT)
WRITE !!?5,"NO Signature Authorities assigned."
+26 IF $DATA(ACRAPVT)
Begin DoDot:1
+27 NEW ACRCAT,ACRCATX
+28 SET (ACRCAT,ACRCATX)=$ORDER(ACRAPVT(0))
+29 DO SIGHEAD
+30 SET ACRCAT=0
+31 FOR
SET ACRCAT=$ORDER(ACRAPVT(ACRCAT))
IF 'ACRCAT!$DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
Begin DoDot:2
+32 IF ACRCAT'=ACRCATX
DO SIGHEAD
SET ACRCATX=ACRCAT
+33 SET ACRORD=0
+34 FOR
SET ACRORD=$ORDER(ACRAPVT(ACRCAT,ACRORD))
IF 'ACRORD!$DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
Begin DoDot:3
+35 SET ACR=0
+36 FOR
SET ACR=$ORDER(ACRAPVT(ACRCAT,ACRORD,ACR))
IF 'ACR!$DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
Begin DoDot:4
+37 WRITE !?5,$EXTRACT($PIECE(^ACRAPVT(ACR,0),U),1,25)
+38 SET (ACRALT,ACRII)=0
+39 FOR ACRI=1:1
SET ACRALT=$ORDER(ACRAPVT(ACRCAT,ACRORD,ACR,ACRALT))
IF 'ACRALT&($SELECT($DATA(ACRAPVT(ACRCAT,ACRORD,ACR))#2
QUIT
Begin DoDot:5
+40 IF ACRALT=""
SET ACRALT=999999
+41 IF $DATA(ACRAPVT(ACRCAT,ACRORD,ACR))#2
IF $PIECE(ACRAPVT(ACRCAT,ACRORD,ACR),U,ACRI)]""
SET ACRALTDA=$PIECE(ACRAPVT(ACRCAT,ACRORD,ACR),U,ACRI)
IF ACRALTDA
IF $DATA(^VA(200,ACRALTDA,0))
Begin DoDot:6
+42 ;S ACRII=ACRII+1,ACRALTX=$P(^VA(200,ACRALTDA,0),U),ACRALTX=$P($P(ACRALTX,",",2)," ")_" "_$P(ACRALTX,",") W:ACRI>1 ! W ?31,$E(ACRALTX,1,23) ;ACR*2.1*19.02 IM16848
+43 ;ACR*2.1*19.02 IM16848
SET ACRII=ACRII+1
IF ACRI>1
WRITE !
WRITE ?31,$EXTRACT($$NAME3^ACRFUTL1(ACRALTDA),1,23)
End DoDot:6
IF 1
+44 IF '$TEST
IF ACRI<5
IF ACRI>1
WRITE !
WRITE ?31,"_________________________"
SET ACRII=ACRII+1
+45 IF '$TEST
IF ACRI>1
WRITE !
+46 ;I ACRALT]"",$D(^VA(200,ACRALT,0)) S ACRALTX=$P(^(0),U),ACRALTX=$P($P(ACRALTX,",",2)," ")_" "_$P(ACRALTX,",") W ?57,$E(ACRALTX,1,25) ;ACR*2.1*19.02 IM16848
+47 ;ACR*2.1*19.02 IM16848
IF ACRALT]""
IF $DATA(^VA(200,ACRALT,0))
WRITE ?57,$EXTRACT($$NAME3^ACRFUTL1(ACRALT),1,25)
End DoDot:5
+48 IF ACRII<5
FOR ACRI=ACRII:1:3
IF ACRI>0
WRITE !
WRITE ?31,"_________________________"
+49 WRITE !
+50 IF $DATA(IOSL)
IF $Y>(IOSL-10)
DO PAUSE^ACRFWARN
WRITE @IOF
DO SIGHEAD
End DoDot:4
End DoDot:3
+51 IF $EXTRACT($GET(IOST),1,2)="P-"
IF $DATA(IOSL)
IF $Y>(IOSL-10)
WRITE @IOF
DO NAME
End DoDot:2
End DoDot:1
+52 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+53 KILL ACR,ACRCAT,ACRALT,ACRALTX,ACRORD,ACRAPVT
+54 IF $DATA(^ACRUAL("LVL",ACRDUZ))
Begin DoDot:1
+55 SET ACRLVL=$ORDER(^ACRUAL("LVL",ACRDUZ,0))
+56 IF ACRLVL
IF $DATA(^ACRACC(ACRLVL,0))
Begin DoDot:2
+57 WRITE !!?5,"ARMS SYSTEM ACCESS LEVEL ",$PIECE(^ACRACC(ACRLVL,0),U,2)," (",$PIECE(^(0),U,3),")"
End DoDot:2
End DoDot:1
IF 1
+58 IF '$TEST
WRITE !!?5,"NO ACCESS LEVEL ASSIGNED."
+59 IF $EXTRACT($GET(IOST),1,2)="P-"
IF $DATA(IOSL)
IF $Y>(IOSL-4)
WRITE @IOF
DO NAME
+60 IF '$DATA(^ACRLOCB("SEC",ACRDUZ))
WRITE !!?5,ACRUSER," does not have access to any Department Accounts."
+61 IF $DATA(^ACRLOCB("SEC",ACRDUZ))
Begin DoDot:1
+62 DO ACCHEAD
+63 SET ACR=999999999
+64 FOR
SET ACR=$ORDER(^ACRLOCB("SEC",ACRDUZ,ACR),-1)
IF 'ACR!$DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
Begin DoDot:2
+65 ;Q:'$G(^ACRLOCB(ACR,0)) ;ACR*2.1*19.04 IM17697 ; ACR*2.1*20.09 IM18831
+66 ; ACR*2.1*20.09 IM18831
IF $GET(^ACRLOCB(ACR,0))=""
QUIT
+67 SET ACRDEPT=$PIECE(^ACRLOCB(ACR,0),U,5)
+68 SET ACRSADA=$PIECE(^ACRLOCB(ACR,0),U,4)
+69 SET ACRSSADA=$PIECE(^ACRLOCB(ACR,"DT"),U,8)
+70 SET ACRFY=$PIECE(^ACRLOCB(ACR,"DT"),U)
+71 IF '$DATA(^AUTTPRG(+ACRDEPT,0))
QUIT
+72 WRITE !,ACRSADA,"-",ACR
+73 WRITE ?15,$PIECE(^AUTTPRG(ACRDEPT,0),U)
+74 WRITE ?50,ACRFY
+75 IF ACRSSADA
IF $DATA(^AUTTSSA(ACRSSADA,0))
WRITE ?54,$PIECE(^(0),U,4)
+76 IF IOSL-4<$Y
Begin DoDot:3
+77 DO PAUSE^ACRFWARN
+78 IF '$DATA(ACRQUIT)&'$DATA(ACROUT)
DO ACCHEAD
End DoDot:3
End DoDot:2
End DoDot:1
+79 WRITE !
+80 DO PAUSE^ACRFWARN
+81 WRITE !
+82 DO ^ACRFCAN
+83 QUIT
ACCHEAD WRITE @IOF
+1 WRITE !!,"Department Account access for: ",ACRUSER
+2 WRITE !!,"ID NO (SA/DA)"
+3 WRITE ?15,"ACCOUNT"
+4 WRITE ?50,"FY"
+5 WRITE ?54,"SUB-SUB-ACTIVITY"
+6 WRITE !,"-------------"
+7 WRITE ?15,"---------------------------------"
+8 WRITE ?50,"--"
+9 WRITE ?54,"----------------"
+10 QUIT
NAME SET D0=ACRDUZ
+1 IF '$DATA(^ACRAU(D0,0))
Begin DoDot:1
+2 SET (X,DINUM)=D0
+3 SET DIC="^ACRAU("
+4 SET DIC(0)="L"
+5 DO FILE^ACRFDIC
+6 SET D0=ACRDUZ
End DoDot:1
+7 NEW DXS,DIP,DC,DN
+8 IF D0
IF $DATA(^VA(200,D0,0))
Begin DoDot:1
+9 SET Y=DT
+10 XECUTE ^DD("DD")
+11 WRITE !?10,"ARMS USER PROFILE"
+12 WRITE ?53,"DATE: ",Y
+13 WRITE !?10,"-----------------"
+14 WRITE ?59,"-----------"
+15 WRITE !!
+16 DO ^ACRPER
End DoDot:1
+17 QUIT
SIGHEAD IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+1 WRITE !!?5,"Your ",$PIECE($PIECE($PIECE(^DD(9002190.5,.06,0),U,3),ACRCAT_":",2),";")
+2 WRITE !?5,"Signature Authorities"
+3 WRITE ?31,"Your alternates are:"
+4 WRITE ?57,"You may sign for:"
+5 WRITE !?5,"-------------------------"
+6 WRITE ?31,"-------------------------"
+7 WRITE ?57,"-----------------------"
+8 QUIT
