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

DGPFHLTM.m

Go to the documentation of this file.
  1. DGPFHLTM ;SHRPE/YMG - PRF HL7 QBP/RSP PROCESSING ; 05/02/18
  1. ;;5.3;Registration;**951**;Aug 13, 1993;Build 135
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ; This routine contains functions for sending Mailman messages related to PRF flag transfer requests.
  1. ;
  1. Q
  1. ;
  1. TREQMSG(DATA,DGPFA,TYPE) ; sends notification about PRF flag ownership transfer request
  1. ; DATA - Array of values to include in the message (see tag EN^DGPFHLT1)
  1. ; DGPFA - PRF assignment array
  1. ; TYPE - 1 = notification about received request, 2 = notification about received response
  1. ;
  1. N DGMAX,MSGTXT,LNCNT,MGRP,RESLT,Z
  1. S MGRP="DGPF PRF TRANSFER REQUESTS" ; PRF transfer requests mail group
  1. S DGMAX=78 ; Max. line length
  1. ;
  1. D ADDLINE^DGPFBGR("",0,DGMAX,.LNCNT,"MSGTXT")
  1. D ADDLINE^DGPFBGR($$CJ^XLFSTR("* * * * PRF OWNERSHIP TRANSFER REQUEST NOTIFICATION * * * *",78," "),0,DGMAX,.LNCNT,"MSGTXT")
  1. D ADDLINE^DGPFBGR("",0,DGMAX,.LNCNT,"MSGTXT")
  1. D ADDLINE^DGPFBGR("The following PRF ownership transfer "_$S(TYPE=1:"request",1:"response")_" has been received:",0,DGMAX,.LNCNT,"MSGTXT")
  1. D ADDLINE^DGPFBGR("",0,DGMAX,.LNCNT,"MSGTXT")
  1. I TYPE=1 D ADDLINE^DGPFBGR($$LJ^XLFSTR("Requesting facility: ",22," ")_$G(DATA("SFNAME")),5,DGMAX,.LNCNT,"MSGTXT")
  1. D ADDLINE^DGPFBGR($$LJ^XLFSTR("Requester name: ",22," ")_$G(DATA("REQBY")),5,DGMAX,.LNCNT,"MSGTXT")
  1. D ADDLINE^DGPFBGR($$LJ^XLFSTR("Request date/time: ",22," ")_$$FMTE^XLFDT($G(DATA("REQDTM")),"1S"),5,DGMAX,.LNCNT,"MSGTXT")
  1. D ADDLINE^DGPFBGR($$LJ^XLFSTR("Request reason: ",22," ")_$G(DATA("REQCMT")),5,DGMAX,.LNCNT,"MSGTXT")
  1. D ADDLINE^DGPFBGR($$LJ^XLFSTR("PRF flag: ",22," ")_$P($G(DGPFA("FLAG")),U,2),5,DGMAX,.LNCNT,"MSGTXT")
  1. D ADDLINE^DGPFBGR($$LJ^XLFSTR("Patient name: ",22," ")_$P($G(DGPFA("DFN")),U,2),5,DGMAX,.LNCNT,"MSGTXT")
  1. I TYPE=2 D
  1. .D ADDLINE^DGPFBGR($$LJ^XLFSTR("Reviewer name: ",22," ")_$G(DATA("REVBY")),5,DGMAX,.LNCNT,"MSGTXT")
  1. .D ADDLINE^DGPFBGR($$LJ^XLFSTR("Review date/time: ",22," ")_$$FMTE^XLFDT($G(DATA("REVDTM")),"1S"),5,DGMAX,.LNCNT,"MSGTXT")
  1. .D ADDLINE^DGPFBGR($$LJ^XLFSTR("Review reason: ",22," ")_$G(DATA("REVCMT")),5,DGMAX,.LNCNT,"MSGTXT")
  1. .S Z=$G(DATA("REVRES")),RESLT=$S(Z="A":"Request approved",Z="D":"Request rejected",1:"Unknown")
  1. .D ADDLINE^DGPFBGR($$LJ^XLFSTR("Review result: ",22," ")_RESLT,5,DGMAX,.LNCNT,"MSGTXT")
  1. .Q
  1. D ADDLINE^DGPFBGR($$REPEAT^XLFSTR("-",DGMAX),0,DGMAX,.LNCNT,"MSGTXT")
  1. ;
  1. D SEND(MGRP,"PRF ownership transfer request notification","MSGTXT(")
  1. Q
  1. ;
  1. TERRMSG(MSGID,ERTXT) ; sends notification about an error that occurred in PRF flag ownership transfer request process
  1. ; MSGID - HL7 message Id
  1. ; ERTXT - array containing error text, ERTXT(line #) contains each line
  1. ;
  1. N DGMAX,MSGTXT,ERLN,LNCNT,MGRP
  1. S MGRP="DGPF HL7 TRANSMISSION ERRORS"
  1. S DGMAX=78 ; Max. line length
  1. ;
  1. D ADDLINE^DGPFBGR("",0,DGMAX,.LNCNT,"MSGTXT")
  1. D ADDLINE^DGPFBGR($$CJ^XLFSTR("* * * * PRF OWNERSHIP TRANSFER REQUEST ERROR * * * *",78," "),0,DGMAX,.LNCNT,"MSGTXT")
  1. D ADDLINE^DGPFBGR("",0,DGMAX,.LNCNT,"MSGTXT")
  1. D ADDLINE^DGPFBGR("The following error occurred during PRF ownership transfer request:",0,DGMAX,.LNCNT,"MSGTXT")
  1. D ADDLINE^DGPFBGR("",0,DGMAX,.LNCNT,"MSGTXT")
  1. S ERLN="" F S ERLN=$O(ERTXT(ERLN)) Q:ERLN="" D ADDLINE^DGPFBGR($G(ERTXT(ERLN)),0,DGMAX,.LNCNT,"MSGTXT")
  1. I $G(MSGID) D
  1. .D ADDLINE^DGPFBGR("",0,DGMAX,.LNCNT,"MSGTXT")
  1. .D ADDLINE^DGPFBGR("HL7 message Id: "_MSGID,5,DGMAX,.LNCNT,"MSGTXT")
  1. .Q
  1. ;
  1. D SEND(MGRP,"PRF ownership transfer request error","MSGTXT(")
  1. Q
  1. ;
  1. SEND(MGRP,SUBJ,MSGARY) ;send the MailMan message
  1. ; MGRP - mail group name
  1. ; MSGARY - name of message text array in open format
  1. ; SUBJ - Subject line
  1. ;
  1. N DIFROM ;protect FM package
  1. N XMDUZ ;sender
  1. N XMSUB ;message subject
  1. N XMTEXT ;name of message text array in open format
  1. N XMY ;recipient array
  1. N XMZ ;returned message number
  1. N XMMG ;error
  1. ;
  1. I MGRP="" Q
  1. S XMDUZ="DGPRF,INTERFACE"
  1. S XMSUB=$G(SUBJ)
  1. S XMTEXT=MSGARY
  1. S XMY("G."_MGRP)=""
  1. D ^XMD
  1. Q