- ACRFUP ;IHS/OIRM/DSD/THL,AEF - ARMS USER PROFILES; [ 09/26/2005 9:44 AM ]
- ;;2.1;ADMIN RESOURCE MGT SYSTEM;**19**;NOV 05, 2001
- ;;ROUTINE USED TO DISPLAY ARMS USER PROFILES
- EN F D EN1 Q:$D(ACRQUIT)!$D(ACROUT)
- K ACR,ACRDUZ,ACRUSER,ACRUP
- Q
- EN1 ;EP;TO SELECT ARMS USER(S) FOR DATA DISPLAY
- W @IOF
- W !?10,"PRINT ARMS USER PROFILES"
- S DIR(0)="SO^1:Individual User;2:Department Account"
- S DIR("A")="Which one"
- D DIR^ACRFDIC
- Q:$D(ACRQUIT)!$D(ACROUT)
- I Y=1 D SELECT K ACRQUIT Q
- I Y=2 D
- .S ACRUP=""
- .D OBLAMT^ACRFDTPE
- .D DEPT:ACRUP
- .K ACRQUIT
- Q
- SELECT ;EP;TO SELECT ARMS USER VIA LOOKUP TO THE USER FILE
- S DIC="^VA(200,"
- S DIC(0)="AEMQZ"
- S DIC("A")="EMPLOYEE............: "
- S DIC("DR")=""
- W !!?21,"|"
- F ACRI=1:1:30 W "="
- W "|"
- D DIC^ACRFDIC
- I U[$E(X)!(+Y<1) S ACRQUIT="" Q
- N ACRDA
- S ACRDUZ=+Y
- ; S ACRUSER=Y(0,0) ;ACR*2.1*19.02 IM16848
- ; S ACRUSER=$P(ACRUSER,",",2)_" "_$P(ACRUSER,",") ;ACR*2.1*19.02 IM16848
- S ACRUSER=$$NAME3^ACRFUTL1(+Y) ;ACR*2.1*19.02 IM16848
- S ACRDA=ACRDUZ
- D PSUM
- Q
- DEPT ;PRINT ARMS USER PROFILE FOR ALL WITH DEPARTMENT ACCOUNT ACCESS
- S ZTDESC="ARMS USER DATA SUMMARY BY DEPARTMENT ACCOUNT"
- S ZTSAVE("ACR*")=""
- S ACRRTN="DEPT1^ACRFUP"
- D ^ACRFZIS
- Q
- DEPT1 S ACRZA=0
- F S ACRZA=$O(^ACRLOCB(ACRUP,"SC",ACRZA)) Q:'ACRZA!$D(ACRQUIT)!$D(ACROUT) D
- .I $D(^ACRLOCB(ACRUP,"SC",ACRZA,0)) S (ACRDUZ,ACRZDA)=+^(0) D
- ..Q:'$D(^VA(200,+ACRZDA,0))
- ..; S ACRUSER=$P(^VA(200,ACRZDA,0),U) ;ACR*2.1*19.02 IM16848
- ..; S ACRUSER=$P(ACRUSER,",",2)_" "_$P(ACRUSER,",") ;ACR*2.1*19.02 IM16848
- ..S ACRUSER=$$NAME3^ACRFUTL1(ACRZDA) ;ACR*2.1*19.02 IM16848
- ..D PS1^ACRFUP1
- K ACRZA
- Q
- PSUM ;EP;TO DISPLAY ARMS USER DATA
- S ZTDESC="ARMS USER DATA SUMMARY"
- S ZTSAVE("ACR*")=""
- S ACRRTN="PS1^ACRFUP1"
- D ^ACRFZIS
- Q
- PS1 ;EP;TO PRINT ARMS USER SUMMARY DATA
- D PS1^ACRFUP1
- Q
- ACRFUP ;IHS/OIRM/DSD/THL,AEF - ARMS USER PROFILES; [ 09/26/2005 9:44 AM ]
- +1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**19**;NOV 05, 2001
- +2 ;;ROUTINE USED TO DISPLAY ARMS USER PROFILES
- EN FOR
- DO EN1
- IF $DATA(ACRQUIT)!$DATA(ACROUT)
- QUIT
- +1 KILL ACR,ACRDUZ,ACRUSER,ACRUP
- +2 QUIT
- EN1 ;EP;TO SELECT ARMS USER(S) FOR DATA DISPLAY
- +1 WRITE @IOF
- +2 WRITE !?10,"PRINT ARMS USER PROFILES"
- +3 SET DIR(0)="SO^1:Individual User;2:Department Account"
- +4 SET DIR("A")="Which one"
- +5 DO DIR^ACRFDIC
- +6 IF $DATA(ACRQUIT)!$DATA(ACROUT)
- QUIT
- +7 IF Y=1
- DO SELECT
- KILL ACRQUIT
- QUIT
- +8 IF Y=2
- Begin DoDot:1
- +9 SET ACRUP=""
- +10 DO OBLAMT^ACRFDTPE
- +11 IF ACRUP
- DO DEPT
- +12 KILL ACRQUIT
- End DoDot:1
- +13 QUIT
- SELECT ;EP;TO SELECT ARMS USER VIA LOOKUP TO THE USER FILE
- +1 SET DIC="^VA(200,"
- +2 SET DIC(0)="AEMQZ"
- +3 SET DIC("A")="EMPLOYEE............: "
- +4 SET DIC("DR")=""
- +5 WRITE !!?21,"|"
- +6 FOR ACRI=1:1:30
- WRITE "="
- +7 WRITE "|"
- +8 DO DIC^ACRFDIC
- +9 IF U[$EXTRACT(X)!(+Y<1)
- SET ACRQUIT=""
- QUIT
- +10 NEW ACRDA
- +11 SET ACRDUZ=+Y
- +12 ; S ACRUSER=Y(0,0) ;ACR*2.1*19.02 IM16848
- +13 ; S ACRUSER=$P(ACRUSER,",",2)_" "_$P(ACRUSER,",") ;ACR*2.1*19.02 IM16848
- +14 ;ACR*2.1*19.02 IM16848
- SET ACRUSER=$$NAME3^ACRFUTL1(+Y)
- +15 SET ACRDA=ACRDUZ
- +16 DO PSUM
- +17 QUIT
- DEPT ;PRINT ARMS USER PROFILE FOR ALL WITH DEPARTMENT ACCOUNT ACCESS
- +1 SET ZTDESC="ARMS USER DATA SUMMARY BY DEPARTMENT ACCOUNT"
- +2 SET ZTSAVE("ACR*")=""
- +3 SET ACRRTN="DEPT1^ACRFUP"
- +4 DO ^ACRFZIS
- +5 QUIT
- DEPT1 SET ACRZA=0
- +1 FOR
- SET ACRZA=$ORDER(^ACRLOCB(ACRUP,"SC",ACRZA))
- IF 'ACRZA!$DATA(ACRQUIT)!$DATA(ACROUT)
- QUIT
- Begin DoDot:1
- +2 IF $DATA(^ACRLOCB(ACRUP,"SC",ACRZA,0))
- SET (ACRDUZ,ACRZDA)=+^(0)
- Begin DoDot:2
- +3 IF '$DATA(^VA(200,+ACRZDA,0))
- QUIT
- +4 ; S ACRUSER=$P(^VA(200,ACRZDA,0),U) ;ACR*2.1*19.02 IM16848
- +5 ; S ACRUSER=$P(ACRUSER,",",2)_" "_$P(ACRUSER,",") ;ACR*2.1*19.02 IM16848
- +6 ;ACR*2.1*19.02 IM16848
- SET ACRUSER=$$NAME3^ACRFUTL1(ACRZDA)
- +7 DO PS1^ACRFUP1
- End DoDot:2
- End DoDot:1
- +8 KILL ACRZA
- +9 QUIT
- PSUM ;EP;TO DISPLAY ARMS USER DATA
- +1 SET ZTDESC="ARMS USER DATA SUMMARY"
- +2 SET ZTSAVE("ACR*")=""
- +3 SET ACRRTN="PS1^ACRFUP1"
- +4 DO ^ACRFZIS
- +5 QUIT
- PS1 ;EP;TO PRINT ARMS USER SUMMARY DATA
- +1 DO PS1^ACRFUP1
- +2 QUIT
