- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCVSUB 1748 printed Feb 18, 2025@23:46:42 Page 2
- PRCVSUB ;ISC-SF/GJW ; 6/6/05 11:38am
- +1 ;;5.1;IFCAP;**81**;Oct 20, 2000
- +2 ;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 ;
- ADDSUB(PRCVSTAT,PRCVENT,PRCVTYP,PRCVMID) ;
- +1 NEW FDA,RESULT,MROOT,VAL,ERRNO
- +2 DO ISEND(PRCVSTAT,PRCVENT)
- +3 SET FDA(414.03,"?+1,",.01)=+$GET(PRCVSTAT)
- +4 SET FDA(414.03,"?+1,",.02)=$GET(PRCVENT)
- +5 SET FDA(414.03,"?+1,",.03)=$GET(PRCVTYP)
- +6 SET FDA(414.03,"?+1,",1)=$$NOW^XLFDT
- +7 SET FDA(414.03,"?+1,",2)=1
- +8 SET FDA(414.03,"?+1,",3)=$GET(PRCVMID)
- +9 ;need "E" because the type field is a set of codes
- +10 DO UPDATE^DIE("EK","FDA","RESULT","MROOT")
- +11 ;error(s) occured
- IF $DATA(MROOT("DIERR"))
- Begin DoDot:1
- +12 SET VAL="E"
- SET ERRNO=""
- +13 FOR
- SET ERRNO=$ORDER(MROOT("DIERR","E",ERRNO))
- if ERRNO=""
- QUIT
- Begin DoDot:2
- +14 SET VAL=VAL_"^"_ERRNO
- End DoDot:2
- End DoDot:1
- +15 IF '$TEST
- Begin DoDot:1
- +16 SET VAL=$GET(RESULT(1,0))_"^"_$GET(RESULT(1))
- End DoDot:1
- +17 QUIT VAL
- +18 ;
- FINDSUB(PRCVSTAT,PRCVENT,PRCVTYP) ;
- +1 NEW OUT,MROOT,VALUES,VAL,ERRNO
- +2 SET VALUES(1)=+$GET(PRCVSTAT)
- +3 SET VALUES(2)=$GET(PRCVENT)
- +4 SET VALUES(3)=$GET(PRCVTYP)
- +5 SET VAL=$$FIND1^DIC(414.03,,"K",.VALUES,,,"MROOT")
- +6 ;error(s) occured
- IF $DATA(MROOT("DIERR"))
- Begin DoDot:1
- +7 SET VAL=-1
- SET ERRNO=""
- +8 FOR
- SET ERRNO=$ORDER(MROOT("DIERR","E",ERRNO))
- if ERRNO=""
- QUIT
- Begin DoDot:2
- +9 SET VAL=VAL_"^"_ERRNO
- End DoDot:2
- End DoDot:1
- +10 QUIT VAL
- +11 ;
- DELSUB(PRCVSTAT,PRCVENT,PRCVTYP) ;
- +1 NEW VAL,IENS,MYFDA,MROOT,ERRNO
- +2 SET VAL=$$FINDSUB(PRCVSTAT,PRCVENT,PRCVTYP)
- +3 if +VAL'>0
- QUIT VAL
- +4 SET IENS=+VAL_","
- +5 SET MYFDA(414.03,IENS,.01)="@"
- +6 DO FILE^DIE(,"MYFDA","MROOT")
- +7 if '$DATA(MROOT("DIERR"))
- QUIT "@^"_+VAL
- +8 ;an error occured in FILE^DIE
- +9 SET VAL="E"
- SET ERRNO=""
- +10 FOR
- SET ERRNO=$ORDER(MROOT("DIERR","E",ERRNO))
- if ERRNO=""
- QUIT
- Begin DoDot:1
- +11 SET VAL=VAL_"^"_ERRNO
- End DoDot:1
- +12 QUIT VAL
- +13 ;
- +14 ;immediate send
- ISEND(PRCVSTAT,PRCVFCP) ;
- +1 NEW ROOT,I
- +2 SET ROOT=$NAME(^PRC(420,PRCVSTAT,1,PRCVFCP,4,"B"))
- +3 SET I=""
- +4 FOR
- SET I=$ORDER(@ROOT@(I))
- if I=""
- QUIT
- Begin DoDot:1
- +5 IF $$FY4^PRCVMON(I)'<$$GETFY^PRCVMON
- Begin DoDot:2
- +6 DO PUSH1^PRCVMON(PRCVSTAT,I,PRCVFCP)
- End DoDot:2
- End DoDot:1
- +7 QUIT