PRCVSUB ;ISC-SF/GJW ; 6/6/05 11:38am
 ;;5.1;IFCAP;**81**;Oct 20, 2000
 ;Per VHA Directive 10-93-142, this routine should not be modified.
 ;
ADDSUB(PRCVSTAT,PRCVENT,PRCVTYP,PRCVMID) ;
 N FDA,RESULT,MROOT,VAL,ERRNO
 D ISEND(PRCVSTAT,PRCVENT)
 S FDA(414.03,"?+1,",.01)=+$G(PRCVSTAT)
 S FDA(414.03,"?+1,",.02)=$G(PRCVENT)
 S FDA(414.03,"?+1,",.03)=$G(PRCVTYP)
 S FDA(414.03,"?+1,",1)=$$NOW^XLFDT
 S FDA(414.03,"?+1,",2)=1
 S FDA(414.03,"?+1,",3)=$G(PRCVMID)
 ;need "E" because the type field is a set of codes
 D UPDATE^DIE("EK","FDA","RESULT","MROOT")
 I $D(MROOT("DIERR")) D  ;error(s) occured
 .S VAL="E",ERRNO=""
 .F  S ERRNO=$O(MROOT("DIERR","E",ERRNO)) Q:ERRNO=""  D
 ..S VAL=VAL_"^"_ERRNO
 E  D
 .S VAL=$G(RESULT(1,0))_"^"_$G(RESULT(1))
 Q VAL
 ;
FINDSUB(PRCVSTAT,PRCVENT,PRCVTYP) ;
 N OUT,MROOT,VALUES,VAL,ERRNO
 S VALUES(1)=+$G(PRCVSTAT)
 S VALUES(2)=$G(PRCVENT)
 S VALUES(3)=$G(PRCVTYP)
 S VAL=$$FIND1^DIC(414.03,,"K",.VALUES,,,"MROOT")
 I $D(MROOT("DIERR")) D  ;error(s) occured
 .S VAL=-1,ERRNO=""
 .F  S ERRNO=$O(MROOT("DIERR","E",ERRNO)) Q:ERRNO=""  D
 ..S VAL=VAL_"^"_ERRNO
 Q VAL
 ;
DELSUB(PRCVSTAT,PRCVENT,PRCVTYP) ;
 N VAL,IENS,MYFDA,MROOT,ERRNO
 S VAL=$$FINDSUB(PRCVSTAT,PRCVENT,PRCVTYP)
 Q:+VAL'>0 VAL
 S IENS=+VAL_","
 S MYFDA(414.03,IENS,.01)="@"
 D FILE^DIE(,"MYFDA","MROOT")
 Q:'$D(MROOT("DIERR")) "@^"_+VAL
 ;an error occured in FILE^DIE
 S VAL="E",ERRNO=""
 F  S ERRNO=$O(MROOT("DIERR","E",ERRNO)) Q:ERRNO=""  D
 .S VAL=VAL_"^"_ERRNO
 Q VAL
 ;
 ;immediate send
ISEND(PRCVSTAT,PRCVFCP) ;
 N ROOT,I
 S ROOT=$NA(^PRC(420,PRCVSTAT,1,PRCVFCP,4,"B"))
 S I=""
 F  S I=$O(@ROOT@(I)) Q:I=""  D
 .I $$FY4^PRCVMON(I)'<$$GETFY^PRCVMON D
 ..D PUSH1^PRCVMON(PRCVSTAT,I,PRCVFCP)
 Q