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