PRCHMESE.m

PRCHMESE ;ISC2/RWS-TRANSMIT OPE TRANSACTIONS TO MAILMAN ;5-8-92/13:06

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

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

READ ; READ SYSID AND LINE COUNT SEGMENTS

 S X=$Q(@TRANSIN),SYSEG=@X

 S X=$Q(@X),LCSEG=@X I $P(LCSEG,U,1)'="LC" S ERR="SEGMENT TYPE SHOULD BE LC" Q

 S LCNT=$P(LCSEG,U,2),ISNO=$P(SYSEG,U,7),IFNO=$TR($P(LCSEG,U,3)," "),LN=$L(IFNO),IFNO=$P(SYSEG,U,3)_"-"_$E(IFNO,1,LN)

 S ^XMB(3.9,XMZ,2,1,0)="   There was an error on IFCAP Requisition Number "_IFNO

 S ^XMB(3.9,XMZ,2,2,0)="    These line items must be deleted from the PO and reordered.  "

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

 S ^XMB(3.9,XMZ,2,4,0)=" Line # - National Stock # - Quantity - Invalid Field    -     Invalid Data "

 S ^XMB(3.9,XMZ,2,5,0)=""

 S LIN=5 F I=1:1:LCNT S X=$Q(@X) D  I $Q(@X)="" S ERR="LINE COUNT ERROR" Q

 .S Y=@X,Y(2)=$P(Y,U,2),Y(3)=$P(Y,U,3),Y(4)=$P(Y,U,4)/100,Y(5)=$P(Y,U,5),Y(6)=$P(Y,U,6)

 .S Y(2)=$E(Y(2),1,4)_"-"_$E(Y(2),5,6)_"-"_$E(Y(2),7,9)_"-"_$E(Y(2),10,20)

 .S Y=$J(Y(3),3)_$J(Y(2),22)_$J(Y(4),10)_"     "_Y(5)_$E("                    ",$L(Y(5)),20)_"  "_Y(6)

 .S LIN=LIN+1,^XMB(3.9,XMZ,2,LIN,0)=Y

EXIT Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRCHMESE   1163     printed  Feb 18, 2025@23:35:04                                                                                                                                                                                                    Page 2

PRCHMESE  ;ISC2/RWS-TRANSMIT OPE TRANSACTIONS TO MAILMAN ;5-8-92/13:06

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

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

READ      ; READ SYSID AND LINE COUNT SEGMENTS

 +1        SET X=$QUERY(@TRANSIN)

           SET SYSEG=@X

 +2        SET X=$QUERY(@X)

           SET LCSEG=@X

           IF $PIECE(LCSEG,U,1)'="LC"

               SET ERR="SEGMENT TYPE SHOULD BE LC"

               QUIT 

 +3        SET LCNT=$PIECE(LCSEG,U,2)

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

           SET IFNO=$TRANSLATE($PIECE(LCSEG,U,3)," ")

           SET LN=$LENGTH(IFNO)

           SET IFNO=$PIECE(SYSEG,U,3)_"-"_$EXTRACT(IFNO,1,LN)

 +4        SET ^XMB(3.9,XMZ,2,1,0)="   There was an error on IFCAP Requisition Number "_IFNO

 +5        SET ^XMB(3.9,XMZ,2,2,0)="    These line items must be deleted from the PO and reordered.  "

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

 +7        SET ^XMB(3.9,XMZ,2,4,0)=" Line # - National Stock # - Quantity - Invalid Field    -     Invalid Data "

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

 +9        SET LIN=5

           FOR I=1:1:LCNT

               SET X=$QUERY(@X)

               Begin DoDot:1

 +10               SET Y=@X

                   SET Y(2)=$PIECE(Y,U,2)

                   SET Y(3)=$PIECE(Y,U,3)

                   SET Y(4)=$PIECE(Y,U,4)/100

                   SET Y(5)=$PIECE(Y,U,5)

                   SET Y(6)=$PIECE(Y,U,6)

 +11               SET Y(2)=$EXTRACT(Y(2),1,4)_"-"_$EXTRACT(Y(2),5,6)_"-"_$EXTRACT(Y(2),7,9)_"-"_$EXTRACT(Y(2),10,20)

 +12               SET Y=$JUSTIFY(Y(3),3)_$JUSTIFY(Y(2),22)_$JUSTIFY(Y(4),10)_"     "_Y(5)_$EXTRACT("                    ",$LENGTH(Y(5)),20)_"  "_Y(6)

 +13               SET LIN=LIN+1

                   SET ^XMB(3.9,XMZ,2,LIN,0)=Y

               End DoDot:1

               IF $QUERY(@X)=""

                   SET ERR="LINE COUNT ERROR"

                   QUIT 

EXIT       QUIT