PRCOACT0.m

PRCOACT0 ;WISC - "ACT" & "PRJ" TRANSACTIONS CONT. ;8/5/96

 ;;5.1;IFCAP;;Oct 20, 2000

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

 ;

 ;called from routine PRCOACT

PERROR ;entry with PRCXM( array that contains error in processing

 ;entry will send mail group defined in 423.5 the error

 ;

 I '$O(PRCXM(0)) Q

 S PRCMG=$S('$D(PRCMG):.5,$E(PRCMG,1,2)'="G.":"G."_PRCMG,1:.5)

 S XMY(PRCMG)=""

 S XMDUZ="IFCAP SERVER PROCESSOR"

 S XMTEXT="PRCXM("

 S XMSUB="IFCAP EDI/RFQ MESSAGE ERROR"

 D ^XMD

 K XMY,XMDUZ,XMSUB,XMTEXT,PRCXM

 Q

 ;

EXTRL(V,T) ;Removes leading spaces or zeros.

 ;V=variable to be parced

 ;T=1 remove leading zeros, T="" remove leading spaces

 S T=$S($G(T):0,1:" ")

 F  Q:$E(V)'=T  S V=$E(V,2,$L(V))

 Q V

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRCOACT0   764     printed  Apr 09, 2024@21:00:44                                                                                                                                                                                                     Page 2

PRCOACT0  ;WISC - "ACT" & "PRJ" TRANSACTIONS CONT. ;8/5/96

 +1       ;;5.1;IFCAP;;Oct 20, 2000

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

 +3       ;

 +4       ;called from routine PRCOACT

PERROR    ;entry with PRCXM( array that contains error in processing

 +1       ;entry will send mail group defined in 423.5 the error

 +2       ;

 +3        IF '$ORDER(PRCXM(0))

               QUIT 

 +4        SET PRCMG=$SELECT('$DATA(PRCMG):.5,$EXTRACT(PRCMG,1,2)'="G.":"G."_PRCMG,1:.5)

 +5        SET XMY(PRCMG)=""

 +6        SET XMDUZ="IFCAP SERVER PROCESSOR"

 +7        SET XMTEXT="PRCXM("

 +8        SET XMSUB="IFCAP EDI/RFQ MESSAGE ERROR"

 +9        DO ^XMD

 +10       KILL XMY,XMDUZ,XMSUB,XMTEXT,PRCXM

 +11       QUIT 

 +12      ;

EXTRL(V,T) ;Removes leading spaces or zeros.

 +1       ;V=variable to be parced

 +2       ;T=1 remove leading zeros, T="" remove leading spaces

 +3        SET T=$SELECT($GET(T):0,1:" ")

 +4        FOR 

               if $EXTRACT(V)'=T

                   QUIT 

               SET V=$EXTRACT(V,2,$LENGTH(V))

 +5        QUIT V

 +6       ;