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 ;;
