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

PRCOEDI.m

Go to the documentation of this file.
  1. PRCOEDI ;WISC/DJM-IFCAP EDI ENTRY ROUTINE ; 7/21/99 11:24am
  1. V ;;5.1;IFCAP;;Oct 20, 2000
  1. ;Per VHA Directive 10-93-142, this routine should not be modified.
  1. ;
  1. ; Receives variable PRCOPODA from calling routines.
  1. ;
  1. ; PRCOPODA = sting of up to 4 '^' pieces.
  1. ; piece 1 = ien of 442 record
  1. ; piece 2 = (optional) flag if not new order
  1. ; piece 3 = (optional) amendment number
  1. ; piece 4 = (optional) ien of 442 record if
  1. ; amendment is PO number change
  1. ;
  1. ; piece 2 flag values:
  1. ; 1 = create a PHM, do not transmit to EDI
  1. ; 2 = create a PHA, do not transmit to EDI
  1. ;
  1. NEW N A,AMEND,A1,A12,CSDA,IEN,MO,PRC,PRCFA,PRCFASYS,PRCPXMZ,PTSW,RECORD
  1. N REQUEST,SERVICE,TEST,TOTAL,VAR1,VAR2,VAR3,VEN,V1,V2,V3,V4,V5,V6
  1. N W1,W2,YR,XMZ
  1. S VAR1=$P(PRCOPODA,"^",1)
  1. S W2="PHA"
  1. I $P(PRCOPODA,"^",2)=1 S W2="PHM"
  1. S AMEND=0
  1. I $P(PRCOPODA,"^",2)]"" S AMEND=1 ; amendment, don't send to EDI
  1. S A=$G(^PRC(442,VAR1,0))
  1. I A="" W:'AMEND W2," not generated - purchase order corrupted.",!! Q
  1. S PRC("SITE")=$P($P(A,U),"-")
  1. S YR=$E(DT,2,3)
  1. S MO=$E(DT,4,5)
  1. S PRC("FY")=$E(100+$S(MO>9:YR+1,1:YR),2,3)
  1. S SERVICE=$P(A,U,12)
  1. I SERVICE>0 D I $G(REQUEST)=3 W:'AMEND W2," not generated - inappropriate for this order.",!! Q
  1. . S RECORD=$G(^PRC(442,VAR1,13,SERVICE,0))
  1. . I RECORD]"" S REQUEST=$P(RECORD,U,9)
  1. S A1=$G(^PRC(442,VAR1,1))
  1. I A1="" W:'AMEND W2," not generated - PO informated corrupted",!! Q
  1. I $P(A1,U,7)=1 W W2," not generated - not used for GSA Supply Depot orders.",!! Q
  1. K ^TMP($J,"STRING")
  1. S VAR2=""
  1. S A12=$G(^PRC(442,VAR1,12))
  1. I A12]"",'AMEND G:$P(A12,U,10)>0 EXIT ;Already has EDI message #
  1. I 'AMEND S $P(A12,U,10)=999999999,^PRC(442,VAR1,12)=A12
  1. ;
  1. ; build segments
  1. D HE^PRCOE3(PRCOPODA,.VAR2) G:VAR2]"" EXIT
  1. D BI^PRCOE1(A,VAR1,.VAR2) G:VAR2]"" EXIT
  1. D VE^PRCOE1(A1,.VAR2) G:VAR2]"" EXIT
  1. D ST^PRCOE1(A,A1,VAR1,.VAR2) G:VAR2]"" EXIT
  1. D MI^PRCOE3(VAR1,.VAR2) G:VAR2]"" EXIT
  1. D AC^PRCOE4(A,A1,VAR1,.VAR2) G:VAR2]"" EXIT
  1. S TOTAL="" D IT^PRCOE2(VAR1,.VAR2,.TOTAL) G:VAR2]"" EXIT
  1. D CO^PRCOE3(VAR1,.VAR2,.TOTAL) G:VAR2]"" EXIT
  1. ;
  1. S IEN=$S($P($G(^PRC(442,VAR1,23)),U,7)>0:$P(^(23),U,7),1:PRC("SITE"))
  1. S PTSW=$P($G(^PRC(411,IEN,9)),U,4) ; test or production site
  1. S V2=""
  1. S VEN=$P(A1,U)
  1. I VEN>0,'AMEND S V1=$G(^PRC(440,VEN,3)),V2=$P(V1,U,2)
  1. S W1=PRC("SITE")
  1. S V3=$P($P(A,U),"-")_$P($P(A,U),"-",2)
  1. S V4=$S(PTSW="T":"IST",1:"ISM")
  1. I 'AMEND,V2="Y",$P($G(^PRC(442,VAR1,23)),U,11)'="P",$P($G(^(12)),U,16)'="n" S V4=$S(PTSW="T":"IST^EDT",1:"ISM^EDP")
  1. I AMEND D EN^DDIOL("...now generating the "_W2_" transaction...","","!!")
  1. D TRANSMIT^PRCPSMCS(W1,W2,V3,V4,200,1)
  1. S XMZ=$O(PRCPXMZ(0))
  1. I XMZ>0 S $P(^PRC(442,VAR1,12),U,10)=PRCPXMZ(XMZ)
  1. I AMEND G EXIT
  1. ;
  1. ; NOW, IF THIS IS NOT FROM AMENDMENTS AND IS AN EDI 'PHA',
  1. ; LETS ADD IT TO FILE 443.75.
  1. ;
  1. S W1=$P(A,U)
  1. S W2="PHA"
  1. S V3=PRCPXMZ(XMZ)
  1. S V5=$P(A1,U,10)
  1. S V6=VAR1
  1. S VAR3=$P(A1,U)
  1. S V4=$P($G(^PRC(440,VAR3,3)),U,3)
  1. I V2="Y",$P($G(^PRC(442,VAR1,12)),U,16)'="n",$P($G(^(23)),U,11)'="P" D ENTER^PRCOEDI(W1,W2,V3,V4,V5,V6)
  1. ;
  1. EXIT I VAR2]"" W:'AMEND W2," not generated - missing information (data code: ",VAR2,")",!!
  1. K ^TMP($J,"STRING"),PRCOUT Q
  1. ;
  1. VDEC(VALUE,LENGTH) ;
  1. ; EXTRINSIC FUNCTION TO CONVERT NUMBER WITH DECIMAL INTO VIRTUAL
  1. ; DECIMAL.
  1. ;
  1. ; VALUE = NUMBER WITH DECIMAL TO CONVERT
  1. ; LENGTH = NUMBER OF VIRTUAL DECIMAL PLACES
  1. ;
  1. ; CALLED FROM PRCOE4
  1. ;
  1. N V1,V2
  1. S (V1,V2)="" G:'$D(VALUE) EXIT1
  1. S V1=$P(VALUE,".",1),V2=$P(VALUE,".",2)
  1. I '$D(LENGTH) S LENGTH=0,V2="" G EXIT1
  1. I LENGTH=0 S V2="" G EXIT1
  1. I LENGTH>0,LENGTH'<$L(V2) S $P(V2,"0",LENGTH)="0",V2=$E(V2,1,LENGTH)
  1. I LENGTH>0,LENGTH<$L(V2) S V2=$E(V2,1,LENGTH)
  1. EXIT1 Q V1_V2
  1. ;
  1. ENTER(ENTRY,TRANS,XMZ,VENDOR,SENDER,POINTER,RFQ,TXT) ;
  1. ;
  1. ; THIS IS THE PARAMETER PASSED CALL TO ENTER A NEW ENTRY INTO
  1. ; FILE 443.75. ONE ENTRY WILL BE CREATED FOR EACH 'PHA'
  1. ; TRANSACTION. ONE OR MORE ENTRIES WILL BE CREATED FOR EACH 'RFQ'
  1. ; OR 'TXT' TRANSACTION (THE CALLING ROUTINE WILL HAVE TO MAKE
  1. ; SEPARATE CALLS, ONE FOR EACH DIFFERENT VENDOR).
  1. ;
  1. ; INPUT PARAMETERS WHAT IT REPRESENTS
  1. ; ENTRY IF THE TRANSACTION IS A 'PHA' THEN SEND
  1. ; THE FILE 442, .01 FIELD VALUE.
  1. ; IF THE TRANSACTION IS A 'RFQ' OR A 'TXT'
  1. ; SEND THE RFQ NUMBER.
  1. ; TRANS SEND THE TYPE OF TRANSACTION BEING SENT
  1. ; TO AUSTIN ('PHA', 'RFQ' OR 'TXT').
  1. ; XMZ THE MAILMAN NUMBER OF THE TRANSACTION.
  1. ; VENDOR THE VENDOR ID USED IN THE TRANSACTION.
  1. ; SENDER THE DUZ OF THE PERSON CREATING THE
  1. ; TRANSACTION ENTERING INTO FILE 443.75.
  1. ; POINTER THE INTERNAL ENTRY NUMBER OF THE ENTRY.
  1. ; RFQ THIS FIELD WILL CONTAIN '00' OR '01'.
  1. ; '00' IS A NORMAL RFQ.
  1. ; '01' IS A CANCELLED RFQ.
  1. ; TXT THE TXT MESSAGE NUMBER. THIS PARAMETER
  1. ; IS OPTIONAL. ALL OTHER PARAMETERS ARE
  1. ; REQUIRED.
  1. ;
  1. ; NOTHING ADDITIONAL IS RETURNED FROM THIS CALL.
  1. ;
  1. ; ALL PASSED PARAMETERS ARE UNCHANGED.
  1. ;
  1. N I,IEN,PRCNO,PRC,PRCDA
  1. S IEN=""
  1. ; SEE IF THE TRANSACTION IS ALREADY ENTERED IN FILE 443.75.
  1. ; IF SO JUST UPDATE THE MAILMAN MESSAGE NUMBER AND DATE/TIME
  1. ; THE MESSAGE WS MAILED.
  1. ;
  1. I TRANS="PHA" D I IEN>0 Q
  1. . S IEN=$O(^PRC(443.75,"AO",TRANS,ENTRY,VENDOR,0))
  1. . I IEN>0 D UPDATE
  1. . Q
  1. ;
  1. I TRANS="RFQ" D I IEN>0 Q
  1. . S IEN=$O(^PRC(443.75,"AC",TRANS,ENTRY,VENDOR,RFQ,0))
  1. . I IEN>0 D UPDATE
  1. . Q
  1. ;
  1. I TRANS="TXT" D I IEN>0 Q
  1. . S IEN=$O(^PRC(443.75,"AF",TRANS,ENTRY,VENDOR,TXT,0))
  1. . I IEN>0 D UPDATE
  1. . Q
  1. ;
  1. ; CONTINUE HERE IF NO RECORD OF THE TRANSACTION WAS FOUND.
  1. ;
  1. F I=1:1:100 L +^PRC(443.75):1 Q:$T=1
  1. G:'$T STOP
  1. K PRCNO
  1. S PRCNO=1+$O(^PRC(443.75,"B",""),-1)
  1. S PRC(1,443.75,"?+1,",.01)=PRCNO
  1. S PRC(2)=""
  1. D UPDATE^DIE("","PRC(1)","PRC(2)")
  1. S PRCDA=PRC(2,1)
  1. L -^PRC(443.75)
  1. ;
  1. ; HAVING CREATED A NEW ENTRY LETS POPULATE IT.
  1. ;
  1. F L +^PRC(443.75,PRCDA):1 Q:$T=1
  1. S X=$P($$NET^XMRENT(XMZ),U)
  1. S %DT="ST"
  1. D ^%DT
  1. S:Y>0 PRC(1,443.75,"?+1,",6)=Y
  1. S PRC(1,443.75,"?+1,",1)=ENTRY
  1. S PRC(1,443.75,"?+1,",3)=TRANS
  1. S PRC(1,443.75,"?+1,",5)=VENDOR
  1. S PRC(1,443.75,"?+1,",4)=XMZ
  1. S PRC(1,443.75,"?+1,",5.5)=SENDER
  1. S:TRANS="RFQ" PRC(1,443.75,"?+1,",6.5)=RFQ
  1. S:$G(TXT)]"" PRC(1,443.75,"?+1,",2)=TXT
  1. S:TRANS="PHA" PRC(1,443.75,"?+1,",7)=POINTER
  1. S:TRANS'="PHA" PRC(1,443.75,"?+1,",8)=POINTER
  1. S PRC(1,443.75,"?+1,",.01)=PRCDA
  1. D UPDATE^DIE("","PRC(1)")
  1. L -^PRC(443.75,PRCDA)
  1. STOP Q
  1. ;
  1. UPDATE ; COME HERE TO UPDATE AN EXISTING RECORD IN FILE 443.75.
  1. S PRC(1,443.75,"?+1,",.01)=IEN
  1. S PRC(1,443.75,"?+1,",4)=XMZ
  1. S X=$P($$NET^XMRENT(XMZ),U)
  1. S %DT="ST"
  1. D ^%DT
  1. S:Y>0 PRC(1,443.75,"?+1,",6)=Y
  1. F L +^PRC(443.75,IEN):1 Q:$T=1
  1. D UPDATE^DIE("","PRC(1)")
  1. L -^PRC(443.75,IEN)
  1. G STOP