ACRFCAN.m

ACRFCAN ;IHS/OIRM/DSD/THL,AEF - DEFAULT CAN SUMMARY FOR ARMS USER; [ 11/01/2001   9:44 AM ]

 ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001

 ;;SUMMARIZES DEFAULT CAN SIGNATURES FOR ARMS USER

EN ;EP;

 D EN1

EXIT K ACR,ACRDA,ACRDFLT,ACRDFLT1,ACRI,ACRJ,ACRX,^TMP("ACRCAN",$J),ACRTYP

 Q

EN1 ;

 K ^TMP("ACRCAN",$J)

 S ACR=U_ACRDUZ_U

 S ACRDA=0

 F  S ACRDA=$O(^ACRCAN(ACRDA)) Q:'ACRDA  D

 .S ACRDFLT=U_$G(^ACRCAN(ACRDA,"DFLT"))_U,ACRDFLT1=U_$G(^ACRCAN(ACRDA,"DFLT1"))_U

 .S ACRCAN=$P(^AUTTCAN(ACRDA,0),U)

 .I ACRDFLT[ACR D

 ..F ACRI=1:1:10,14,15,20,24,25,27:1:30 I ACRDUZ=$P(ACRDFLT,U,ACRI+1) D

 ...S ACRX=$P($T(@ACRI),";;",2)

 ...S:ACRX ACRX=$P(^DD(9002186.5,ACRX,0),U)

 ...S:ACRX]"" ^TMP("ACRCAN",$J,ACRCAN,ACRX)=""

 .I ACRDFLT1[ACR D

 ..F ACRI=3,4,7:1:14,16:1:30 I ACRDUZ=$P(ACRDFLT1,U,ACRI+1) D

 ...S ACRJ=ACRI+100,ACRX=$P($T(@ACRJ),";;",2)

 ...S:ACRX ACRX=$P(^DD(9002186.5,ACRX,0),U)

 ...S:ACRX]"" ^TMP("ACRCAN",$J,ACRCAN,ACRX)=""

 I '$D(^TMP("ACRCAN",$J)) W @IOF Q

 D HEAD

 S ACRCAN=""

 F  S ACRCAN=$O(^TMP("ACRCAN",$J,ACRCAN)) Q:ACRCAN=""!$D(ACRQUIT)  D

 .S ACRI=0

 .S ACRTYP=""

 .F  S ACRTYP=$O(^TMP("ACRCAN",$J,ACRCAN,ACRTYP)) Q:ACRTYP=""!$D(ACRQUIT)  D

 ..S ACRI=ACRI+1

 ..W:ACRI=1 !?10,ACRCAN

 ..W:ACRI>1 !

 ..W ?20,ACRTYP

 ..I IOSL-4<$Y D PAUSE^ACRFWARN,HEAD

 D PAUSE^ACRFWARN

 Q

HEAD ;

 W @IOF

 W !?10,"CAN's and SIGNATURE TYPE's for which ",ACRUSER

 W !?10,"is the default signatore."

 W !!?10,"CAN"

 W ?20,"SIGNATURE TYPE"

 W !?10,"-------"

 W ?20,"-------------------------"

 Q

1 ;;1000

2 ;;1010

3 ;;1020

4 ;;1030

5 ;;1040

6 ;;1050

7 ;;1060

8 ;;1070

9 ;;1080

10 ;;

11 ;;

12 ;;

13 ;;

14 ;;

15 ;;1140

16 ;;

17 ;;

18 ;;1170

19 ;;

20 ;;1190

21 ;;

22 ;;

23 ;;

24 ;;1230

25 ;;1240

26 ;;

27 ;;

28 ;;

29 ;;

30 ;;

101 ;;

102 ;;

103 ;;1250

104 ;;1260

105 ;;

106 ;;

107 ;;1081

108 ;;1032

109 ;;

110 ;;1300

111 ;;1310

112 ;;1320

113 ;;1330

114 ;;1340

115 ;;1350

116 ;;1360

117 ;;1370

118 ;;1380

119 ;;1390

120 ;;1400

121 ;;1410

122 ;;1420

123 ;;1430

124 ;;1440

125 ;;1450;;Travel Procurement Official

126 ;;

127 ;;

128 ;;

129 ;;

130 ;;

ACRFCAN   ;IHS/OIRM/DSD/THL,AEF - DEFAULT CAN SUMMARY FOR ARMS USER; [ 11/01/2001   9:44 AM ]

 +1       ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001

 +2       ;;SUMMARIZES DEFAULT CAN SIGNATURES FOR ARMS USER

EN        ;EP;

 +1        DO EN1

EXIT       KILL ACR,ACRDA,ACRDFLT,ACRDFLT1,ACRI,ACRJ,ACRX,^TMP("ACRCAN",$JOB),ACRTYP

 +1        QUIT 

