source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCB8A.m@ 1710

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

initial load of WorldVistAEHR

File size: 3.3 KB
RevLine 
[613]1PRCB8A ;WISC/PLT-AUTO GENERATE FMS DOCUMENTS ; 08/16/95 3:30 PM
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 QUIT ;invalid entry
5 ;
6 ;.X = record id of file 2100.1 if generated, "" if fail
7 ;PRCFC is ^1=FMS documents (fileman) date, ^2=doc year, ^3=doc quarter
8 ; ^4=SITE #, ^5=fund control point #, ^6=$amount, ^7=BBFY
9 ; ^8=fcp # if from AT, ^9=fiscal accounting period mmyy, ^10=cal acct per
10 ;PRCID data ^1=file 2100.1 ri, ^2= document id if regenerated
11SA(X,PRCFC,PRCID) ;SA auto document
12 N PRCA,PRCB,PRCC,PRCDDT,PRCF,PRCQ,PRCRI,PRCSITE,PRCY,GECSFMS,PRCLACT,PRCAP
13 N A,B,Z
14 S PRCDDT=$P(PRCFC,"^"),PRCY=$P(PRCFC,"^",2),PRCQ=$P(PRCFC,"^",3)
15 S PRCSITE=+$P(PRCFC,"^",4),PRCRI(420.01)=+$P(PRCFC,"^",5),PRCAMT=$P(PRCFC,"^",6),PRCAP=$P(PRCFC,"^",9)_"/"_$P(PRCFC,"^",10)
16 I $G(PRCID)]"" S PRCRI(2100.1)=+PRCID,PRCID=$P(PRCID,"^",2)
17 I $G(PRCID)="" S (X,Z)=PRCSITE_"-FC" D EN1^PRCSUT3 S X="0000"_+$P(X,"-",3),PRCID=PRCSITE_"FC"_$E(X,$L(X)-3,$L(X))
18 S PRCY=$$YEAR^PRC0C(PRCY)+0
19 D ;get required fields data and line action code
20 . D DOCREQ^PRC0C("^"_PRCSITE_"^"_PRCRI(420.01)_"^"_$E(PRCY,3,4)_"^"_$P(PRCFC,"^",7),"SAB","PRCF")
21 . S A=$$FMSACC^PRC0D(PRCSITE,PRCF),B=$$FIRST^PRC0B1("^PRCD(420.141,""B"","""_A_""",",0)
22 . I B S PRCLACT="C"
23 . E S A=$$A420D141^PRC0F(A,$P(PRCFC,"^",5)),PRCLACT="C"
24 . QUIT
25 I $G(PRCRI(2100.1)) D REBUILD^GECSUFM1(PRCRI(2100.1),"I",$$SEC1^PRC0C(PRCSITE),"Y","Edited Rejected Auto SA Document")
26 ;add entry in file 2100.1 if not rejected process
27 D:$G(PRCRI(2100.1))="" G EXIT:PRCRI(2100.1)<1
28 . D CONTROL^GECSUFMS("I",PRCSITE,PRCID,"SA",$$SEC1^PRC0C(PRCSITE),0,"Y","Original Auto SA Document")
29 . S PRCRI(2100.1)=GECSFMS("DA")
30 . QUIT
31 D SETPARAM^GECSSDCT(PRCRI(2100.1),$P($TR(PRCFC,"^","/"),"/",1,8)_"/"_PRCLACT_"/"_PRCAP)
32 S PRCC=1,PRCB(PRCC)=""
33 D SADOC,DLM("~")
34 D SALIN,DLM("~{")
35 S PRCA="" F S PRCA=$O(PRCB(PRCA)) Q:'PRCA D SETCS^GECSSTAA(PRCRI(2100.1),PRCB(PRCA))
36 D:PRCLACT="A" SETCODE^GECSSDCT(PRCRI(2100.1),"D SAREJ^PRCB1C")
37 D SETSTAT^GECSSTAA(PRCRI(2100.1),"Q")
38EXIT S X=$G(PRCRI(2100.1))_"^"_PRCID
39 QUIT
40 ;
41SADOC ;assemble SA doc
42 D STR("SA2",3),STR($E(PRCDDT,4,5),2),STR($E(PRCDDT,6,7),2),STR($E(PRCDDT,2,3),2)
43 D STR($E(PRCAP,1,2),2),STR($E(PRCAP,3,4),2),STR($E($P(PRCF,"^",6),3,4),2),STR($S($P(PRCF,"^",6)=$P(PRCF,"^",7):"",1:$E($P(PRCF,"^",7),3,4)),2)
44 D STR("01",2),STR($P(PRCF,"^",5),6),STR($FN(PRCAMT,"-",2),12)
45 S X=$$DATE^PRC0C(PRCDDT,"I"),X=$S(PRCY_"^"_PRCQ]$P(X,"^",1,2):"DA",1:"DP")
46 D STR(X,2),STR("02",2)
47 D STR($S(X="DP":"03",1:""),2),STR("",1)
48 QUIT
49 ;
50SALIN ;assemble SA line
51 D STR("LIN",3),DLM("~"),STR("SAA",3),STR(PRCLACT,1)
52 D STR($S($G(PRCF("SITE"))="N":"",1:PRCSITE),7)
53 D STR($S($G(PRCF("AO"))="N":"",1:$P(PRCF,"^")),4)
54 D STR($S($G(PRCF("SITE"))="N":"",1:PRCSITE),7)
55 D STR($S($G(PRCF("FCPRJ"))="N":"",1:$P(PRCF,"^",3)),9)
56 D STR($S($G(PRCF("OC"))="N":"",1:$P(PRCF,"^",4)),4)
57 F A=6,12,12,12,12 D STR("",A)
58 F A=1:1:4 D STR($S(PRCQ=A:$FN(PRCAMT,"-",2),1:""),12)
59 F A=30,1 D STR("",30)
60 F A=1:1:4 D STR($S(PRCQ=A&(PRCAMT<0):"D",PRCQ=A:"I",1:""),12)
61 D STR("",1)
62 QUIT
63 ;
64 ;A = data, B = field length
65STR(A,B) ;store data in node/piece
66 S:$L(PRCB(PRCC))+$L(A)>230 PRCC=PRCC+1,PRCB(PRCC)=""
67 S PRCB(PRCC)=PRCB(PRCC)_$E(A,1,B)_"^"
68 QUIT
69 ;
70DLM(A) ;store seg ~ or txn { delimiters
71 S PRCB(PRCC)=PRCB(PRCC)_A
72 QUIT
73 ;
Note: See TracBrowser for help on using the repository browser.