Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRCVSUB

PRCVSUB.m

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