| 1 | PRCVSUB ;ISC-SF/GJW ; 6/6/05 11:38am
|
|---|
| 2 | ;;5.1;IFCAP;**81**;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ADDSUB(PRCVSTAT,PRCVENT,PRCVTYP,PRCVMID) ;
|
|---|
| 6 | N FDA,RESULT,MROOT,VAL,ERRNO
|
|---|
| 7 | D ISEND(PRCVSTAT,PRCVENT)
|
|---|
| 8 | S FDA(414.03,"?+1,",.01)=+$G(PRCVSTAT)
|
|---|
| 9 | S FDA(414.03,"?+1,",.02)=$G(PRCVENT)
|
|---|
| 10 | S FDA(414.03,"?+1,",.03)=$G(PRCVTYP)
|
|---|
| 11 | S FDA(414.03,"?+1,",1)=$$NOW^XLFDT
|
|---|
| 12 | S FDA(414.03,"?+1,",2)=1
|
|---|
| 13 | S FDA(414.03,"?+1,",3)=$G(PRCVMID)
|
|---|
| 14 | ;need "E" because the type field is a set of codes
|
|---|
| 15 | D UPDATE^DIE("EK","FDA","RESULT","MROOT")
|
|---|
| 16 | I $D(MROOT("DIERR")) D ;error(s) occured
|
|---|
| 17 | .S VAL="E",ERRNO=""
|
|---|
| 18 | .F S ERRNO=$O(MROOT("DIERR","E",ERRNO)) Q:ERRNO="" D
|
|---|
| 19 | ..S VAL=VAL_"^"_ERRNO
|
|---|
| 20 | E D
|
|---|
| 21 | .S VAL=$G(RESULT(1,0))_"^"_$G(RESULT(1))
|
|---|
| 22 | Q VAL
|
|---|
| 23 | ;
|
|---|
| 24 | FINDSUB(PRCVSTAT,PRCVENT,PRCVTYP) ;
|
|---|
| 25 | N OUT,MROOT,VALUES,VAL,ERRNO
|
|---|
| 26 | S VALUES(1)=+$G(PRCVSTAT)
|
|---|
| 27 | S VALUES(2)=$G(PRCVENT)
|
|---|
| 28 | S VALUES(3)=$G(PRCVTYP)
|
|---|
| 29 | S VAL=$$FIND1^DIC(414.03,,"K",.VALUES,,,"MROOT")
|
|---|
| 30 | I $D(MROOT("DIERR")) D ;error(s) occured
|
|---|
| 31 | .S VAL=-1,ERRNO=""
|
|---|
| 32 | .F S ERRNO=$O(MROOT("DIERR","E",ERRNO)) Q:ERRNO="" D
|
|---|
| 33 | ..S VAL=VAL_"^"_ERRNO
|
|---|
| 34 | Q VAL
|
|---|
| 35 | ;
|
|---|
| 36 | DELSUB(PRCVSTAT,PRCVENT,PRCVTYP) ;
|
|---|
| 37 | N VAL,IENS,MYFDA,MROOT,ERRNO
|
|---|
| 38 | S VAL=$$FINDSUB(PRCVSTAT,PRCVENT,PRCVTYP)
|
|---|
| 39 | Q:+VAL'>0 VAL
|
|---|
| 40 | S IENS=+VAL_","
|
|---|
| 41 | S MYFDA(414.03,IENS,.01)="@"
|
|---|
| 42 | D FILE^DIE(,"MYFDA","MROOT")
|
|---|
| 43 | Q:'$D(MROOT("DIERR")) "@^"_+VAL
|
|---|
| 44 | ;an error occured in FILE^DIE
|
|---|
| 45 | S VAL="E",ERRNO=""
|
|---|
| 46 | F S ERRNO=$O(MROOT("DIERR","E",ERRNO)) Q:ERRNO="" D
|
|---|
| 47 | .S VAL=VAL_"^"_ERRNO
|
|---|
| 48 | Q VAL
|
|---|
| 49 | ;
|
|---|
| 50 | ;immediate send
|
|---|
| 51 | ISEND(PRCVSTAT,PRCVFCP) ;
|
|---|
| 52 | N ROOT,I
|
|---|
| 53 | S ROOT=$NA(^PRC(420,PRCVSTAT,1,PRCVFCP,4,"B"))
|
|---|
| 54 | S I=""
|
|---|
| 55 | F S I=$O(@ROOT@(I)) Q:I="" D
|
|---|
| 56 | .I $$FY4^PRCVMON(I)'<$$GETFY^PRCVMON D
|
|---|
| 57 | ..D PUSH1^PRCVMON(PRCVSTAT,I,PRCVFCP)
|
|---|
| 58 | Q
|
|---|
