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

IBCNFSND.m

Go to the documentation of this file.
  1. IBCNFSND ;WOIFO/PO - Electronic Insurance Identification ;12/23/2011
  1. ;;2.0;INTEGRATED BILLING;**457**;21-MAR-94;Build 30
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. ;;
  1. ;
  1. ; Sending Extract files and checking status of file transfers.
  1. ;
  1. Q
  1. ;
  1. SENDEII ; send HMS extract files and check status of files transfers.
  1. ; this subroutine is called from IBAMTC routine which is an scheduled job running once a day.
  1. ;
  1. N IBNOTREC,IBNOEXT,IBCNFPAR,IBCRDT,IBD0,IBD1,IBEXTNOD,IBFARR,IBFILE,IBFLIST,IBFROM,IBFSPEC,IBMSGNUM,IBNOEXT
  1. N IBNUMMSG,IBNUMREC,IBPSTDUE,IBSUB1,IBTEXT,IBTO,IBXMSUB,IBXMY,IBNORES,IBMAXREC,IBAKEEP,IBXMZ
  1. N X,Y,DA,DIC,DIK,D0,D1,D2,DG,DI,DIW,DICR,DIE,DLAYGO,DQ,DR,XMDUN,XMZ,IBFILEX,FNDFILE,FNDFILES
  1. ; get the IB configuration parameters and list of active extract files.
  1. D GETPARAM^IBCNFRD(.IBCNFPAR)
  1. ;
  1. I 'IBCNFPAR(13.02) QUIT ; if eII active field is not 1 quit.
  1. ;
  1. S IBMAXREC=255 ; message's maximum record line legth
  1. S IBAKEEP=6*30 ; number of days to keep the activity logs before get purged.
  1. S IBTEXT="^TMP(""IBCNFCND_IBTEXT"",$J)" ; @IBTEXT@(1:nnn) array to store the extract file content.
  1. K @IBTEXT
  1. ;
  1. ; for each active extracted HMS file name.
  1. S IBSUB1=0
  1. F S IBSUB1=$O(IBCNFPAR(13.08,IBSUB1)) Q:'IBSUB1 D
  1. . S IBEXTNOD=IBCNFPAR(13.08,IBSUB1)
  1. . S IBFILE=$P(IBEXTNOD,U,3) ; extract file name
  1. . ;
  1. . K DIC S DIC="^IBA(355.35,",DIC(0)="QZL",X=$P(IBEXTNOD,U,1) D ^DIC
  1. . S IBD0=+Y
  1. . S IBCRDT=$P(Y(0),U,2) ;creation date time.
  1. . I 'IBCRDT S IBCRDT=$$NOW^XLFDT() ; first time this type is created.
  1. . ;
  1. . ; Check message sub-file for all acknowledgements
  1. . ; want to do this first, so we can get the old ones cleared out
  1. . ; and put in activity log
  1. . ;
  1. . I $O(^IBA(355.35,IBD0,1,0)) D
  1. . . ; if confirmation messages are received for the extract file
  1. . . I $$CHKEXT(IBD0,IBFILE,$P(IBEXTNOD,U,4),.IBNOTREC) D
  1. . . . D CACTLOG(IBD0) ; save the top-level fields of HMS extract file status in the activity log sub-file.
  1. . . . ; kill the messages sub-file.
  1. . . . S DA(1)=IBD0,DA=0
  1. . . . S DIK="^IBA(355.35,"_DA(1)_",1,"
  1. . . . F S DA=$O(^IBA(355.35,IBD0,1,DA)) Q:'DA D ^DIK
  1. . ;
  1. . ; check, if the extract file exits.
  1. . K IBFSPEC,IBFLIST,FNDFILES
  1. . S IBFSPEC(IBFILE)=""
  1. . ;process all the versions of files
  1. . F K IBFLIST S FNDFILE=$$LIST^%ZISH(IBCNFPAR(13.01),"IBFSPEC","IBFLIST") Q:'FNDFILE D
  1. . . S FNDFILES(IBFILE)=""
  1. . . ;Get the full name of the first file found (includes version number for VMS based systems)
  1. . . S IBFILEX=$O(IBFLIST(""))
  1. . . ;
  1. . . ; set the file creation date/time.
  1. . . S DIE="^IBA(355.35,",DA=IBD0,DR=".02///^S X=$$NOW^XLFDT()" D ^DIE
  1. . . ;
  1. . . ; open the eII file and read the content into @IBTEXT@ global and cut the
  1. . . ; records to 255 (IBMAXREC) character chunks if more than 255 (IBMAXREC) characters.
  1. . . D FILERD(IBCNFPAR(13.01),IBFILEX,IBTEXT)
  1. . . ;
  1. . . ; build the file message(s)with the maximum number of lines per message.
  1. . . ; and send the file message(s) to related AITC queue.
  1. . . S IBNUMREC=$O(@IBTEXT@(""),-1) ; number of records
  1. . . S IBNUMMSG=IBNUMREC\IBCNFPAR(13.07) ; number of message to be sent
  1. . . S:IBNUMREC#IBCNFPAR(13.07) IBNUMMSG=IBNUMMSG+1 ; add one message if number records is not multiple of max number of records
  1. . . S:IBNUMMSG<1 IBNUMMSG=1 ; make sure at least one message is sent if the extract file is empty
  1. . . F IBMSGNUM=1:1:IBNUMMSG D
  1. . . . S IBFROM=((IBMSGNUM-1)*IBCNFPAR(13.07)+1)
  1. . . . S IBTO=IBMSGNUM*IBCNFPAR(13.07)
  1. . . . S:IBTO>IBNUMREC IBTO=IBNUMREC
  1. . . . S IBXMSUB="HMS eII Extracted file "_IBFILE_" MSG("_IBMSGNUM_"/"_IBNUMMSG_")"
  1. . . . S IBXMY($P(IBEXTNOD,U,4))="" ; send it to associated ATIC queue address e.g. XXX@Q-IBN.DOMAIN.EXT
  1. . . . S IBXMZ=$$MSGSEND(.IBXMY,IBXMSUB,IBTEXT,IBFROM,IBTO,IBMAXREC)
  1. . . . ;
  1. . . . ; set the purge date for the message in message(#3.9) file
  1. . . . D VAPOR^XMXEDIT(IBXMZ,$$HTFM^XLFDT(+$H+IBAKEEP_","_$P($H,",",2)))
  1. . . . ;
  1. . . . ; record the creation date/time and the time the message(s) were sent in HMS Extract File Status
  1. . . . K DIC S DA(1)=IBD0,DIC(0)="MLF",DLAYGO=355.35
  1. . . . S DIC="^IBA(355.35,"_DA(1)_",1,"
  1. . . . S DIC("DR")=".02///^S X=$$NOW^XLFDT()"
  1. . . . S X=IBXMZ
  1. . . . D FILE^DICN
  1. . . ; delete the file using its full name
  1. . . S IBFARR(IBFILEX)=""
  1. . . S Y=$$DEL^%ZISH(IBCNFPAR(13.01),$NA(IBFARR))
  1. . ;
  1. . I '$D(FNDFILES(IBFILE)) D ;else if extracted file does not exist, save the file name to be reported.
  1. . . S IBPSTDUE=$$FILEDUE^IBCNFSND($P(IBEXTNOD,U,5),$P(IBEXTNOD,U,6),IBCRDT)
  1. . . S:IBPSTDUE IBNOEXT(IBFILE)=""
  1. ;
  1. ; send an email to IBCNF EII IRM mail group with list of files and messages that their
  1. ; confirmation messages are not received within the given time. then re-send the message to ATIC.
  1. I $D(IBNOTREC)>0 D
  1. . D MSGNOTRC^IBCNFSND(.IBNOTREC)
  1. . D RESNDMSG(.IBNOTREC,IBAKEEP)
  1. ;
  1. ; if extract files are not created withing the give time send an email to IBCNF EII IRM mail group.
  1. I $D(IBNOEXT)>0 D MSGNOEXT^IBCNFSND(.IBNOEXT)
  1. ;
  1. ; if a Result File is not received within the due time
  1. ; Send an email to IBCNF EII IRM mail group
  1. S IBCRDT=+$P($G(^IBA(355.351,1,0)),U,2)
  1. S IBPSTDUE=$$FILEDUE^IBCNFSND(IBCNFPAR(13.04),IBCNFPAR(13.05),IBCRDT)
  1. I IBPSTDUE>0 D MSGNORES^IBCNFSND(IBCNFPAR(13.03))
  1. ;
  1. ; purge the entries older than 6 months in Activity Log sub-file of
  1. ; HMS Extract File Status and HMS Result File Status
  1. D PURGELOG(IBAKEEP) ; purge the activity logs of HMS extract file status and HMS result file status
  1. ;
  1. K @IBTEXT
  1. ;
  1. Q
  1. ;
  1. FILEDUE(IBDUEDAY,IBLTDAY,IBCRDT,IBNOW) ; check if file is due
  1. ; input: IBDEUDAY - day of the month the file is due
  1. ; IBLTDAY - number of days after day of month to declare file is late
  1. ; IBCRDT - date/time last file was processed
  1. ; output: 1 - if file is due
  1. ; 0 - if file is not due
  1. ;
  1. N IBLDM,IBDUEDT,IBLATEDT,LATE,PREVDUE,IBFDOM,IBPFDOM,PLATEDT
  1. S IBNOW=$G(IBNOW,$$NOW^XLFDT())
  1. S LATE=0
  1. ; if day of month file due day is 0 retrun 0, since this is as needed file.
  1. I 'IBDUEDAY Q LATE ; do not check assume not past due.
  1. S IBNOW=IBNOW\1 ; current date
  1. S IBCRDT=IBCRDT\1
  1. ;
  1. ; calculate the due date and passed due late date.
  1. S IBLDM=$E($$SCH^XLFDT("1M(L@1A)",IBNOW)\1,6,7) ; last day of month
  1. I IBDUEDAY>IBLDM S IBDUEDAY=IBLDM ; if due day greater than last day of currnt month set it to last date of current month.
  1. S IBDUEDT=$E(IBNOW,1,5)_$S($L(IBDUEDAY)>1:IBDUEDAY,1:"0"_IBDUEDAY)
  1. S IBLATEDT=$$FMADD^XLFDT(IBDUEDT,IBLTDAY) ; calculate late date
  1. ;FIRST OF THIS MONTH
  1. S IBFDOM=$E(IBNOW,1,5)_"01"
  1. ;MINUS ONE GETS LAST DAY OF PREVIOUS MONTH
  1. S IBLDMP=$$HTFM^XLFDT($$FMTH^XLFDT(IBFDOM,1)-1,1)
  1. ; SETUP FIRST DAY OF PREV MONTH TO CALCULATE DUE DATE OF PREV MONTH
  1. S IBPFDOM=$E(IBLDMP,1,5)_"01"
  1. ;NOW CALCULATE DUE DATE OF PREV MONTH
  1. S PREVDUE=$E(IBPFDOM,1,5)_$S($L(IBDUEDAY)>1:IBDUEDAY,1:"0"_IBDUEDAY)
  1. I PREVDUE>IBLDMP S PREVDUE=IBLDMP
  1. S PLATEDT=$$FMADD^XLFDT(PREVDUE,IBLTDAY) ; calculate late date
  1. ;
  1. ; if current time greater than late date/time and creation time is less than due date/time, the file due
  1. I IBNOW>IBLATEDT,IBCRDT<IBDUEDT S LATE=1
  1. I IBCRDT<PREVDUE,IBNOW>PLATEDT S LATE=1
  1. Q LATE ; file is not due.
  1. ;
  1. MSGNORES(IBFILE) ; Notify G.IBCNF EII IRM mail group that the result file is not received
  1. ; input: IBNORES - result file name
  1. ; output: none
  1. ;
  1. N XMSUB,IBMSG,XMY,XMTEXT,IBNOW,IBX
  1. S XMSUB="Expected Result file has not been received."
  1. S IBNOW=$$NOW^XLFDT()
  1. S IBMSG(1)="Expected Result file "_IBFILE_" has not been received yet"
  1. S XMTEXT="IBMSG("
  1. S XMY("G.IBCNF EII IRM")=""
  1. D ^XMD
  1. Q
  1. ;
  1. MSGNOEXT(IBNOEXT) ; Notify G.IBCNF EII IRM mail group that the extract file is not created
  1. ; input: IBNOEXT(<file name>)="" list of the extract file names.
  1. ; output: none
  1. ;
  1. N XMSUB,IBMSG,XMY,XMTEXT,IBNOW,IBX,IBFILE
  1. S XMSUB="Expected Extract files have not been created."
  1. S IBNOW=$$NOW^XLFDT()
  1. S IBMSG(1)="The following Extract file(s) have not been created yet:"
  1. S IBFILE=""
  1. S IBX=1
  1. F S IBFILE=$O(IBNOEXT(IBFILE)) Q:IBFILE="" D
  1. . S IBX=IBX+1
  1. . S IBMSG(IBX)=" "_IBFILE
  1. S XMTEXT="IBMSG("
  1. S XMY("G.IBCNF EII IRM")=""
  1. D ^XMD
  1. Q
  1. ;
  1. MSGNOTRC(IBNOTREC) ; Notify G.IBCNF EII IRM mail group the confirmation messages are not received for extract files
  1. ; input: IBNOTREC - array where
  1. ; IBNOTREC((<file index>)= <file name> ^
  1. ; IBNOTREC(<file index>, <message index>) = <message #> ^
  1. ; output: none
  1. ;
  1. N XMSUB,IBRESMSG,XMY,XMTEXT,IBNOW,I,IBX,J
  1. S XMSUB="Confirmation messages have not been received!!!"
  1. S IBNOW=$$NOW^XLFDT()
  1. S IBRESMSG(1)="Confirmation message(s) have not been received for the following file(s):"
  1. S IBX=1
  1. S I=0
  1. F S I=$O(IBNOTREC(I)) Q:'I D
  1. . S IBX=IBX+1
  1. . S IBRESMSG(IBX)="File Name: "_$P(IBNOTREC(I),U)
  1. . S J=0
  1. . F S J=$O(IBNOTREC(I,J)) Q:'J D
  1. . . S IBX=IBX+1
  1. . . S IBRESMSG(IBX)=" Msg #: "_$P(IBNOTREC(I,J),U)
  1. S XMTEXT="IBRESMSG("
  1. S XMY("G.IBCNF EII IRM")=""
  1. D ^XMD
  1. Q
  1. ;
  1. CHKEXT(IBD0,IBFILE,IBAITC,IBNOTREC) ; For given extract file type check if all messages are confirmed.
  1. ; input: IBD0 - ien of HMS extract file status (#355.35)
  1. ; IBFILE - file name
  1. ; IBAITC = AITC DMI queue email address.
  1. ;
  1. ; output: IBNOTREC array where
  1. ; IBNOTREC((<file index>)= file name^AITC DMI queue email address
  1. ; IBNOTREC(<file index>, <message index>) = message # ^ send date time
  1. ;
  1. N IBD1,IBCONFRM,IBNOW,IBDIFF
  1. S IBNOW=$$NOW^XLFDT()
  1. S IBCONFRM=1
  1. S IBD1=0
  1. F S IBD1=$O(^IBA(355.35,IBD0,1,IBD1)) Q:'IBD1 D
  1. . I $P($G(^IBA(355.35,IBD0,1,IBD1,0)),U,4)="" D ;if AITC confirmation number is empty
  1. . . S IBCONFRM=0
  1. . . S IBDIFF=$$HDIFF^XLFDT($$FMTH^XLFDT(IBNOW),$$FMTH^XLFDT($P($G(^IBA(355.35,IBD0,1,IBD1,0)),U,2)),2)
  1. . . I IBDIFF>(IBCNFPAR(13.06)*3600) D ; if no confirmation received within due time
  1. . . . S IBNOTREC(IBD0,IBD1)=$P($G(^IBA(355.35,IBD0,1,IBD1,0)),U)_U_$P($G(^IBA(355.35,IBD0,1,IBD1,0)),U,2)
  1. . . . S IBNOTREC(IBD0)=IBFILE_U_IBAITC ; keep track of file name to be sent to IRM mail group
  1. Q IBCONFRM
  1. ;
  1. FILERD(DIR,FILE,IBTEXT) ; Read the extract file into @IBTEXT@ array
  1. ; input: DIR - HMS directory name
  1. ; FILE - extract file name
  1. ; output: IBTEXT - array name where file is read into as @IBTEXT@(<1...n>)
  1. ;
  1. ;
  1. N IBI,IBREC,I
  1. K @IBTEXT
  1. ; read the file
  1. D OPEN^%ZISH("IBFILEX",DIR,FILE,"R")
  1. Q:POP
  1. U IO
  1. S IBI=0
  1. F Q:$$STATUS^%ZISH D
  1. . R IBREC:5
  1. . Q:$$STATUS^%ZISH
  1. . S IBI=IBI+1
  1. . S @IBTEXT@(IBI)=IBREC
  1. D CLOSE^%ZISH("IBFILEX")
  1. Q
  1. ;
  1. MSGSEND(XMY,XMSUB,IBTEXT,IBFROM,IBTO,IBMAXREC) ; send the extract file text to AITC DMI Queue
  1. ; input: XMY - array of recipients names
  1. ; XMSUB - message subject
  1. ; IBTEXT - array name where content of message is read from @IBTEXT@(IBFROM:IBTO)
  1. ; IBFROM - start of the message text in @IBTEXT@() array
  1. ; IBTO - end of the message text in @IBTEXT@() array
  1. ; IBMAXREC - maximum line length that can be put into each messge line.
  1. ; output: returns the created message id
  1. ;
  1. N XMDUZ,XMTEXT,TEMPTEXT,I,IBI,J,IBREC
  1. S TEMPTEXT="TMP(""IBCNFSND_TEMP"",$J)"
  1. K @TEMPTEXT
  1. S IBI=0
  1. F J=IBFROM:1:IBTO D
  1. . S IBREC=@IBTEXT@(J)
  1. . F I=1:IBMAXREC:$L(IBREC) D
  1. . . S IBI=IBI+1
  1. . . S @TEMPTEXT@(IBI)=$E(IBREC,I,IBMAXREC+I-1)
  1. ;
  1. S @TEMPTEXT@(IBI+1)="NNNN" ; insert the end of message marker as required by AITC.
  1. S XMTEXT=$E(TEMPTEXT,1,$L(TEMPTEXT)-1)_"," ;set XMTEXT in form of say "TMP(""IBCNFSND_TEMP"",$J,"
  1. S XMDUZ=.5 ;post master (.5 user id)
  1. ; send the message
  1. D ^XMD
  1. K @TEMPTEXT
  1. Q $G(XMZ)
  1. ;
  1. CACTLOG(IBD0) ; create the activity log of HMS extract file status
  1. ; input: IBD0 - ien of HMS extract file status (#355.35)
  1. ; output: none
  1. ;
  1. N IBCDT,IBD1,IBNODE,DA,DIC,X,Y
  1. ; create the the activity log subfile.
  1. S IBCDT=$P(^IBA(355.35,IBD0,0),U,2)
  1. S DA(1)=IBD0,DIC(0)="MLF",DLAYGO=355.35
  1. S DIC="^IBA(355.35,"_DA(1)_",2,"
  1. S X=IBCDT D FILE^DICN
  1. ; create messages subfile of activity log subfile
  1. K DA,DIC,X
  1. S DA(2)=IBD0
  1. S DA(1)=+Y
  1. S IBD1=0
  1. F S IBD1=$O(^IBA(355.35,IBD0,1,IBD1)) Q:'IBD1 D
  1. . S IBNODE=^IBA(355.35,IBD0,1,IBD1,0)
  1. . S DIC(0)="MLF"
  1. . S DIC="^IBA(355.35,"_DA(2)_",2,"_DA(1)_",1,"
  1. . S DIC("DR")=".02///^S X=$P(IBNODE,U,2);.03///^S X=$P(IBNODE,U,3);.04///^S X=$P(IBNODE,U,4)"
  1. . S X=$P(IBNODE,U)
  1. . D FILE^DICN
  1. Q
  1. ;
  1. PURGELOG(IBAKEEP) ; purge the activity logs of HMS extract file status and HMS result file status
  1. ; input: IBAKEEP - number of days to keep the activity logs
  1. ; output: none
  1. ;
  1. N IBCRDT,IBNOW,IBSTART,IBD0,DA,DIK
  1. S IBNOW=$$NOW^XLFDT()
  1. S IBSTART=$$HTFM^XLFDT($$HADD^XLFDT($$FMTH^XLFDT(IBNOW),-IBAKEEP))
  1. ;
  1. ; purge the HMS extract file status activity log.
  1. S IBD0=0
  1. F S IBD0=$O(^IBA(355.35,IBD0)) Q:'IBD0 D
  1. . S IBCRDT=""
  1. . F S IBCRDT=$O(^IBA(355.35,IBD0,2,"B",IBCRDT)) Q:'IBCRDT Q:IBCRDT>IBSTART D
  1. . . ;W !, IBCRDT
  1. . . S DA(1)=IBD0
  1. . . S DA=$O(^IBA(355.35,IBD0,2,"B",IBCRDT,""))
  1. . . S DIK="^IBA(355.35,"_DA(1)_",2,"
  1. . . D ^DIK
  1. ;
  1. ; purge the HMS result file status activity log.
  1. S IBD0=0
  1. F S IBD0=$O(^IBA(355.351,IBD0)) Q:'IBD0 D
  1. . S IBCRDT=""
  1. . F S IBCRDT=$O(^IBA(355.351,IBD0,2,"B",IBCRDT)) Q:'IBCRDT Q:IBCRDT>IBSTART D
  1. . . S DA(1)=IBD0
  1. . . S DA=$O(^IBA(355.351,IBD0,2,"B",IBCRDT,""))
  1. . . S DIK="^IBA(355.351,"_DA(1)_",2,"
  1. . . D ^DIK
  1. Q
  1. ;
  1. RESNDMSG(IBNOTREC,IBAKEEP) ; Resend the messages for which the confirmation messages are not received for extract files
  1. ; input: IBNOTREC - array where
  1. ; IBNOTREC((<file index>)= file name^AITC DMI queue email address
  1. ; IBNOTREC(<file index>, <message index>) = message # ^ send date time
  1. ; IBAKEEP = number of days before purge the new message
  1. ; output: none
  1. ;
  1. N XMSUB,IBRESMSG,XMY,XMTEXT,IBNOW,IBD0,IBD1,XMZ,IBRESEND,IBAITC,XMDUZ,XMPOS
  1. S IBNOW=$$NOW^XLFDT()
  1. S IBD0=0
  1. ; for each extract file type get the list of unconfirmed messages.
  1. F S IBD0=$O(IBNOTREC(IBD0)) Q:'IBD0 D
  1. . S IBAITC=$P(IBNOTREC(IBD0),U,2) ; AITC DMI Queue email address.
  1. . S IBD1=0
  1. . F S IBD1=$O(IBNOTREC(IBD0,IBD1)) Q:'IBD1 D
  1. . . S IBXMZ=$P(IBNOTREC(IBD0,IBD1),U)
  1. . . ; for this unconfirmed message, set AUSTIN ID and AITC Confirmation number to 0.
  1. . . S DA=IBD1,DA(1)=IBD0
  1. . . S DIE="^IBA(355.35,"_DA(1)_",1,"
  1. . . S DR=".03///^S X=0;.04///^S X=0" D ^DIE
  1. . . ;
  1. . . ; get and resend the message, with the " - Re-Send:<old message id>"
  1. . . ; appended to the subject of the new message.
  1. . . D GMSGTXT(IBXMZ,.IBRESMSG)
  1. . . S IBRESEND=" - Re-Send:"
  1. . . S XMSUB=$$SUBGET^XMGAPI0(IBXMZ)
  1. . . S XMSUB=$S(XMSUB[IBRESEND:$P(XMSUB,IBRESEND,1),1:XMSUB)_IBRESEND_IBXMZ
  1. . . S XMY(IBAITC)="" ; AITC DMI queue address
  1. . . S XMTEXT="IBRESMSG("
  1. . . D ^XMD
  1. . . ;
  1. . . ; set the purge date for the message in message(#3.9) file
  1. . . D VAPOR^XMXEDIT(XMZ,$$HTFM^XLFDT(+$H+IBAKEEP_","_$P($H,",",2)))
  1. . . ;
  1. . . ; record the time, the message is re-sent in HMS Extract File Status
  1. . . K DIC S DA(1)=IBD0,DIC(0)="MLF",DLAYGO=355.35
  1. . . S DIC="^IBA(355.35,"_DA(1)_",1,"
  1. . . S DIC("DR")=".02///^S X=$$NOW^XLFDT()"
  1. . . S X=XMZ
  1. . . D FILE^DICN
  1. Q
  1. ;
  1. GMSGTXT(XMZ,IBRESMSG) ; get message's txt
  1. ; input: XMZ - message id.
  1. ; output: IBRESMSG - array containing the message's txt
  1. ;
  1. N IBXMZ,XMER,XMA,XMRG
  1. K IBRESMSG
  1. S IBXMZ=$G(XMZ)
  1. S XMA=0
  1. F D Q:XMER<0
  1. . D REC^XMS3 ; receive a line
  1. . Q:XMER<0 ; check for end of message
  1. . S XMA=XMA+1
  1. . S IBRESMSG(XMA)=XMRG
  1. Q
  1. ;