PRCHMESH.m

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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRCHMESH   1203     printed  Apr 09, 2024@21:06:56                                                                                                                                                                                                    Page 2

PRCHMESH  ;ISC2/RWS-TRANSMIT OHC,OHG & OHS TRANS TO MAILMAN ;3-26-92/11:12

V         ;;5.1;IFCAP;;Oct 20, 2000

 +1       ;Per VHA Directive 10-93-142, this routine should not be modified.

 +2       ;

READ      ; READ SYSID SEGMENT

 +1        SET X=$QUERY(@TRANSIN)

           SET SYSEG=@X

           SET ISNO=$PIECE(SYSEG,U,7)

 +2        SET ^XMB(3.9,XMZ,2,1,0)="     ISMS Order "_ISNO_" has been changed."

 +3        SET ^XMB(3.9,XMZ,2,2,0)=""

 +4        SET ^XMB(3.9,XMZ,2,3,0)=""

 +5        SET ^XMB(3.9,XMZ,2,4,0)=""

 +6        SET ^XMB(3.9,XMZ,2,5,0)=""

 +7        SET LIN=5

           FOR I=1:1:4

               SET X=$QUERY(@X)

               Begin DoDot:1

 +8                SET Y=@X

                   SET Z=$TEXT(TABLE+I)

                   SET Z=$PIECE(Z,";;",2)

                   FOR J=1:1

                       if $PIECE(Z,";",J)=""

                           QUIT 

                       Begin DoDot:2

 +9                        SET PAIR=$PIECE(Z,";",J)

                           SET FLDIN=$PIECE(PAIR,",",1)

                           SET FLDOUT=$PIECE(PAIR,",",2)

 +10                       SET DATA=$PIECE(Y,U,FLDIN)

                           if DATA=""

                               QUIT 

                           SET NAME=$SELECT($DATA(^DD(423,FLDOUT,0)):$PIECE(^(0),U),1:FLDOUT)

 +11                       SET LIN=LIN+1

                           SET ^XMB(3.9,XMZ,2,LIN,0)="  The new "_NAME_$EXTRACT("                    ",$LENGTH(NAME),20)_" is "_DATA_".  "

                       End DoDot:2

               End DoDot:1

               IF I=4

                   IF $QUERY(@X)='""

                       SET ERR="LINE COUNT ERROR"

                       QUIT 

 +12      ;

EXIT       KILL DATA,FIELD,FLDIN,FLDOUT

 +1        QUIT 

 +2       ;

TABLE     ;FIELD NAME LOOKUP TABLE  ;FIELD # WITHIN SEGMENT,POINTER TO FIELD NAME;

 +1       ;;9,578;11,580;12,581;13,582

 +2       ;;2,512.2;3,512.1;4,512.3;5,512.4;6,512.5;8,512.7;9,512.8;10,512.9

 +3       ;;2,513.1;3,513.2;4,513.3;5,513.4;6,513.5;8,513.7;9,513.8;10,513.9

 +4       ;;2,514.1;3,514.2;4,514.3;5,514.4;6,514.5;8,514.7;9,514.8;10,514.9