- PRCOEDI ;WISC/DJM-IFCAP EDI ENTRY ROUTINE ; 7/21/99 11:24am
- V ;;5.1;IFCAP;;Oct 20, 2000
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- ; Receives variable PRCOPODA from calling routines.
- ;
- ; PRCOPODA = sting of up to 4 '^' pieces.
- ; piece 1 = ien of 442 record
- ; piece 2 = (optional) flag if not new order
- ; piece 3 = (optional) amendment number
- ; piece 4 = (optional) ien of 442 record if
- ; amendment is PO number change
- ;
- ; piece 2 flag values:
- ; 1 = create a PHM, do not transmit to EDI
- ; 2 = create a PHA, do not transmit to EDI
- ;
- NEW N A,AMEND,A1,A12,CSDA,IEN,MO,PRC,PRCFA,PRCFASYS,PRCPXMZ,PTSW,RECORD
- N REQUEST,SERVICE,TEST,TOTAL,VAR1,VAR2,VAR3,VEN,V1,V2,V3,V4,V5,V6
- N W1,W2,YR,XMZ
- S VAR1=$P(PRCOPODA,"^",1)
- S W2="PHA"
- I $P(PRCOPODA,"^",2)=1 S W2="PHM"
- S AMEND=0
- I $P(PRCOPODA,"^",2)]"" S AMEND=1 ; amendment, don't send to EDI
- S A=$G(^PRC(442,VAR1,0))
- I A="" W:'AMEND W2," not generated - purchase order corrupted.",!! Q
- S PRC("SITE")=$P($P(A,U),"-")
- S YR=$E(DT,2,3)
- S MO=$E(DT,4,5)
- S PRC("FY")=$E(100+$S(MO>9:YR+1,1:YR),2,3)
- S SERVICE=$P(A,U,12)
- I SERVICE>0 D I $G(REQUEST)=3 W:'AMEND W2," not generated - inappropriate for this order.",!! Q
- . S RECORD=$G(^PRC(442,VAR1,13,SERVICE,0))
- . I RECORD]"" S REQUEST=$P(RECORD,U,9)
- S A1=$G(^PRC(442,VAR1,1))
- I A1="" W:'AMEND W2," not generated - PO informated corrupted",!! Q
- I $P(A1,U,7)=1 W W2," not generated - not used for GSA Supply Depot orders.",!! Q
- K ^TMP($J,"STRING")
- S VAR2=""
- S A12=$G(^PRC(442,VAR1,12))
- I A12]"",'AMEND G:$P(A12,U,10)>0 EXIT ;Already has EDI message #
- I 'AMEND S $P(A12,U,10)=999999999,^PRC(442,VAR1,12)=A12
- ;
- ; build segments
- D HE^PRCOE3(PRCOPODA,.VAR2) G:VAR2]"" EXIT
- D BI^PRCOE1(A,VAR1,.VAR2) G:VAR2]"" EXIT
- D VE^PRCOE1(A1,.VAR2) G:VAR2]"" EXIT
- D ST^PRCOE1(A,A1,VAR1,.VAR2) G:VAR2]"" EXIT
- D MI^PRCOE3(VAR1,.VAR2) G:VAR2]"" EXIT
- D AC^PRCOE4(A,A1,VAR1,.VAR2) G:VAR2]"" EXIT
- S TOTAL="" D IT^PRCOE2(VAR1,.VAR2,.TOTAL) G:VAR2]"" EXIT
- D CO^PRCOE3(VAR1,.VAR2,.TOTAL) G:VAR2]"" EXIT
- ;
- S IEN=$S($P($G(^PRC(442,VAR1,23)),U,7)>0:$P(^(23),U,7),1:PRC("SITE"))
- S PTSW=$P($G(^PRC(411,IEN,9)),U,4) ; test or production site
- S V2=""
- S VEN=$P(A1,U)
- I VEN>0,'AMEND S V1=$G(^PRC(440,VEN,3)),V2=$P(V1,U,2)
- S W1=PRC("SITE")
- S V3=$P($P(A,U),"-")_$P($P(A,U),"-",2)
- S V4=$S(PTSW="T":"IST",1:"ISM")
- 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")
- I AMEND D EN^DDIOL("...now generating the "_W2_" transaction...","","!!")
- D TRANSMIT^PRCPSMCS(W1,W2,V3,V4,200,1)
- S XMZ=$O(PRCPXMZ(0))
- I XMZ>0 S $P(^PRC(442,VAR1,12),U,10)=PRCPXMZ(XMZ)
- I AMEND G EXIT
- ;
- ; NOW, IF THIS IS NOT FROM AMENDMENTS AND IS AN EDI 'PHA',
- ; LETS ADD IT TO FILE 443.75.
- ;
- S W1=$P(A,U)
- S W2="PHA"
- S V3=PRCPXMZ(XMZ)
- S V5=$P(A1,U,10)
- S V6=VAR1
- S VAR3=$P(A1,U)
- S V4=$P($G(^PRC(440,VAR3,3)),U,3)
- 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)
- ;
- EXIT I VAR2]"" W:'AMEND W2," not generated - missing information (data code: ",VAR2,")",!!
- K ^TMP($J,"STRING"),PRCOUT Q
- ;
- VDEC(VALUE,LENGTH) ;
- ; EXTRINSIC FUNCTION TO CONVERT NUMBER WITH DECIMAL INTO VIRTUAL
- ; DECIMAL.
- ;
- ; VALUE = NUMBER WITH DECIMAL TO CONVERT
- ; LENGTH = NUMBER OF VIRTUAL DECIMAL PLACES
- ;
- ; CALLED FROM PRCOE4
- ;
- N V1,V2
- S (V1,V2)="" G:'$D(VALUE) EXIT1
- S V1=$P(VALUE,".",1),V2=$P(VALUE,".",2)
- I '$D(LENGTH) S LENGTH=0,V2="" G EXIT1
- I LENGTH=0 S V2="" G EXIT1
- I LENGTH>0,LENGTH'<$L(V2) S $P(V2,"0",LENGTH)="0",V2=$E(V2,1,LENGTH)
- I LENGTH>0,LENGTH<$L(V2) S V2=$E(V2,1,LENGTH)
- EXIT1 Q V1_V2
- ;
- ENTER(ENTRY,TRANS,XMZ,VENDOR,SENDER,POINTER,RFQ,TXT) ;
- ;
- ; THIS IS THE PARAMETER PASSED CALL TO ENTER A NEW ENTRY INTO
- ; FILE 443.75. ONE ENTRY WILL BE CREATED FOR EACH 'PHA'
- ; TRANSACTION. ONE OR MORE ENTRIES WILL BE CREATED FOR EACH 'RFQ'
- ; OR 'TXT' TRANSACTION (THE CALLING ROUTINE WILL HAVE TO MAKE
- ; SEPARATE CALLS, ONE FOR EACH DIFFERENT VENDOR).
- ;
- ; INPUT PARAMETERS WHAT IT REPRESENTS
- ; ENTRY IF THE TRANSACTION IS A 'PHA' THEN SEND
- ; THE FILE 442, .01 FIELD VALUE.
- ; IF THE TRANSACTION IS A 'RFQ' OR A 'TXT'
- ; SEND THE RFQ NUMBER.
- ; TRANS SEND THE TYPE OF TRANSACTION BEING SENT
- ; TO AUSTIN ('PHA', 'RFQ' OR 'TXT').
- ; XMZ THE MAILMAN NUMBER OF THE TRANSACTION.
- ; VENDOR THE VENDOR ID USED IN THE TRANSACTION.
- ; SENDER THE DUZ OF THE PERSON CREATING THE
- ; TRANSACTION ENTERING INTO FILE 443.75.
- ; POINTER THE INTERNAL ENTRY NUMBER OF THE ENTRY.
- ; RFQ THIS FIELD WILL CONTAIN '00' OR '01'.
- ; '00' IS A NORMAL RFQ.
- ; '01' IS A CANCELLED RFQ.
- ; TXT THE TXT MESSAGE NUMBER. THIS PARAMETER
- ; IS OPTIONAL. ALL OTHER PARAMETERS ARE
- ; REQUIRED.
- ;
- ; NOTHING ADDITIONAL IS RETURNED FROM THIS CALL.
- ;
- ; ALL PASSED PARAMETERS ARE UNCHANGED.
- ;
- N I,IEN,PRCNO,PRC,PRCDA
- S IEN=""
- ; SEE IF THE TRANSACTION IS ALREADY ENTERED IN FILE 443.75.
- ; IF SO JUST UPDATE THE MAILMAN MESSAGE NUMBER AND DATE/TIME
- ; THE MESSAGE WS MAILED.
- ;
- I TRANS="PHA" D I IEN>0 Q
- . S IEN=$O(^PRC(443.75,"AO",TRANS,ENTRY,VENDOR,0))
- . I IEN>0 D UPDATE
- . Q
- ;
- I TRANS="RFQ" D I IEN>0 Q
- . S IEN=$O(^PRC(443.75,"AC",TRANS,ENTRY,VENDOR,RFQ,0))
- . I IEN>0 D UPDATE
- . Q
- ;
- I TRANS="TXT" D I IEN>0 Q
- . S IEN=$O(^PRC(443.75,"AF",TRANS,ENTRY,VENDOR,TXT,0))
- . I IEN>0 D UPDATE
- . Q
- ;
- ; CONTINUE HERE IF NO RECORD OF THE TRANSACTION WAS FOUND.
- ;
- F I=1:1:100 L +^PRC(443.75):1 Q:$T=1
- G:'$T STOP
- K PRCNO
- S PRCNO=1+$O(^PRC(443.75,"B",""),-1)
- S PRC(1,443.75,"?+1,",.01)=PRCNO
- S PRC(2)=""
- D UPDATE^DIE("","PRC(1)","PRC(2)")
- S PRCDA=PRC(2,1)
- L -^PRC(443.75)
- ;
- ; HAVING CREATED A NEW ENTRY LETS POPULATE IT.
- ;
- F L +^PRC(443.75,PRCDA):1 Q:$T=1
- S X=$P($$NET^XMRENT(XMZ),U)
- S %DT="ST"
- D ^%DT
- S:Y>0 PRC(1,443.75,"?+1,",6)=Y
- S PRC(1,443.75,"?+1,",1)=ENTRY
- S PRC(1,443.75,"?+1,",3)=TRANS
- S PRC(1,443.75,"?+1,",5)=VENDOR
- S PRC(1,443.75,"?+1,",4)=XMZ
- S PRC(1,443.75,"?+1,",5.5)=SENDER
- S:TRANS="RFQ" PRC(1,443.75,"?+1,",6.5)=RFQ
- S:$G(TXT)]"" PRC(1,443.75,"?+1,",2)=TXT
- S:TRANS="PHA" PRC(1,443.75,"?+1,",7)=POINTER
- S:TRANS'="PHA" PRC(1,443.75,"?+1,",8)=POINTER
- S PRC(1,443.75,"?+1,",.01)=PRCDA
- D UPDATE^DIE("","PRC(1)")
- L -^PRC(443.75,PRCDA)
- STOP Q
- ;
- UPDATE ; COME HERE TO UPDATE AN EXISTING RECORD IN FILE 443.75.
- S PRC(1,443.75,"?+1,",.01)=IEN
- S PRC(1,443.75,"?+1,",4)=XMZ
- S X=$P($$NET^XMRENT(XMZ),U)
- S %DT="ST"
- D ^%DT
- S:Y>0 PRC(1,443.75,"?+1,",6)=Y
- F L +^PRC(443.75,IEN):1 Q:$T=1
- D UPDATE^DIE("","PRC(1)")
- L -^PRC(443.75,IEN)
- G STOP
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCOEDI 7233 printed Dec 13, 2024@02:11:50 Page 2
- PRCOEDI ;WISC/DJM-IFCAP EDI ENTRY ROUTINE ; 7/21/99 11:24am
- V ;;5.1;IFCAP;;Oct 20, 2000
- +1 ;Per VHA Directive 10-93-142, this routine should not be modified.
- +2 ;
- +3 ; Receives variable PRCOPODA from calling routines.
- +4 ;
- +5 ; PRCOPODA = sting of up to 4 '^' pieces.
- +6 ; piece 1 = ien of 442 record
- +7 ; piece 2 = (optional) flag if not new order
- +8 ; piece 3 = (optional) amendment number
- +9 ; piece 4 = (optional) ien of 442 record if
- +10 ; amendment is PO number change
- +11 ;
- +12 ; piece 2 flag values:
- +13 ; 1 = create a PHM, do not transmit to EDI
- +14 ; 2 = create a PHA, do not transmit to EDI
- +15 ;
- NEW NEW A,AMEND,A1,A12,CSDA,IEN,MO,PRC,PRCFA,PRCFASYS,PRCPXMZ,PTSW,RECORD
- +1 NEW REQUEST,SERVICE,TEST,TOTAL,VAR1,VAR2,VAR3,VEN,V1,V2,V3,V4,V5,V6
- +2 NEW W1,W2,YR,XMZ
- +3 SET VAR1=$PIECE(PRCOPODA,"^",1)
- +4 SET W2="PHA"
- +5 IF $PIECE(PRCOPODA,"^",2)=1
- SET W2="PHM"
- +6 SET AMEND=0
- +7 ; amendment, don't send to EDI
- IF $PIECE(PRCOPODA,"^",2)]""
- SET AMEND=1
- +8 SET A=$GET(^PRC(442,VAR1,0))
- +9 IF A=""
- if 'AMEND
- WRITE W2," not generated - purchase order corrupted.",!!
- QUIT
- +10 SET PRC("SITE")=$PIECE($PIECE(A,U),"-")
- +11 SET YR=$EXTRACT(DT,2,3)
- +12 SET MO=$EXTRACT(DT,4,5)
- +13 SET PRC("FY")=$EXTRACT(100+$SELECT(MO>9:YR+1,1:YR),2,3)
- +14 SET SERVICE=$PIECE(A,U,12)
- +15 IF SERVICE>0
- Begin DoDot:1
- +16 SET RECORD=$GET(^PRC(442,VAR1,13,SERVICE,0))
- +17 IF RECORD]""
- SET REQUEST=$PIECE(RECORD,U,9)
- End DoDot:1
- IF $GET(REQUEST)=3
- if 'AMEND
- WRITE W2," not generated - inappropriate for this order.",!!
- QUIT
- +18 SET A1=$GET(^PRC(442,VAR1,1))
- +19 IF A1=""
- if 'AMEND
- WRITE W2," not generated - PO informated corrupted",!!
- QUIT
- +20 IF $PIECE(A1,U,7)=1
- WRITE W2," not generated - not used for GSA Supply Depot orders.",!!
- QUIT
- +21 KILL ^TMP($JOB,"STRING")
- +22 SET VAR2=""
- +23 SET A12=$GET(^PRC(442,VAR1,12))
- +24 ;Already has EDI message #
- IF A12]""
- IF 'AMEND
- if $PIECE(A12,U,10)>0
- GOTO EXIT
- +25 IF 'AMEND
- SET $PIECE(A12,U,10)=999999999
- SET ^PRC(442,VAR1,12)=A12
- +26 ;
- +27 ; build segments
- +28 DO HE^PRCOE3(PRCOPODA,.VAR2)
- if VAR2]""
- GOTO EXIT
- +29 DO BI^PRCOE1(A,VAR1,.VAR2)
- if VAR2]""
- GOTO EXIT
- +30 DO VE^PRCOE1(A1,.VAR2)
- if VAR2]""
- GOTO EXIT
- +31 DO ST^PRCOE1(A,A1,VAR1,.VAR2)
- if VAR2]""
- GOTO EXIT
- +32 DO MI^PRCOE3(VAR1,.VAR2)
- if VAR2]""
- GOTO EXIT
- +33 DO AC^PRCOE4(A,A1,VAR1,.VAR2)
- if VAR2]""
- GOTO EXIT
- +34 SET TOTAL=""
- DO IT^PRCOE2(VAR1,.VAR2,.TOTAL)
- if VAR2]""
- GOTO EXIT
- +35 DO CO^PRCOE3(VAR1,.VAR2,.TOTAL)
- if VAR2]""
- GOTO EXIT
- +36 ;
- +37 SET IEN=$SELECT($PIECE($GET(^PRC(442,VAR1,23)),U,7)>0:$PIECE(^(23),U,7),1:PRC("SITE"))
- +38 ; test or production site
- SET PTSW=$PIECE($GET(^PRC(411,IEN,9)),U,4)
- +39 SET V2=""
- +40 SET VEN=$PIECE(A1,U)
- +41 IF VEN>0
- IF 'AMEND
- SET V1=$GET(^PRC(440,VEN,3))
- SET V2=$PIECE(V1,U,2)
- +42 SET W1=PRC("SITE")
- +43 SET V3=$PIECE($PIECE(A,U),"-")_$PIECE($PIECE(A,U),"-",2)
- +44 SET V4=$SELECT(PTSW="T":"IST",1:"ISM")
- +45 IF 'AMEND
- IF V2="Y"
- IF $PIECE($GET(^PRC(442,VAR1,23)),U,11)'="P"
- IF $PIECE($GET(^(12)),U,16)'="n"
- SET V4=$SELECT(PTSW="T":"IST^EDT",1:"ISM^EDP")
- +46 IF AMEND
- DO EN^DDIOL("...now generating the "_W2_" transaction...","","!!")
- +47 DO TRANSMIT^PRCPSMCS(W1,W2,V3,V4,200,1)
- +48 SET XMZ=$ORDER(PRCPXMZ(0))
- +49 IF XMZ>0
- SET $PIECE(^PRC(442,VAR1,12),U,10)=PRCPXMZ(XMZ)
- +50 IF AMEND
- GOTO EXIT
- +51 ;
- +52 ; NOW, IF THIS IS NOT FROM AMENDMENTS AND IS AN EDI 'PHA',
- +53 ; LETS ADD IT TO FILE 443.75.
- +54 ;
- +55 SET W1=$PIECE(A,U)
- +56 SET W2="PHA"
- +57 SET V3=PRCPXMZ(XMZ)
- +58 SET V5=$PIECE(A1,U,10)
- +59 SET V6=VAR1
- +60 SET VAR3=$PIECE(A1,U)
- +61 SET V4=$PIECE($GET(^PRC(440,VAR3,3)),U,3)
- +62 IF V2="Y"
- IF $PIECE($GET(^PRC(442,VAR1,12)),U,16)'="n"
- IF $PIECE($GET(^(23)),U,11)'="P"
- DO ENTER^PRCOEDI(W1,W2,V3,V4,V5,V6)
- +63 ;
- EXIT IF VAR2]""
- if 'AMEND
- WRITE W2," not generated - missing information (data code: ",VAR2,")",!!
- +1 KILL ^TMP($JOB,"STRING"),PRCOUT
- QUIT
- +2 ;
- VDEC(VALUE,LENGTH) ;
- +1 ; EXTRINSIC FUNCTION TO CONVERT NUMBER WITH DECIMAL INTO VIRTUAL
- +2 ; DECIMAL.
- +3 ;
- +4 ; VALUE = NUMBER WITH DECIMAL TO CONVERT
- +5 ; LENGTH = NUMBER OF VIRTUAL DECIMAL PLACES
- +6 ;
- +7 ; CALLED FROM PRCOE4
- +8 ;
- +9 NEW V1,V2
- +10 SET (V1,V2)=""
- if '$DATA(VALUE)
- GOTO EXIT1
- +11 SET V1=$PIECE(VALUE,".",1)
- SET V2=$PIECE(VALUE,".",2)
- +12 IF '$DATA(LENGTH)
- SET LENGTH=0
- SET V2=""
- GOTO EXIT1
- +13 IF LENGTH=0
- SET V2=""
- GOTO EXIT1
- +14 IF LENGTH>0
- IF LENGTH'<$LENGTH(V2)
- SET $PIECE(V2,"0",LENGTH)="0"
- SET V2=$EXTRACT(V2,1,LENGTH)
- +15 IF LENGTH>0
- IF LENGTH<$LENGTH(V2)
- SET V2=$EXTRACT(V2,1,LENGTH)
- EXIT1 QUIT V1_V2
- +1 ;
- ENTER(ENTRY,TRANS,XMZ,VENDOR,SENDER,POINTER,RFQ,TXT) ;
- +1 ;
- +2 ; THIS IS THE PARAMETER PASSED CALL TO ENTER A NEW ENTRY INTO
- +3 ; FILE 443.75. ONE ENTRY WILL BE CREATED FOR EACH 'PHA'
- +4 ; TRANSACTION. ONE OR MORE ENTRIES WILL BE CREATED FOR EACH 'RFQ'
- +5 ; OR 'TXT' TRANSACTION (THE CALLING ROUTINE WILL HAVE TO MAKE
- +6 ; SEPARATE CALLS, ONE FOR EACH DIFFERENT VENDOR).
- +7 ;
- +8 ; INPUT PARAMETERS WHAT IT REPRESENTS
- +9 ; ENTRY IF THE TRANSACTION IS A 'PHA' THEN SEND
- +10 ; THE FILE 442, .01 FIELD VALUE.
- +11 ; IF THE TRANSACTION IS A 'RFQ' OR A 'TXT'
- +12 ; SEND THE RFQ NUMBER.
- +13 ; TRANS SEND THE TYPE OF TRANSACTION BEING SENT
- +14 ; TO AUSTIN ('PHA', 'RFQ' OR 'TXT').
- +15 ; XMZ THE MAILMAN NUMBER OF THE TRANSACTION.
- +16 ; VENDOR THE VENDOR ID USED IN THE TRANSACTION.
- +17 ; SENDER THE DUZ OF THE PERSON CREATING THE
- +18 ; TRANSACTION ENTERING INTO FILE 443.75.
- +19 ; POINTER THE INTERNAL ENTRY NUMBER OF THE ENTRY.
- +20 ; RFQ THIS FIELD WILL CONTAIN '00' OR '01'.
- +21 ; '00' IS A NORMAL RFQ.
- +22 ; '01' IS A CANCELLED RFQ.
- +23 ; TXT THE TXT MESSAGE NUMBER. THIS PARAMETER
- +24 ; IS OPTIONAL. ALL OTHER PARAMETERS ARE
- +25 ; REQUIRED.
- +26 ;
- +27 ; NOTHING ADDITIONAL IS RETURNED FROM THIS CALL.
- +28 ;
- +29 ; ALL PASSED PARAMETERS ARE UNCHANGED.
- +30 ;
- +31 NEW I,IEN,PRCNO,PRC,PRCDA
- +32 SET IEN=""
- +33 ; SEE IF THE TRANSACTION IS ALREADY ENTERED IN FILE 443.75.
- +34 ; IF SO JUST UPDATE THE MAILMAN MESSAGE NUMBER AND DATE/TIME
- +35 ; THE MESSAGE WS MAILED.
- +36 ;
- +37 IF TRANS="PHA"
- Begin DoDot:1
- +38 SET IEN=$ORDER(^PRC(443.75,"AO",TRANS,ENTRY,VENDOR,0))
- +39 IF IEN>0
- DO UPDATE
- +40 QUIT
- End DoDot:1
- IF IEN>0
- QUIT
- +41 ;
- +42 IF TRANS="RFQ"
- Begin DoDot:1
- +43 SET IEN=$ORDER(^PRC(443.75,"AC",TRANS,ENTRY,VENDOR,RFQ,0))
- +44 IF IEN>0
- DO UPDATE
- +45 QUIT
- End DoDot:1
- IF IEN>0
- QUIT
- +46 ;
- +47 IF TRANS="TXT"
- Begin DoDot:1
- +48 SET IEN=$ORDER(^PRC(443.75,"AF",TRANS,ENTRY,VENDOR,TXT,0))
- +49 IF IEN>0
- DO UPDATE
- +50 QUIT
- End DoDot:1
- IF IEN>0
- QUIT
- +51 ;
- +52 ; CONTINUE HERE IF NO RECORD OF THE TRANSACTION WAS FOUND.
- +53 ;
- +54 FOR I=1:1:100
- LOCK +^PRC(443.75):1
- if $TEST=1
- QUIT
- +55 if '$TEST
- GOTO STOP
- +56 KILL PRCNO
- +57 SET PRCNO=1+$ORDER(^PRC(443.75,"B",""),-1)
- +58 SET PRC(1,443.75,"?+1,",.01)=PRCNO
- +59 SET PRC(2)=""
- +60 DO UPDATE^DIE("","PRC(1)","PRC(2)")
- +61 SET PRCDA=PRC(2,1)
- +62 LOCK -^PRC(443.75)
- +63 ;
- +64 ; HAVING CREATED A NEW ENTRY LETS POPULATE IT.
- +65 ;
- +66 FOR
- LOCK +^PRC(443.75,PRCDA):1
- if $TEST=1
- QUIT
- +67 SET X=$PIECE($$NET^XMRENT(XMZ),U)
- +68 SET %DT="ST"
- +69 DO ^%DT
- +70 if Y>0
- SET PRC(1,443.75,"?+1,",6)=Y
- +71 SET PRC(1,443.75,"?+1,",1)=ENTRY
- +72 SET PRC(1,443.75,"?+1,",3)=TRANS
- +73 SET PRC(1,443.75,"?+1,",5)=VENDOR
- +74 SET PRC(1,443.75,"?+1,",4)=XMZ
- +75 SET PRC(1,443.75,"?+1,",5.5)=SENDER
- +76 if TRANS="RFQ"
- SET PRC(1,443.75,"?+1,",6.5)=RFQ
- +77 if $GET(TXT)]""
- SET PRC(1,443.75,"?+1,",2)=TXT
- +78 if TRANS="PHA"
- SET PRC(1,443.75,"?+1,",7)=POINTER
- +79 if TRANS'="PHA"
- SET PRC(1,443.75,"?+1,",8)=POINTER
- +80 SET PRC(1,443.75,"?+1,",.01)=PRCDA
- +81 DO UPDATE^DIE("","PRC(1)")
- +82 LOCK -^PRC(443.75,PRCDA)
- STOP QUIT
- +1 ;
- UPDATE ; COME HERE TO UPDATE AN EXISTING RECORD IN FILE 443.75.
- +1 SET PRC(1,443.75,"?+1,",.01)=IEN
- +2 SET PRC(1,443.75,"?+1,",4)=XMZ
- +3 SET X=$PIECE($$NET^XMRENT(XMZ),U)
- +4 SET %DT="ST"
- +5 DO ^%DT
- +6 if Y>0
- SET PRC(1,443.75,"?+1,",6)=Y
- +7 FOR
- LOCK +^PRC(443.75,IEN):1
- if $TEST=1
- QUIT
- +8 DO UPDATE^DIE("","PRC(1)")
- +9 LOCK -^PRC(443.75,IEN)
- +10 GOTO STOP