| [613] | 1 | PRCH8A ;WISC/PLT-AUTO GENERATE FMS ET-DOCUMENTS ; 09/10/96 9:36 AM
|
|---|
| 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 data: ^1=ri of 440.6, ^2=ri of 442, ^3 =1 if 440.6 is d, =2 if 442 is d, ^4 = BOC from 442
|
|---|
| 8 | ;PRCID data ^1=file 2100.1 ri, ^2= document id (if regenerated)
|
|---|
| 9 | ET(X,PRCFC,PRCID) ;ET auto document
|
|---|
| 10 | N PRCA,PRCB,PRCC,PRCDDT,PRCF,PRCQ,PRCRI,PRCSITE,PRCY,GECSFMS,PRCLACT,PRCAP,PRCDD
|
|---|
| 11 | N PRCDI,PRCBOC,PRCEM,PRCIDL
|
|---|
| 12 | N A,B,Z
|
|---|
| 13 | S PRCRI(440.6)=$P(PRCFC,"^"),PRCRI(442)=$P(PRCFC,"^",2),PRCDI=$P(PRCFC,"^",3),PRCBOC=$P(PRCFC,"^",4)
|
|---|
| 14 | S PRCIDL=$P(^PRCH(440.6,PRCRI(440.6),0),"^")
|
|---|
| 15 | S PRCDD=$$DD^PRCH0A(PRCRI(440.6)_"^"_DT,PRCRI(442)),PRCSITE=$E($P(PRCDD,"^",3),1,3),PRCEM=$P($P(PRCDD,"~",2),"^",9)
|
|---|
| 16 | I $G(PRCID)]"" S PRCRI(2100.1)=+PRCID,PRCID=$P(PRCID,"^",2),PRCEM=$S($P(PRCID,"-",2)="":"E",1:"M"),A=$P(PRCDD,"~",2),$P(A,"^",9)=PRCEM,$P(PRCDD,"~",2)=A
|
|---|
| 17 | I $G(PRCID)="" S PRCID=$P(PRCDD,"^",3)
|
|---|
| 18 | ;D ;get required fields data and line action code
|
|---|
| 19 | ;. D DOCREQ^PRC0C("^"_PRCSITE_"^"_PRCRI(420.01)_"^"_$E(PRCY,3,4)_"^"_$P(PRCFC,"^",7),"ET","PRCF")
|
|---|
| 20 | ;. QUIT
|
|---|
| 21 | I $G(PRCRI(2100.1)) D REBUILD^GECSUFM1(PRCRI(2100.1),"I",$$SEC1^PRC0C(PRCSITE),"","Edited Rejected Auto ET 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,"ET",$$SEC1^PRC0C(PRCSITE),$S(PRCEM="M":1,1:0),"","Auto ET Document")
|
|---|
| 25 | . S PRCRI(2100.1)=GECSFMS("DA")
|
|---|
| 26 | . QUIT
|
|---|
| 27 | D SETPARAM^GECSSDCT(PRCRI(2100.1),$TR(PRCFC,"^","/"))
|
|---|
| 28 | S PRCC=1,PRCB(PRCC)=$P(PRCDD,"~",2)_"^~"
|
|---|
| 29 | S PRCB(2)="LIN^~"_$$DDA4406^PRCH0A(PRCRI(440.6))
|
|---|
| 30 | S PRCB(3)="LIN^~"_$$DDA442^PRCH0A(PRCRI(442)),$P(PRCB(3),"^",34)=$P(PRCB(2),"^",34) I $G(PRCBOC)]"" S $P(PRCB(3),"^",22)=PRCBOC
|
|---|
| 31 | F A=2,3 S $P(PRCB(A),"^",3)=$E(A-2*500+$E(PRCIDL,13,15)+1000,2,4),$P(PRCB(A),"^",35)=$E("DI",A-1),PRCB(A)=PRCB(A)_"^~"
|
|---|
| 32 | I PRCDI=2 F A=2,3 S $P(PRCB(A),"^",35)=$E("ID",A-1)
|
|---|
| 33 | I $P(PRCB(2),"^",34)<0 S A=$P(PRCB(2),"^",35),$P(PRCB(2),"^",35)=$P(PRCB(3),"^",35),$P(PRCB(3),"^",35)=A F A=2,3 S $P(PRCB(A),"^",34)=$E($P(PRCB(A),"^",34),2,999)
|
|---|
| 34 | I $P(PRCB(2),"^",35)'="D" S A=PRCB(2),PRCB(2)=PRCB(3),PRCB(3)=A
|
|---|
| 35 | S PRCA="" F S PRCA=$O(PRCB(PRCA)) Q:'PRCA D SETCS^GECSSTAA(PRCRI(2100.1),PRCB(PRCA))
|
|---|
| 36 | D SETSTAT^GECSSTAA(PRCRI(2100.1),"Q")
|
|---|
| 37 | EXIT S X=$G(PRCRI(2100.1))_"^"_PRCID
|
|---|
| 38 | QUIT
|
|---|
