59 lines
1.7 KiB
Mathematica
59 lines
1.7 KiB
Mathematica
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
|