- DIFGSRV ;SFISC/RWF-SERVER INTERFACE TO FILEGRAMS ;Jan 05, 2015
- ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
- ;;Per VA Directive 6402, this routine should not be modified.
- ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
- ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
- ;;Licensed under the terms of the Apache License, Version 2.0.
- ;
- Q
- HIST ;Add a message to the FileGram History file so it can be processed.
- S DIXM=0,U="^" X XMREC ;get first line
- I $P(XMRG,U)'="$DAT" S DIXM=DIXM+1,XQSTXT(DIXM)="First line of message doesn't start with '$DAT'"
- S DIFG=$P(XMRG,U,3)
- I DIFG<2 S DIXM=DIXM+1,XQSTXT(DIXM)="Can't update a VA FileMan file."
- I "^2^3^19^"[(U_DIFG_U) S DIXM=DIXM+1,XQSTXT(DIXM)="Update to a protected file (#"_DIFG_")."
- Q:DIXM
- S DIFG("FE")=+$P(XQSUB,"#",2),DIFG("TEMPLATE")="",DIFG("DUZ")=XMFROM
- D LOG^DIFGG
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIFGSRV 880 printed Feb 19, 2025@00:14:10 Page 2
- DIFGSRV ;SFISC/RWF-SERVER INTERFACE TO FILEGRAMS ;Jan 05, 2015
- +1 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
- +4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
- +5 ;;Licensed under the terms of the Apache License, Version 2.0.
- +6 ;
- +7 QUIT
- HIST ;Add a message to the FileGram History file so it can be processed.
- +1 ;get first line
- SET DIXM=0
- SET U="^"
- XECUTE XMREC
- +2 IF $PIECE(XMRG,U)'="$DAT"
- SET DIXM=DIXM+1
- SET XQSTXT(DIXM)="First line of message doesn't start with '$DAT'"
- +3 SET DIFG=$PIECE(XMRG,U,3)
- +4 IF DIFG<2
- SET DIXM=DIXM+1
- SET XQSTXT(DIXM)="Can't update a VA FileMan file."
- +5 IF "^2^3^19^"[(U_DIFG_U)
- SET DIXM=DIXM+1
- SET XQSTXT(DIXM)="Update to a protected file (#"_DIFG_")."
- +6 if DIXM
- QUIT
- +7 SET DIFG("FE")=+$PIECE(XQSUB,"#",2)
- SET DIFG("TEMPLATE")=""
- SET DIFG("DUZ")=XMFROM
- +8 DO LOG^DIFGG
- +9 QUIT