Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRCOE2

PRCOE2.m

Go to the documentation of this file. 
  1. PRCOE2 ;WISC/DJM-IFCAP SEGMENTS IT,DE ;12/26/02  18:18
  1. V ;;5.1;IFCAP;**63,221**;Oct 20, 2000;Build 14
  1.  ;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  ;PRC*5.1*221 Modify an item description display to skip '|' logic
  1.  ;            if description contains a undefined display command
  1.  ;            like '| IN '
  1.  ;
  1.  ;;
  1.  ;;THIS ROUTINE AT THE 'IT' ENTRY POINT CREATES ONE 'IT' SEGMENTS FOR EACH
  1.  ;;ITEM IN THE P.O. TRANSACTION.  IT ALSO CREATES ALL THE 'DE' SEGMENTS
  1.  ;;NEEDED FOR EACH 'IT' SEGMENT.  THE LAST THING DONE IN THIS ROUTINE IS
  1.  ;;TO UPDATE THE 'HE' SEGMENT AT FIELD NAME 'LINE COUNT' TO REFLECT THE
  1.  ;;NUMBER OF 'IT' SEGMENTS IN THIS TRANSACTION.
  1.  ;;
  1.  ;;THIS ROUTINE CREATES THE 'COMMENTS' SEGMENT AT THE 'CO' ENTRY POINT.
  1.  ;;ADDITIONALLY, THE 'HE' SEGMENT AT THE FIELD NAME 'COMMENT COUNT' IS
  1.  ;;UPDATED TO REFLECT THE NUMBER OF 'CO' SEGMENTS CREATED.
  1.  ;;
  1. IT(VAR1,VAR2,TOTAL) ;ITEMS INFORMATION SEGMENT
  1.  N AZ,B,C,CN,DC,DE,DELDT,DIS,DIWF,DIWL,DIWR,FOBPOINT,FSC,HAZM,I0,I2
  1.  N I4,INC,INN,ITEM,ITEMCNT,J,LI,LIN,LOT,LPRC,LPRC1,M,MPN,MPNO,N,N1L
  1.  N NSN,UC,UNIT,UP,UPN,VPN,X,TD,SKU,SKUF,SERNO,SEQU,SCH
  1.  N SCHX,RP,PDA,OS,OT,IT,ICNT,PURPIPE,PRCHI,PRCHJ   ;PRC*5.1*221
  1.  S (ITEM,ITEMCNT)=0
  1.  S OS=$P($G(^PRC(442,VAR1,7)),"^",1)+0 ; order status
  1.  S TOTAL=$P($G(^PRC(442,VAR1,2,0)),U,4)+7
  1.  D PIPECK S ITEM=0  ;PRC*5.1*221
  1.  F  S ITEM=$O(^PRC(442,VAR1,2,ITEM)) Q:ITEM'>0  S ITEMCNT=ITEMCNT+1 D  Q:VAR2]""
  1.  .S I0=$G(^PRC(442,VAR1,2,ITEM,0))
  1.  .S I2=$G(^PRC(442,VAR1,2,ITEM,2))
  1.  .I I2="" S VAR2="NI2N^"_ITEM Q
  1.  .S I4=$G(^PRC(442,VAR1,2,ITEM,4))
  1.  .S NSN=$P(I0,U,13)
  1.  .S FSC=$P(I2,U,3)
  1.  .S FSC=$S(FSC]"":$P($G(^PRC(441.2,FSC,0)),U),1:"")
  1.  .S NSN=$S(NSN]"":NSN,1:FSC)
  1.  .S B="IT^"_$P(I0,U)_"^"_NSN_"^" ; FIELDS 1, 2, 3
  1.  .S RP=$P(I0,U,5)
  1.  .S INN=""
  1.  .S:RP>0 INN=$G(^PRC(441,RP,0))
  1.  .S INC=$P(INN,U,12)
  1.  .I $P(I0,U,13)="",INC="" S INC=77777
  1.  .S B=B_INC_"^" ; FIELD 4
  1.  .S VPN=$P(I0,U,6)
  1.  .S:$E(VPN,1)="#" VPN=$E(VPN,2,99)
  1.  .S B=B_VPN_"^" ; FIELD 5
  1.  .;
  1. IT0 .S MPN=$S(RP>0:$G(^PRC(441,RP,3)),1:"")
  1.  .I MPN="" S B=B_"^" G IT1 ; FIELD 6 - CONDITION 1
  1.  .S MPNO=$P(MPN,U,5)
  1.  .S:$E(MPNO,1)="#" MPNO=$E(MPNO,2,99)
  1.  .S B=B_MPNO_"^" ; FIELD 6 - CONDITION 2
  1.  .;
  1. IT1 .S N=$P(I0,U,15)
  1.  .I N]"" S N=$TR($P(N,"-",1,3),"-")
  1.  .S B=B_N_"^" ; FIELD 7 (NDC)
  1.  .;
  1.  .S Q=$P(I0,U,2)
  1.  .I OS=45 S Q=0 ; zero for cancelled orders
  1.  .I Q="" S VAR2="NQTY^"_$P(I0,U) Q
  1.  .S Q=Q\1+(Q#1>0)_"00"
  1.  .S B=B_Q_"^" ; FIELD 8 (quantity)
  1.  .;
  1.  .S UP=$P(I0,U,3)
  1.  .I UP="" S VAR2="NUOP^"_$P(I0,U) Q
  1.  .S UPN=$G(^PRCD(420.5,UP,0))
  1.  .I UPN="" S VAR2="NUPN^"_$P(I0,U) Q
  1.  .S UNIT=$P(UPN,U)
  1.  .I UNIT="" S VAR2="NUNI^"_$P(I0,U) Q
  1.  .S B=B_UNIT_"^" ; FIELD 9
  1.  .;
  1.  .S UC=$P(I0,U,9)
  1.  .I UC="" S VAR2="NAUC^"_$P(I0,U) Q
  1.  .I UC="N/C"!(OS=45) S UC=0 ; no charge or canceled
  1.  .S UC=$TR($J(UC,11,4)," .","0") ; pad and strip decimal point
  1.  .;
  1. IT2 .S B=B_UC_"^^" ; FIELDS 10, 11
  1.  .S LIN=$P(I0,U)
  1.  .S (DIS,TD)=0
  1.  .F  S DIS=$O(^PRC(442,VAR1,3,DIS)) G:DIS'>0 IT3 D   Q:LIN=LI
  1.  . .S DC=$G(^PRC(442,VAR1,3,DIS,0))
  1.  . .S LI=$P(DC,U,6)
  1.  . .Q
  1.  .S TD=1
  1.  .S PDA=$P(DC,U,2)
  1.  .I $E(PDA,1)'="$" D  G IT3
  1.  . .S N=$TR($J(PDA,5,2)," .","0")
  1.  . .S B=B_N_"^^" ; FIELDS 12, 13 - CONDITION 1
  1.  .S PDA=$E(PDA,2,99)
  1.  .S N=$TR($J(PDA,10,2)," .","0")
  1.  .S B=B_"^"_N_"^" ; FIELDS 12, 13 - CONDITION 2
  1.  .;
  1. IT3 .S:'TD B=B_"^^" ; FIELDS 12, 13 - CONDITION 3
  1.  .I $P(I0,U,16)>0 D
  1.  . .S SKU=$P(I0,U,16)
  1.  . .S SKU=$G(^PRCD(420.5,SKU,0))
  1.  . .S SKUF=$S($P(I0,U,17)>0:$P(I0,U,17),1:1)
  1.  . .S SKU=$P(SKU,U)
  1.  . .S B=B_SKU_"^"_SKUF_"^" ; FIELDS 14, 15 - CONDITION 1
  1.  .I $P(I0,U,16)'>0 S B=B_UNIT_"^1^" ; FIELDS 14, 15 - CONDITION 2
  1.  .;
  1. IT4 .S B=B_"^"_$S($P(I4,U,15)]"":$P(I4,U,15),1:"N")_"^"_$S($P(I4,U,16)]"":$P(I4,U,16),1:"N")_"^" ; FIELDS 16, 17, 18
  1.  .S CN=$P(I2,U,2)
  1.  .S OT=$P(^PRC(442,VAR1,1),U,7)
  1.  .S OT=","_OT_","
  1.  .S OT=$S(",1,4,6,10,"[OT:"D",1:"")
  1.  .I OT="D",CN="" S VAR2="NCNO^"_$P(I0,U) Q:VAR2]""
  1.  .S B=B_CN_"^" ; FIELD 19
  1.  .S LPRC=$P($G(^PRC(442,VAR1,1)),U,19)
  1.  .S LPRC1=""
  1.  .I LPRC>0 S LPRC1=$P($G(^PRC(443.8,LPRC,0)),U)
  1.  .I LPRC>0 S:LPRC1=10 LPRC1="A"
  1.  .S B=B_LPRC1_"^" ; FIELD 20
  1.  .;
  1. IT5 .S (IT,ICNT)=0
  1.  .S AZ=$G(^PRC(442,VAR1,2,ITEM,1,0))
  1.  .G:$P(AZ,U,4)'>0 IT6
  1.  .S DIWR=70
  1.  .S DIWL=1
  1.  .S DIWF=""
  1.  .S DE=0
  1.  .K ^UTILITY($J,"W")
  1.  .F  S DE=$O(^PRC(442,VAR1,2,ITEM,1,DE)) Q:DE=""  D
  1.  . .S X=$G(^PRC(442,VAR1,2,ITEM,1,DE,0))
  1.  . .S X=$S($D(X):X,1:"") S:PURPIPE DIWF=$G(DIWF)_"|"
  1.  . .D DIWP^PRCUTL($G(DA))
  1.  .S J=$G(^UTILITY($J,"W",1))
  1.  .G:J="" IT6
  1.  .I J>900 S J=900
  1.  .S IT=1
  1.  .S ICNT=""
  1.  .F I=1:1:J D
  1.  . .S N=$G(^UTILITY($J,"W",1,I,0)) S:$L(N)=0 N=" " S N=$TR(N,"^")
  1.  . .S M="DE^"_$P(I0,U)_"^"_I_"^"_N_"^|" ; DE SEGMENT FIELDS 1, 2, 3, 4, 5
  1.  . .S ^TMP($J,"STRING",ITEMCNT+6+I)=M
  1.  . .S TOTAL=TOTAL+1
  1.  . .S ICNT=ICNT+1
  1.  .K ^UTILITY($J,"W")
  1.  .;
  1. IT6 .S B=B_$S(IT:ICNT,1:0)_"^^" ; FIELDS 21, 22
  1.  .;
  1. IT7 .S LOT=$P(I4,U,17)
  1.  .S SERNO=$P(I4,U,18)
  1.  .S HAZM=$P(I2,U,14)
  1.  .S B=B_LOT_"^"_SERNO_"^"_HAZM_"^^" ; FIELDS 23, 24, 25, 26
  1.  .;
  1. IT8 .S IT=0
  1.  .S AZ=$P(^PRC(442,VAR1,0),U)
  1.  .S SCH=0
  1.  .S SEQU=0
  1.  .F  S SCH=$O(^PRC(442.8,"AC",AZ,ITEM,SCH)) Q:SCH=""  D
  1.  .  .S SCHX=$G(^PRC(442.8,SCH,0))
  1.  .  .Q:SCHX=""
  1.  .  .S SEQU=SEQU+1
  1.  .  .S IT=1
  1.  .  .S X=$P(SCHX,U,3)
  1.  .  .D JD^PRCFDLN
  1.  .  .S DELDT=$E(X,1,3)+1700_$E(Y,1,3)
  1.  .  .S M="SC^"_$P(I0,U)_"^"_SEQU_"^"_($P(SCHX,U,5)*100)_"^"_UNIT_"^"_DELDT_"^|"
  1.  .  .S ^TMP($J,"STRING",ITEMCNT+6+ICNT+SEQU)=M
  1.  .  .S TOTAL=TOTAL+1
  1. IT9 .S B=B_$S(IT:SEQU,1:0)_"^"_$P(INN,U,15)_"^|" ;FIELDS 27, 28, 29
  1.  .S ^TMP($J,"STRING",ITEMCNT+6)=B
  1.  .S ITEMCNT=ITEMCNT+ICNT+SEQU
  1.  .S B=^TMP($J,"STRING",1) ;ADD 1 TO HE SEGMENT FIELD 12
  1.  .S $P(B,U,12)=$P(B,U,12)+1
  1.  .S ^TMP($J,"STRING",1)=B
  1.  Q
  1. PIPECK ;check for invalid pipe '|IN ' command in item description   ;PRC*5.1*221
  1.  N PRCITEM
  1.  S PURPIPE=0,PRCITEM=0
  1.  F PRCHI=1:1 S PRCITEM=$O(^PRC(442,VAR1,2,PRCITEM)),PRCHDIW=0 Q:'PRCITEM  D  Q:PURPIPE
  1.  . F PRCHJ=1:1 S PRCHDIW=$O(^PRC(442,VAR1,2,PRCITEM,1,PRCHDIW)) Q:PRCHDIW'>0  S X=$S($D(^(PRCHDIW,0)):^(0),1:"") D  Q:PURPIPE
  1.  . . I X["| IN " S PURPIPE=1
  1.  . . Q
  1.  Q