source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCHMESH.m@ 1141

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

initial load of WorldVistAEHR

File size: 1.2 KB
Line 
1PRCHMESH ;ISC2/RWS-TRANSMIT OHC,OHG & OHS TRANS TO MAILMAN ;3-26-92/11:12
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5READ ; 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 ;
18EXIT K DATA,FIELD,FLDIN,FLDOUT
19 Q
20 ;
21TABLE ;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
Note: See TracBrowser for help on using the repository browser.