| 1 | PRCHMESH ;ISC2/RWS-TRANSMIT OHC,OHG & OHS TRANS TO MAILMAN ;3-26-92/11:12
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | READ ; READ SYSID SEGMENT
|
|---|
| 6 | S X=$Q(@TRANSIN),SYSEG=@X,ISNO=$P(SYSEG,U,7)
|
|---|
| 7 | S ^XMB(3.9,XMZ,2,1,0)=" ISMS Order "_ISNO_" has been changed."
|
|---|
| 8 | S ^XMB(3.9,XMZ,2,2,0)=""
|
|---|
| 9 | S ^XMB(3.9,XMZ,2,3,0)=""
|
|---|
| 10 | S ^XMB(3.9,XMZ,2,4,0)=""
|
|---|
| 11 | S ^XMB(3.9,XMZ,2,5,0)=""
|
|---|
| 12 | S LIN=5 F I=1:1:4 S X=$Q(@X) D I I=4,$Q(@X)='"" S ERR="LINE COUNT ERROR" Q
|
|---|
| 13 | .S Y=@X,Z=$T(TABLE+I),Z=$P(Z,";;",2) F J=1:1 Q:$P(Z,";",J)="" D
|
|---|
| 14 | ..S PAIR=$P(Z,";",J),FLDIN=$P(PAIR,",",1),FLDOUT=$P(PAIR,",",2)
|
|---|
| 15 | ..S DATA=$P(Y,U,FLDIN) Q:DATA="" S NAME=$S($D(^DD(423,FLDOUT,0)):$P(^(0),U),1:FLDOUT)
|
|---|
| 16 | ..S LIN=LIN+1,^XMB(3.9,XMZ,2,LIN,0)=" The new "_NAME_$E(" ",$L(NAME),20)_" is "_DATA_". "
|
|---|
| 17 | ;
|
|---|
| 18 | EXIT K DATA,FIELD,FLDIN,FLDOUT
|
|---|
| 19 | Q
|
|---|
| 20 | ;
|
|---|
| 21 | TABLE ;FIELD NAME LOOKUP TABLE ;FIELD # WITHIN SEGMENT,POINTER TO FIELD NAME;
|
|---|
| 22 | ;;9,578;11,580;12,581;13,582
|
|---|
| 23 | ;;2,512.2;3,512.1;4,512.3;5,512.4;6,512.5;8,512.7;9,512.8;10,512.9
|
|---|
| 24 | ;;2,513.1;3,513.2;4,513.3;5,513.4;6,513.5;8,513.7;9,513.8;10,513.9
|
|---|
| 25 | ;;2,514.1;3,514.2;4,514.3;5,514.4;6,514.5;8,514.7;9,514.8;10,514.9
|
|---|
