| [613] | 1 | PRC5CON3 ;WISC/SJG-GENERATE FMS DOCS FOR CONVERSION III ;
|
|---|
| 2 | V ;;5.0;IFCAP;**27**;4/21/95
|
|---|
| 3 | ;
|
|---|
| 4 | QUIT
|
|---|
| 5 | ; No top level entry
|
|---|
| 6 | ;
|
|---|
| 7 | ; Front end routine for Conversion III 'Held' Documents from 423
|
|---|
| 8 | EN(PI1,PI2,PI3) ;
|
|---|
| 9 | ; Parameters passed from entry in File 423
|
|---|
| 10 | ; PI1 = Internal Record Number from File 442
|
|---|
| 11 | ; PI2 = Document Action, i.e, "E" or "M"
|
|---|
| 12 | ; PI3 = Transmission Date
|
|---|
| 13 | GET N DATE,FMSDOCT,FMSINT,LOOP,P2
|
|---|
| 14 | S X=PI1,DIC=442,DIC(0)="NZ" D ^DIC K DIC
|
|---|
| 15 | I Y<0 W:'$D(ZTQUEUED) !,"No entry found in File 442!!!" Q
|
|---|
| 16 | VAR S PO(0)=Y(0),PO=Y,PRCFA("PODA")=+Y
|
|---|
| 17 | S PRC("SITE")=$P(PO(0),"-"),PRCFA("OBLDATE")=PI3
|
|---|
| 18 | S PCP=+$P(PO(0),"^",3),$P(PCP,"^",2)=$S($D(^PRC(420,PRC("SITE"),1,+PCP,0)):$P(^(0),"^",12),1:"") K Y
|
|---|
| 19 | S PARTDT=PRCFA("OBLDATE") D PARTS^PRCFFUC(PARTDT,.DATE) S PRCFA("ACCPD")=DATE
|
|---|
| 20 | S PRC("FY")=$E($P($$DATE^PRC0C(PI3,"I"),"^"),3,4)
|
|---|
| 21 | S PRCFA("REF")=$P(PO(0),U),PRCFA("SYS")="FMS"
|
|---|
| 22 | S PRCFA("SFC")=$P(PO(0),U,19),PRCFA("MP")=$P(PO(0),U,2)
|
|---|
| 23 | S PRCFA("TT")=$S(PRCFA("MP")=2:"SO",PRCFA("MP")=1:"MO",PRCFA("MP")=8:"MO",PRCFA("MP")=21:"SO",1:"MO")
|
|---|
| 24 | VAR1 S PRCFA("BBFY")=$$BBFY^PRCFFU5(+PO) D BBFYCHK^PRCFFU19(+PO)
|
|---|
| 25 | S PARAM1="^"_PRC("SITE")_"^"_+PCP_"^"_PRC("FY")_"^"_PRCFA("BBFY")
|
|---|
| 26 | D DOCREQ^PRC0C(PARAM1,"SPE","PRCFMO")
|
|---|
| 27 | S PRCFMO("G/N")=$P(PRCFMO,U,12)
|
|---|
| 28 | S IDFLAG="I",REQ=$P(PO(0),U,12)
|
|---|
| 29 | ; get person 'Obligated By' from primary 2237
|
|---|
| 30 | VAR2 I REQ]"" D GENDIQ^PRCFFU7(410,+REQ,29,"IEN","") S PRC("PER")=$G(PRCTMP(410,+REQ,29,"I"))
|
|---|
| 31 | ; if no primary 2237, get person 'Obligated By' from node 10 on PO
|
|---|
| 32 | I REQ="" D
|
|---|
| 33 | .N L1,TT,NODE
|
|---|
| 34 | .S L1=$O(^PRC(442,+PO,10,0)) Q:L1="" D
|
|---|
| 35 | ..S NODE=^PRC(442,+PO,10,L1,0),TT=$P(NODE,".",1,2)
|
|---|
| 36 | ..I TT="921.60"!(TT="921.00") S PRC("PER")=$P(NODE,U,2)
|
|---|
| 37 | ..Q
|
|---|
| 38 | .Q
|
|---|
| 39 | ; if all else fails, use DUZ of person running conversion
|
|---|
| 40 | I '$D(PRC("PER")) D DUZ^PRCFSITE
|
|---|
| 41 | S PRCFA("MOD")=$S(PI2="E":"E^0^Original Entry",PI2="M":"M^1^Modification Entry")
|
|---|
| 42 | S PRCFA("IDES")="Conversion III/CALM Code Sheet "
|
|---|
| 43 | I PRCFA("MP")=21 S PRCFA("IDES")=PRCFA("IDES")_"1358 Obligation" D NODE^PRCS58OB(+REQ,.TRNODE)
|
|---|
| 44 | E S PRCFA("IDES")=PRCFA("IDES")_"Purchase Order"
|
|---|
| 45 | I $D(ZTQUEUED) S PRCFA("CONVS")=1
|
|---|
| 46 | D:'$D(ZTQUEUED) EN^DDIOL("...now converting CALM code sheet for obligation "_PRCFA("REF")_"...")
|
|---|
| 47 | STACK D STACK^PRCFFU(PRCFA("MOD"))
|
|---|
| 48 | K ^TMP($J,"PRCMO")
|
|---|
| 49 | S FMSINT=+PO,FMSMOD=$P(PRCFA("MOD"),U,1)
|
|---|
| 50 | D NEW^PRCFFU1(FMSINT,PRCFA("TT"),FMSMOD)
|
|---|
| 51 | S LOOP=0 F S LOOP=$O(^TMP($J,"PRCMO",GECSFMS("DA"),LOOP)) Q:'LOOP D SETCS^GECSSTAA(GECSFMS("DA"),^(LOOP))
|
|---|
| 52 | K ^TMP($J,"PRCMO")
|
|---|
| 53 | D SETSTAT^GECSSTAA(GECSFMS("DA"),"Q")
|
|---|
| 54 | I '$D(POESIG) I $D(PRCFA("PODA")),+PRCFA("PODA")>0 S POESIG=1
|
|---|
| 55 | S P2=+PO,$P(P2,"/",5)=$P($G(PRCFA("ACCPD")),U),$P(P2,"/",6)=PRCFA("OBLDATE")
|
|---|
| 56 | S:PRCFA("MP")=21 $P(P2,"/",3)=REQ
|
|---|
| 57 | D SETPARAM^GECSSDCT(GECSFMS("DA"),P2)
|
|---|
| 58 | S FMSDOCT=$P(PRCFA("REF"),"-",2) D EN7^PRCFFU41(PRCFA("TT"),FMSMOD,PRCFA("OBLDATE"),FMSDOCT)
|
|---|
| 59 | D KILL
|
|---|
| 60 | Q
|
|---|
| 61 | KILL K BEGDATE,DIC,FMSMOD,FMSVENID,FOB,GECSFMS,IDFLAG,NUMB,PARAM1,PARTDT,PCP
|
|---|
| 62 | K PO,PODATE,PRC,PRCCC,PRCCCC,PRCCP,PRCCSCC,PRCFA,PRCFMO,PRCREQST,PRCSTA
|
|---|
| 63 | K PRCSTR,PRCTMP,REQ,SATSTN,STR2,TRNODE,X,Y
|
|---|
| 64 | Q
|
|---|
