ACRFUP.m

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