source: WorldVistAEHR/trunk/r/ENGINEERING-EN/ENFAXMT2.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.1 KB
RevLine 
[613]1ENFAXMT2 ;WASHINGTON IRMFO/KLD/DH/SAB; CREATE CODE SHEET ;12/16/1998
2 ;;7.0;ENGINEERING;**29,60**;Aug 17, 1993
3 ;This routine should not be modified.
4SEND ; Add code sheet to Generic Code Sheet (GCS) stack
5 ; create GCS code sheet
6 D CONTROL^GECSUFMS("E",ENFAP("SITE"),ENFAP("TRANS"),ENFAP("DOC"),ENFAP("AO"),0,"","ENFAXMT")
7 ; send remaining segments to GCS
8 F I=1:1:4 D:$D(X(I)) SETCS^GECSSTAA(GECSFMS("DA"),X(I))
9 ; save copy of code sheet in ENG log file
10 D @ENFAP("DOC")
11 ; set code sheet status to Queue on GCS stack
12 D SETSTAT^GECSSTAA(GECSFMS("DA"),"Q")
13 K GECSFMS
14 Q
15 ;
16FA ;copy FA
17 S ^ENG(6915.2,ENFA("DA"),1)=$P(GECSFMS("CTL"),"^~")
18 S ^ENG(6915.2,ENFA("DA"),2)=$P(GECSFMS("DOC"),U)
19 S ^ENG(6915.2,ENFA("DA"),3)=$P(X(1),U,1,9)_U_$P(X(1),U,11,20)_U_$P(X(1),U,22,32)_U_$P(X(1),U,21)
20 S ^ENG(6915.2,ENFA("DA"),6)=$P(X(3),"^~")
21 S ^ENG(6915.2,ENFA("DA"),7)=$P(X(4),U,1,2)_U_$P(X(4),U,10)
22 Q
23 ;
24FB ;copy FB
25 S ^ENG(6915.3,ENFB("DA"),1)=$P(GECSFMS("CTL"),"^~")
26 S ^ENG(6915.3,ENFB("DA"),2)=$P(GECSFMS("DOC"),U)
27 S ^ENG(6915.3,ENFB("DA"),3)=$P(X(1),U,1,4)_U_$P(X(1),U,10,17)
28 S ^ENG(6915.3,ENFB("DA"),4)=$P(X(2),U)_"^^^"_$P(X(2),U,8)
29 S ^ENG(6915.3,ENFB("DA"),5)=$P(X(3),"^~")
30 S ^ENG(6915.3,ENFB("DA"),6)=$P(X(4),U)_U_$P(X(4),U,2)_U_$P(X(4),U,10)
31 Q
32 ;
33FC ;copy FC
34 S ^ENG(6915.4,ENFC("DA"),1)=$P(GECSFMS("CTL"),"^~")
35 S ^ENG(6915.4,ENFC("DA"),2)=$P(GECSFMS("DOC"),U)
36 S ^ENG(6915.4,ENFC("DA"),3)=$P(X(1),U,1,4)_U_$P(X(1),U,10)_U_$P(X(1),U,12,21)
37 S ^ENG(6915.4,ENFC("DA"),4)=$P(X(2),U)_U_$P(X(2),U,6)_U_$P(X(2),U,8,10)_U_$P(X(2),U,12,18)_U_$P(X(2),U,20)_U_$P(X(2),U,22,24)
38 S ^ENG(6915.4,ENFC("DA"),5)=$P(X(3),"^~")
39 S ^ENG(6915.4,ENFC("DA"),6)=$P(X(4),U,1,2)_U_$P(X(4),U,10)
40 Q
41 ;
42FD ;copy FD
43 S ^ENG(6915.5,ENFD("DA"),1)=$P(GECSFMS("CTL"),"^~")
44 S ^ENG(6915.5,ENFD("DA"),2)=$P(GECSFMS("DOC"),U)
45 S ^ENG(6915.5,ENFD("DA"),3)=$P(X(1),U,1,4)_U_$P(X(1),U,10)
46 S ^ENG(6915.5,ENFD("DA"),4)=$P(X(3),"^~")
47 S ^ENG(6915.5,ENFD("DA"),5)=$P(X(4),"^~")
48 Q
49 ;
50FR ;copy FR
51 S ^ENG(6915.6,ENFR("DA"),1)=$P(GECSFMS("CTL"),"^~")
52 S ^ENG(6915.6,ENFR("DA"),2)=$P(GECSFMS("DOC"),U)
53 S ^ENG(6915.6,ENFR("DA"),3)=$P(X(1),U,1,4)_U_$P(X(1),U,10,13)_U_$P(X(1),U,15,24)
54 Q
55 ;ENFAXMT2
Note: See TracBrowser for help on using the repository browser.