- 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 ---[H[J[2J[HPRCOACT0 764 printed Feb 18, 2025@23:37:59 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 ;