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 Dec 13, 2024@02:47:56 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
