- 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
