PRCFFU22 ;WISC/SJG-FMS MO4, MO5 SEGMENTS ;11/26/93  15:35
V ;;5.1;IFCAP;;Oct 20, 2000
 ;Per VHA Directive 10-93-142, this routine should not be modified.
 ;
MO4 ;Build 'MO4' Segment
 ; 9.2  - PROMPT PAYMENT TERMS (442.06)
 ;  .01 - PROMPT PAYMENT PERCENT
 ;  1   - DAYS (TERM)
 ; Don't send if NET/30; exceptions only
MO4A I TYCODE="M" Q:'PRCFA("PPT")
 N SEG,DISCPER,DISCDAY,PER,DAY,DAYX,AUTOACC,PROXDAY,HIGH
 S TMPLINE=TMPLINE+1,SEG=""
 K PRCTMP N DA S DIC=442,DA=+PO,DIQ="PRCTMP(",DIQ(0)="IE",DR="9.2"
 S DR(442.06)=".01;1",(HIGH,DA(442.06))=$$HIGH(.RET) D EN^DIQ1 K DIC,DIQ,DR
 S (AUTOACC,DISCPER,DISCDAY,PROXDAY)=""
MO4B I TRCODE="SO"&((PRCFA("MP")=21)!(PRCFA("MP")=2)) S AUTOACC=PRCFA("AUTOACC")
 S DAY=$G(PRCTMP(442.06,HIGH,1,"E"))
 S DAYX=$E(DAY,$L(DAY)-1,$L(DAY))
 I "^st^ST^nd^ND^rd^RD^th^TH^"[DAYX S PROXDAY=+DAY
 I PROXDAY="" S DISCDAY=+DAY
 S PER=$G(PRCTMP(442.06,HIGH,.01,"E"))
 S DISCPER=$G(PRCTMP(442.06,HIGH,.01,"E"))
 I DISCPER="NET" S (DISCPER,DISCDAY)=""
 I DISCPER]"" S DISCPER=$FN(DISCPER,"",3)
 I (DISCPER="")&(DISCDAY="")&(AUTOACC="") S TMPLINE=TMPLINE-1 Q
 S $P(SEG,U,1)=DISCDAY,$P(SEG,U,2)=DISCPER
MO4C I TRCODE="SO"&((PRCFA("MP")=21)!(PRCFA("MP")=2)) S $P(SEG,U,7)=AUTOACC
 I +$G(PROXDAY) S $P(SEG,U,8)=PROXDAY
 S ^TMP($J,"PRCMO",INT,TMPLINE)="MO4^^"_SEG_"^~"
 Q
MO5 ; Build 'MO5' Segment
 N SEG
 S TMPLINE=TMPLINE+1,SEG=""
 S ^TMP($J,"PRCMO",INT,TMPLINE)="MO5^~"
 I SEG S ^TMP($J,"PRCMO",INT,TMPLINE)="MO5^"_SEG_"^~"
 Q
HIGH(RET) ; Determine largest Prompt Payment Terms 
 N LOOP,LOOP1,PPT,PPTVAL,PPTIEN
 S LOOP=0,LOOP1="",PPTIEN=1
 F  S LOOP=$O(^PRC(442,+PO,5,LOOP)) Q:'LOOP  D
 .S PPTVAL=^PRC(442,+PO,5,LOOP,0)
 .I +PPTVAL>0 S PPT(100-PPTVAL)=+PPTVAL_"^"_LOOP
 .Q
 I $D(PPT) S LOOP1=$O(PPT(LOOP1)),PPTIEN=$P(PPT(LOOP1),U,2)
 Q PPTIEN