EN1       ;

 +1        KILL ^TMP("ACRCAN",$JOB)

 +2        SET ACR=U_ACRDUZ_U

 +3        SET ACRDA=0

 +4        FOR 

               SET ACRDA=$ORDER(^ACRCAN(ACRDA))

               IF 'ACRDA

                   QUIT 

               Begin DoDot:1

 +5                SET ACRDFLT=U_$GET(^ACRCAN(ACRDA,"DFLT"))_U

                   SET ACRDFLT1=U_$GET(^ACRCAN(ACRDA,"DFLT1"))_U

 +6                SET ACRCAN=$PIECE(^AUTTCAN(ACRDA,0),U)

 +7                IF ACRDFLT[ACR

                       Begin DoDot:2

 +8                        FOR ACRI=1:1:10,14,15,20,24,25,27:1:30

                               IF ACRDUZ=$PIECE(ACRDFLT,U,ACRI+1)

                                   Begin DoDot:3

 +9                                    SET ACRX=$PIECE($TEXT(@ACRI),";;",2)

 +10                                   IF ACRX

                                           SET ACRX=$PIECE(^DD(9002186.5,ACRX,0),U)

 +11                                   IF ACRX]""

                                           SET ^TMP("ACRCAN",$JOB,ACRCAN,ACRX)=""

                                   End DoDot:3

                       End DoDot:2

 +12               IF ACRDFLT1[ACR

                       Begin DoDot:2

 +13                       FOR ACRI=3,4,7:1:14,16:1:30

                               IF ACRDUZ=$PIECE(ACRDFLT1,U,ACRI+1)

                                   Begin DoDot:3

 +14                                   SET ACRJ=ACRI+100

                                       SET ACRX=$PIECE($TEXT(@ACRJ),";;",2)

 +15                                   IF ACRX

                                           SET ACRX=$PIECE(^DD(9002186.5,ACRX,0),U)

 +16                                   IF ACRX]""

                                           SET ^TMP("ACRCAN",$JOB,ACRCAN,ACRX)=""

                                   End DoDot:3

                       End DoDot:2

               End DoDot:1

 +17       IF '$DATA(^TMP("ACRCAN",$JOB))

               WRITE @IOF

               QUIT 

 +18       DO HEAD

 +19       SET ACRCAN=""

 +20       FOR 

               SET ACRCAN=$ORDER(^TMP("ACRCAN",$JOB,ACRCAN))

               IF ACRCAN=""!$DATA(ACRQUIT)

                   QUIT 

               Begin DoDot:1

 +21               SET ACRI=0

 +22               SET ACRTYP=""

 +23               FOR 

                       SET ACRTYP=$ORDER(^TMP("ACRCAN",$JOB,ACRCAN,ACRTYP))

                       IF ACRTYP=""!$DATA(ACRQUIT)

                           QUIT 

                       Begin DoDot:2

 +24                       SET ACRI=ACRI+1

 +25                       IF ACRI=1

                               WRITE !?10,ACRCAN

 +26                       IF ACRI>1

                               WRITE !

 +27                       WRITE ?20,ACRTYP

 +28                       IF IOSL-4<$Y

                               DO PAUSE^ACRFWARN

                               DO HEAD

                       End DoDot:2

               End DoDot:1

 +29       DO PAUSE^ACRFWARN

 +30       QUIT 

HEAD      ;

 +1        WRITE @IOF

 +2        WRITE !?10,"CAN's and SIGNATURE TYPE's for which ",ACRUSER

 +3        WRITE !?10,"is the default signatore."

 +4        WRITE !!?10,"CAN"

 +5        WRITE ?20,"SIGNATURE TYPE"

 +6        WRITE !?10,"-------"

 +7        WRITE ?20,"-------------------------"

 +8        QUIT 

1         ;;1000

2         ;;1010

3         ;;1020

4         ;;1030

5         ;;1040

6         ;;1050

7         ;;1060

8         ;;1070

9         ;;1080

10        ;;

11        ;;

12        ;;

13        ;;

14        ;;

15        ;;1140

16        ;;

17        ;;

18        ;;1170

19        ;;

20        ;;1190

21        ;;

22        ;;

23        ;;

24        ;;1230

25        ;;1240

26        ;;

27        ;;

28        ;;

29        ;;

30        ;;

101       ;;

102       ;;

103       ;;1250

104       ;;1260

105       ;;

106       ;;

107       ;;1081

108       ;;1032

109       ;;

110       ;;1300

111       ;;1310

112       ;;1320

113       ;;1330

114       ;;1340

115       ;;1350

116       ;;1360

117       ;;1370

118       ;;1380

119       ;;1390

120       ;;1400

121       ;;1410

122       ;;1420

123       ;;1430

124       ;;1440

125       ;;1450;;Travel Procurement Official

126       ;;

127       ;;

128       ;;

129       ;;

130       ;;