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