source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCFFU8.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.2 KB
RevLine 
[613]1PRCFFU8 ;WISC/SJG-OBLIGATION PROCESSING UTILITIES, CON'T ;7/24/00 23:11
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ; No Top Level Entry
6 QUIT
7MSG ;
8 W !!,"This Purchase Order Amendment will not require a Modification "
9 W:PRCFA("TT")="MO" !,"Miscellaneous Order (MO) "
10 W:PRCFA("TT")="SO" !,"Service Order (SO) "
11 W "Document for the following reason(s):"
12 W !!,"The Amendment consisted of: "
13 I $D(PRCFA("SHIP")),PRCFA("SHIP")]"" W ?30,PRCFA("SHIP"),!
14 I $D(PRCFA("SOURCE")),PRCFA("SOURCE")]"" W ?30,PRCFA("SOURCE"),!
15 I $D(PRCFA("MAIL")),PRCFA("MAIL")]"" W ?30,PRCFA("MAIL"),!
16 I $D(PRCFA("ADMADD")),PRCFA("ADMADD")]"" W ?30,PRCFA("ADMADD"),!
17 I $D(PRCFA("ADMDEL")),PRCFA("ADMDEL")]"" W ?30,PRCFA("ADMDEL"),!
18 I $D(PRCFA("AUTH")),PRCFA("AUTH")]"" W ?30,PRCFA("AUTH"),!
19 I $D(PRCFA("ZERO")),PRCFA("ZERO")]"" W ?30,PRCFA("ZERO"),! H 3
20 I $D(PRCFA("WASH")),PRCFA("WASH")]"" W ?30,PRCFA("WASH"),! H 3
21 W !!,"No Modification FMS Document has been transmitted!!" H 3
22 QUIT
23 ;
24CANCEL(REF,TYPE) ; Cancel FMS Obligation Documents
25 ; REF - PAT Reference Number
26 ; TYPE - FMS Transaction Type
27 ; DATA - MO2 Segment
28 N DATA
29 S (PRCFA("MOD"),PRCFA("CANCEL"))="X^2^Cancellation Entry"
30 S FMSMOD=$P(PRCFA("MOD"),U)
31 I PRCFA("TT")="AR",$E(REF,11,12)'=12 S REF=$E(REF,1,10)_12
32 S FMSSEC=$$SEC1^PRC0C(PRC("SITE"))
33 I TYPE="AR" D CANC S TYPE="SO",REF=$E(REF,1,10)
34 D:$G(MTOPDA)="" DEC,CANC Q
35DEC ;
36 Q:XRBLD=2 ; exit if rebuilding the 'E' (amended original) transaction
37 W !!,"...now generating the FMS Decrease "_TYPE_" Obligation Document..."
38 S FMSDES="Decrease Obligation Amount of "_TYPE_" Obligation Document"
39 I XRBLD=0 D CONTROL^GECSUFMS("I",PRC("SITE"),REF,TYPE,FMSSEC,1,"Y",FMSDES)
40 S DATA=$$SEG2^PRCFFU8("X^"_TYPE,POIEN,.SEG)
41 D GECS
42 S PRCFA("PODA")=PRCFA("OLDPODA")
43 I '$D(POESIG) I $D(PRCFA("PODA")),+PRCFA("PODA")>0 S POESIG=1
44 N FMSDOCT S FMSDOCT=$P(PRCFA("REF"),"-",2)
45 D EN7^PRCFFU41(TYPE,FMSMOD,PRCFA("OBLDATE"),FMSDOCT)
46 Q
47CANC ;
48 Q:XRBLD=2
49 W !!,"...now generating the FMS "_TYPE_" Cancellation Document..."
50 S FMSDES="Cancellation of "_TYPE_" Obligation Document"
51 I XRBLD=0 D CONTROL^GECSUFMS("I",PRC("SITE"),REF,TYPE,FMSSEC,1,"Y",FMSDES)
52 S DATA=$$SEG2^PRCFFU8("X^"_TYPE,POIEN,.SEG)
53 D GECS
54 S PRCFA("PODA")=PRCFA("OLDPODA")
55 I '$D(POESIG) I $D(PRCFA("PODA")),+PRCFA("PODA")>0 S POESIG=1
56 N FMSDOCT S FMSDOCT=$P(PRCFA("REF"),"-",2)
57 D EN7^PRCFFU41(TYPE,FMSMOD,PRCFA("OBLDATE"),FMSDOCT)
58 Q
59 ;
60GECS ; Common GECS processing for 'X' documents
61 D SETCS^GECSSTAA(GECSFMS("DA"),DATA)
62 D SETSTAT^GECSSTAA(GECSFMS("DA"),"Q")
63 N P2 S P2=+PO_"/"_PRCFA("AMEND#"),$P(P2,"/",5)=$P($G(PRCFA("ACCPD")),U),$P(P2,"/",6)=PRCFA("OBLDATE")
64 D SETPARAM^GECSSDCT(GECSFMS("DA"),P2)
65 Q
66SEG2(TYPE,IEN,SEG) ; Create MO2 segment for cancellation document
67 ; IEN - Internal Entry Number of Purchase Order
68 ; TYPE - FMS Document Type
69 ; SEG - Return value for MO2 segment
70 D GENDIQ^PRCFFU7(442,IEN,.1,"I","")
71 S FMSPODAT=$G(PRCFA("OBLDATE"))
72 I FMSPODAT="" D NOW^%DTC S FMSPODAT=X
73 D DATE^PRCFFU2(FMSPODAT,.A,.B,.C)
74 S FMSPODAT=FMSYR_"^"_FMSMO_"^"_FMSDAY
75 I $P(TYPE,"^",2)="AR" S SEG="RC2",$P(SEG,U,7)=$P(TYPE,"^",1)_"^~"
76 E S SEG="MO2",$P(SEG,U,10)=$P(TYPE,"^",1)_"^~"
77 S $P(SEG,"^",2,4)=FMSPODAT
78 K PRCTMP
79 QUIT SEG
Note: See TracBrowser for help on using the repository browser.