| 1 | PRCB8A1 ;WISC/PLT-PRCB8A CONTINUED ; 08/16/95 3:29 PM
|
|---|
| 2 | V ;;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 #
|
|---|
| 9 | ; ^5 = transfer from control point #, ^6 = $amount,
|
|---|
| 10 | ; ^7 = BBFY, ^8 = to fund control point #, ^9=fiscal accounting period (mmyy), ^10=Cal acct per
|
|---|
| 11 | ;PRCID=FMS document id if regenerated
|
|---|
| 12 | ST(X,PRCFC,PRCID) ;ST auto document
|
|---|
| 13 | N PRCA,PRCB,PRCC,PRCDDT,PRCF,PRCF1,PRCQ,PRCRI,PRCSITE,PRCY,GECSFMS,PRCAP
|
|---|
| 14 | N A,B,Z
|
|---|
| 15 | S PRCDDT=$P(PRCFC,"^"),PRCY=$P(PRCFC,"^",2),PRCQ=$P(PRCFC,"^",3)
|
|---|
| 16 | S PRCSITE=+$P(PRCFC,"^",4),PRCRI(420.01)=+$P(PRCFC,"^",5),PRCAMT=$P(PRCFC,"^",6)
|
|---|
| 17 | S PRCRI("420.01A")=$P(PRCFC,"^",8),PRCAP=$P(PRCFC,"^",9)_"/"_$P(PRCFC,"^",10)
|
|---|
| 18 | I $G(PRCID)]"" S PRCRI(2100.1)=+PRCID,PRCID=$P(PRCID,"^",2)
|
|---|
| 19 | 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))
|
|---|
| 20 | S PRCY=$$YEAR^PRC0C(PRCY)+0
|
|---|
| 21 | I $G(PRCRI(2100.1)) D REBUILD^GECSUFM1(PRCRI(2100.1),"I",$$SEC1^PRC0C(PRCSITE),"Y","Edited Rejected Auto ST Document")
|
|---|
| 22 | ;add entry in file 2100.1 if not rejected process
|
|---|
| 23 | D:$G(PRCRI(2100.1))="" G EXIT:PRCRI(2100.1)<1
|
|---|
| 24 | . D CONTROL^GECSUFMS("I",PRCSITE,PRCID,"ST",$$SEC1^PRC0C(PRCSITE),0,"Y","Original Auto ST Document")
|
|---|
| 25 | . S PRCRI(2100.1)=GECSFMS("DA")
|
|---|
| 26 | . QUIT
|
|---|
| 27 | D SETPARAM^GECSSDCT(PRCRI(2100.1),$P($TR(PRCFC,"^","/"),"/",1,8)_"//"_PRCAP)
|
|---|
| 28 | S PRCC=1,PRCB(PRCC)=""
|
|---|
| 29 | D STDOC,DLM("~")
|
|---|
| 30 | D STLIN,DLM("~{")
|
|---|
| 31 | S PRCA="" F S PRCA=$O(PRCB(PRCA)) Q:'PRCA D SETCS^GECSSTAA(PRCRI(2100.1),PRCB(PRCA))
|
|---|
| 32 | D SETSTAT^GECSSTAA(PRCRI(2100.1),"Q")
|
|---|
| 33 | EXIT S X=$G(PRCRI(2100.1))_"^"_PRCID
|
|---|
| 34 | QUIT
|
|---|
| 35 | ;
|
|---|
| 36 | STDOC ;assemble ST doc
|
|---|
| 37 | D DOCREQ^PRC0C("^"_PRCSITE_"^"_PRCRI(420.01)_"^"_$E(PRCY,3,4)_"^"_$P(PRCFC,"^",7),"SAB","PRCF")
|
|---|
| 38 | D DOCREQ^PRC0C("^"_PRCSITE_"^"_PRCRI("420.01A")_"^"_$E(PRCY,3,4)_"^"_$P(PRCFC,"^",7),"SAB","PRCF1")
|
|---|
| 39 | D STR("ST2",3),STR($E(PRCDDT,4,5),2),STR($E(PRCDDT,6,7),2),STR($E(PRCDDT,2,3),2)
|
|---|
| 40 | 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)
|
|---|
| 41 | D STR($P(PRCF,"^",5),6)
|
|---|
| 42 | QUIT
|
|---|
| 43 | ;
|
|---|
| 44 | STLIN ;assemble ST line
|
|---|
| 45 | D STR("LIN",3),DLM("~"),STR("STA",3)
|
|---|
| 46 | D STR($S($G(PRCF("AO"))="N":"",1:$P(PRCF,"^")),4)
|
|---|
| 47 | D STR($S($G(PRCF("SITE"))="N":"",1:PRCSITE),7)
|
|---|
| 48 | D STR($S($G(PRCF("FCPRJ"))="N":"",1:$P(PRCF,"^",3)),9)
|
|---|
| 49 | D STR($S($G(PRCF("OC"))="N":"",1:$P(PRCF,"^",4)),4)
|
|---|
| 50 | D STR(PRCQ,1)
|
|---|
| 51 | S X=$$DATE^PRC0C(PRCDDT,"I"),X=$S(PRCY_"^"_PRCQ]$P(X,"^",1,2):"A",1:"Y") D STR(X,1)
|
|---|
| 52 | D STR($S($G(PRCF1("AO"))="N":"",1:$P(PRCF1,"^")),4)
|
|---|
| 53 | D STR($S($G(PRCF1("SITE"))="N":"",1:PRCSITE),7)
|
|---|
| 54 | D STR($S($G(PRCF1("FCPRJ"))="N":"",1:$P(PRCF1,"^",3)),9)
|
|---|
| 55 | D STR($S($G(PRCF1("OC"))="N":"",1:$P(PRCF1,"^",4)),4)
|
|---|
| 56 | D STR(PRCQ,1),STR($FN(PRCAMT,"-",2),15)
|
|---|
| 57 | QUIT
|
|---|
| 58 | ;
|
|---|
| 59 | ;
|
|---|
| 60 | ;A = data, B = field length
|
|---|
| 61 | STR(A,B) ;store data in node/piece
|
|---|
| 62 | S:$L(PRCB(PRCC))+$L(A)>230 PRCC=PRCC+1,PRCB(PRCC)=""
|
|---|
| 63 | S PRCB(PRCC)=PRCB(PRCC)_$E(A,1,B)_"^"
|
|---|
| 64 | QUIT
|
|---|
| 65 | ;
|
|---|
| 66 | DLM(A) ;store seg ~ or txn { delimiters
|
|---|
| 67 | S PRCB(PRCC)=PRCB(PRCC)_A
|
|---|
| 68 | QUIT
|
|---|
| 69 | ;
|
|---|
