- PRC5CON3 ;WISC/SJG-GENERATE FMS DOCS FOR CONVERSION III ;
- V ;;5.0;IFCAP;**27**;4/21/95
- ;
- QUIT
- ; No top level entry
- ;
- ; Front end routine for Conversion III 'Held' Documents from 423
- EN(PI1,PI2,PI3) ;
- ; Parameters passed from entry in File 423
- ; PI1 = Internal Record Number from File 442
- ; PI2 = Document Action, i.e, "E" or "M"
- ; PI3 = Transmission Date
- GET N DATE,FMSDOCT,FMSINT,LOOP,P2
- S X=PI1,DIC=442,DIC(0)="NZ" D ^DIC K DIC
- I Y<0 W:'$D(ZTQUEUED) !,"No entry found in File 442!!!" Q
- VAR S PO(0)=Y(0),PO=Y,PRCFA("PODA")=+Y
- S PRC("SITE")=$P(PO(0),"-"),PRCFA("OBLDATE")=PI3
- S PCP=+$P(PO(0),"^",3),$P(PCP,"^",2)=$S($D(^PRC(420,PRC("SITE"),1,+PCP,0)):$P(^(0),"^",12),1:"") K Y
- S PARTDT=PRCFA("OBLDATE") D PARTS^PRCFFUC(PARTDT,.DATE) S PRCFA("ACCPD")=DATE
- S PRC("FY")=$E($P($$DATE^PRC0C(PI3,"I"),"^"),3,4)
- S PRCFA("REF")=$P(PO(0),U),PRCFA("SYS")="FMS"
- S PRCFA("SFC")=$P(PO(0),U,19),PRCFA("MP")=$P(PO(0),U,2)
- S PRCFA("TT")=$S(PRCFA("MP")=2:"SO",PRCFA("MP")=1:"MO",PRCFA("MP")=8:"MO",PRCFA("MP")=21:"SO",1:"MO")
- VAR1 S PRCFA("BBFY")=$$BBFY^PRCFFU5(+PO) D BBFYCHK^PRCFFU19(+PO)
- S PARAM1="^"_PRC("SITE")_"^"_+PCP_"^"_PRC("FY")_"^"_PRCFA("BBFY")
- D DOCREQ^PRC0C(PARAM1,"SPE","PRCFMO")
- S PRCFMO("G/N")=$P(PRCFMO,U,12)
- S IDFLAG="I",REQ=$P(PO(0),U,12)
- ; get person 'Obligated By' from primary 2237
- VAR2 I REQ]"" D GENDIQ^PRCFFU7(410,+REQ,29,"IEN","") S PRC("PER")=$G(PRCTMP(410,+REQ,29,"I"))
- ; if no primary 2237, get person 'Obligated By' from node 10 on PO
- I REQ="" D
- .N L1,TT,NODE
- .S L1=$O(^PRC(442,+PO,10,0)) Q:L1="" D
- ..S NODE=^PRC(442,+PO,10,L1,0),TT=$P(NODE,".",1,2)
- ..I TT="921.60"!(TT="921.00") S PRC("PER")=$P(NODE,U,2)
- ..Q
- .Q
- ; if all else fails, use DUZ of person running conversion
- I '$D(PRC("PER")) D DUZ^PRCFSITE
- S PRCFA("MOD")=$S(PI2="E":"E^0^Original Entry",PI2="M":"M^1^Modification Entry")
- S PRCFA("IDES")="Conversion III/CALM Code Sheet "
- I PRCFA("MP")=21 S PRCFA("IDES")=PRCFA("IDES")_"1358 Obligation" D NODE^PRCS58OB(+REQ,.TRNODE)
- E S PRCFA("IDES")=PRCFA("IDES")_"Purchase Order"
- I $D(ZTQUEUED) S PRCFA("CONVS")=1
- D:'$D(ZTQUEUED) EN^DDIOL("...now converting CALM code sheet for obligation "_PRCFA("REF")_"...")
- STACK D STACK^PRCFFU(PRCFA("MOD"))
- K ^TMP($J,"PRCMO")
- S FMSINT=+PO,FMSMOD=$P(PRCFA("MOD"),U,1)
- D NEW^PRCFFU1(FMSINT,PRCFA("TT"),FMSMOD)
- S LOOP=0 F S LOOP=$O(^TMP($J,"PRCMO",GECSFMS("DA"),LOOP)) Q:'LOOP D SETCS^GECSSTAA(GECSFMS("DA"),^(LOOP))
- K ^TMP($J,"PRCMO")
- D SETSTAT^GECSSTAA(GECSFMS("DA"),"Q")
- I '$D(POESIG) I $D(PRCFA("PODA")),+PRCFA("PODA")>0 S POESIG=1
- S P2=+PO,$P(P2,"/",5)=$P($G(PRCFA("ACCPD")),U),$P(P2,"/",6)=PRCFA("OBLDATE")
- S:PRCFA("MP")=21 $P(P2,"/",3)=REQ
- D SETPARAM^GECSSDCT(GECSFMS("DA"),P2)
- S FMSDOCT=$P(PRCFA("REF"),"-",2) D EN7^PRCFFU41(PRCFA("TT"),FMSMOD,PRCFA("OBLDATE"),FMSDOCT)
- D KILL
- Q
- KILL K BEGDATE,DIC,FMSMOD,FMSVENID,FOB,GECSFMS,IDFLAG,NUMB,PARAM1,PARTDT,PCP
- K PO,PODATE,PRC,PRCCC,PRCCCC,PRCCP,PRCCSCC,PRCFA,PRCFMO,PRCREQST,PRCSTA
- K PRCSTR,PRCTMP,REQ,SATSTN,STR2,TRNODE,X,Y
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRC5CON3 3054 printed Feb 18, 2025@23:26:25 Page 2
- PRC5CON3 ;WISC/SJG-GENERATE FMS DOCS FOR CONVERSION III ;
- V ;;5.0;IFCAP;**27**;4/21/95
- +1 ;
- +2 QUIT
- +3 ; No top level entry
- +4 ;
- +5 ; Front end routine for Conversion III 'Held' Documents from 423
- EN(PI1,PI2,PI3) ;
- +1 ; Parameters passed from entry in File 423
- +2 ; PI1 = Internal Record Number from File 442
- +3 ; PI2 = Document Action, i.e, "E" or "M"
- +4 ; PI3 = Transmission Date
- GET NEW DATE,FMSDOCT,FMSINT,LOOP,P2
- +1 SET X=PI1
- SET DIC=442
- SET DIC(0)="NZ"
- DO ^DIC
- KILL DIC
- +2 IF Y<0
- if '$DATA(ZTQUEUED)
- WRITE !,"No entry found in File 442!!!"
- QUIT
- VAR SET PO(0)=Y(0)
- SET PO=Y
- SET PRCFA("PODA")=+Y
- +1 SET PRC("SITE")=$PIECE(PO(0),"-")
- SET PRCFA("OBLDATE")=PI3
- +2 SET PCP=+$PIECE(PO(0),"^",3)
- SET $PIECE(PCP,"^",2)=$SELECT($DATA(^PRC(420,PRC("SITE"),1,+PCP,0)):$PIECE(^(0),"^",12),1:"")
- KILL Y
- +3 SET PARTDT=PRCFA("OBLDATE")
- DO PARTS^PRCFFUC(PARTDT,.DATE)
- SET PRCFA("ACCPD")=DATE
- +4 SET PRC("FY")=$EXTRACT($PIECE($$DATE^PRC0C(PI3,"I"),"^"),3,4)
- +5 SET PRCFA("REF")=$PIECE(PO(0),U)
- SET PRCFA("SYS")="FMS"
- +6 SET PRCFA("SFC")=$PIECE(PO(0),U,19)
- SET PRCFA("MP")=$PIECE(PO(0),U,2)
- +7 SET PRCFA("TT")=$SELECT(PRCFA("MP")=2:"SO",PRCFA("MP")=1:"MO",PRCFA("MP")=8:"MO",PRCFA("MP")=21:"SO",1:"MO")
- VAR1 SET PRCFA("BBFY")=$$BBFY^PRCFFU5(+PO)
- DO BBFYCHK^PRCFFU19(+PO)
- +1 SET PARAM1="^"_PRC("SITE")_"^"_+PCP_"^"_PRC("FY")_"^"_PRCFA("BBFY")
- +2 DO DOCREQ^PRC0C(PARAM1,"SPE","PRCFMO")
- +3 SET PRCFMO("G/N")=$PIECE(PRCFMO,U,12)
- +4 SET IDFLAG="I"
- SET REQ=$PIECE(PO(0),U,12)
- +5 ; get person 'Obligated By' from primary 2237
- VAR2 IF REQ]""
- DO GENDIQ^PRCFFU7(410,+REQ,29,"IEN","")
- SET PRC("PER")=$GET(PRCTMP(410,+REQ,29,"I"))
- +1 ; if no primary 2237, get person 'Obligated By' from node 10 on PO
- +2 IF REQ=""
- Begin DoDot:1
- +3 NEW L1,TT,NODE
- +4 SET L1=$ORDER(^PRC(442,+PO,10,0))
- if L1=""
- QUIT
- Begin DoDot:2
- +5 SET NODE=^PRC(442,+PO,10,L1,0)
- SET TT=$PIECE(NODE,".",1,2)
- +6 IF TT="921.60"!(TT="921.00")
- SET PRC("PER")=$PIECE(NODE,U,2)
- +7 QUIT
- End DoDot:2
- +8 QUIT
- End DoDot:1
- +9 ; if all else fails, use DUZ of person running conversion
- +10 IF '$DATA(PRC("PER"))
- DO DUZ^PRCFSITE
- +11 SET PRCFA("MOD")=$SELECT(PI2="E":"E^0^Original Entry",PI2="M":"M^1^Modification Entry")
- +12 SET PRCFA("IDES")="Conversion III/CALM Code Sheet "
- +13 IF PRCFA("MP")=21
- SET PRCFA("IDES")=PRCFA("IDES")_"1358 Obligation"
- DO NODE^PRCS58OB(+REQ,.TRNODE)
- +14 IF '$TEST
- SET PRCFA("IDES")=PRCFA("IDES")_"Purchase Order"
- +15 IF $DATA(ZTQUEUED)
- SET PRCFA("CONVS")=1
- +16 if '$DATA(ZTQUEUED)
- DO EN^DDIOL("...now converting CALM code sheet for obligation "_PRCFA("REF")_"...")
- STACK DO STACK^PRCFFU(PRCFA("MOD"))
- +1 KILL ^TMP($JOB,"PRCMO")
- +2 SET FMSINT=+PO
- SET FMSMOD=$PIECE(PRCFA("MOD"),U,1)
- +3 DO NEW^PRCFFU1(FMSINT,PRCFA("TT"),FMSMOD)
- +4 SET LOOP=0
- FOR
- SET LOOP=$ORDER(^TMP($JOB,"PRCMO",GECSFMS("DA"),LOOP))
- if 'LOOP
- QUIT
- DO SETCS^GECSSTAA(GECSFMS("DA"),^(LOOP))
- +5 KILL ^TMP($JOB,"PRCMO")
- +6 DO SETSTAT^GECSSTAA(GECSFMS("DA"),"Q")
- +7 IF '$DATA(POESIG)
- IF $DATA(PRCFA("PODA"))
- IF +PRCFA("PODA")>0
- SET POESIG=1
- +8 SET P2=+PO
- SET $PIECE(P2,"/",5)=$PIECE($GET(PRCFA("ACCPD")),U)
- SET $PIECE(P2,"/",6)=PRCFA("OBLDATE")
- +9 if PRCFA("MP")=21
- SET $PIECE(P2,"/",3)=REQ
- +10 DO SETPARAM^GECSSDCT(GECSFMS("DA"),P2)
- +11 SET FMSDOCT=$PIECE(PRCFA("REF"),"-",2)
- DO EN7^PRCFFU41(PRCFA("TT"),FMSMOD,PRCFA("OBLDATE"),FMSDOCT)
- +12 DO KILL
- +13 QUIT
- KILL KILL BEGDATE,DIC,FMSMOD,FMSVENID,FOB,GECSFMS,IDFLAG,NUMB,PARAM1,PARTDT,PCP
- +1 KILL PO,PODATE,PRC,PRCCC,PRCCCC,PRCCP,PRCCSCC,PRCFA,PRCFMO,PRCREQST,PRCSTA
- +2 KILL PRCSTR,PRCTMP,REQ,SATSTN,STR2,TRNODE,X,Y
- +3 QUIT