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

VBECRPC.m

Go to the documentation of this file.
  1. VBECRPC ; HOIFO/BNT - VBECS Remote Procedure Utilities;Mar 23,2005
  1. ;;2.0;VBEC;;Jun 05, 2015;Build 4
  1. ;
  1. ; Note: This routine supports data exchange with an FDA registered
  1. ; medical device. As such, it may not be changed in any way without
  1. ; prior written approval from the medical device manufacturer.
  1. ;
  1. ; Integration Agreements:
  1. ; Reference to $$GET1^DIQ supported by IA #2052
  1. ; Reference to $$CHARCHK^XOBVLIB supported by IA #4090
  1. ;
  1. QUIT
  1. ;
  1. STRIPL(VBDATA) ;STRIP TRAILING SPACES
  1. F Q:$E(VBDATA,$L(VBDATA))'=" " S VBDATA=$E(VBDATA,1,$L(VBDATA)-1)
  1. Q VBDATA
  1. STRIPL3(VBDATA) ;STRIP LAST 3 CHARACTERS
  1. S VBDATA=$E(VBDATA,1,$L(VBDATA)-3)
  1. Q VBDATA
  1. BEGROOT(X) ; Add beginning root element
  1. D ADD("<"_X_">")
  1. Q
  1. ;
  1. ENDROOT(X) ; Add end root element
  1. D ADD("</"_X_">")
  1. Q
  1. ;
  1. ADD(STR) ; Add XML to result global
  1. S VBECCNT=VBECCNT+1
  1. S @RESULTS@(VBECCNT)=STR
  1. Q
  1. ;
  1. ERROR(STR) ; Return ERROR
  1. ;
  1. D BEGROOT("Error")
  1. D ADD("<Text>"_$$CHARCHK^XOBVLIB(STR)_"</Text>")
  1. D ENDROOT("Error")
  1. Q
  1. ;
  1. BADRPC(RPC,RTN,OPTION) ; Send back information on bad RPC call
  1. ;
  1. ;
  1. S @RESULTS@(0)="-1^Error calling RPC: "_RPC_" at "_OPTION_U_RTN
  1. Q
  1. ;
  1. BLDERMSG(VBECPRMS,VBRSLT,VBMT) ; build error message(s) into VBMT global
  1. ;
  1. N VBX ; temporary variable for holding text
  1. N VBNM ; indirect name of request/results array/global
  1. N VBNM2 ; copy of VBNM for different FOR loop
  1. N VBORIG ; copy of VBNM with trailing parenthesis removed
  1. N VBDATA ; data value from request/results node
  1. N VBLBL ; label value comprised of $NA_VBDATA
  1. N VBSUB ; subscript value for array node
  1. N VBOUT ; full concatenated value of node to display
  1. N VBLCV ; loop control variable for FOR loop
  1. N VBDONE ; flag to signify 'done' with loop
  1. N VBBLANK ; blank line of blank spaces
  1. N VBMAXDAT ; maximum allowable length of array node data value
  1. N VBMAXLBL ; maximum discovered length of array node label value
  1. N VBSPACES ; calulated gap to format display to show data at column
  1. ;
  1. S VBX="Following are the request and results array(s)"
  1. I $D(@VBMT@("!INITIAL IEN"))#2=1 D
  1. . S VBX=VBX_" for IEN # "_$P(@VBMT@("!INITIAL IEN"),U,2)
  1. . S @VBMT@("#FOLLOWS MSG")=VBX
  1. S VBBLANK=" "
  1. ;
  1. F VBNM="VBECPRMS",$NA(@VBRSLT) D
  1. . S VBNM2=VBNM,VBORIG=$P(VBNM,")")
  1. . S VBMAXLBL=1
  1. . F S VBNM2=$Q(@VBNM2) Q:VBNM2="" Q:$NA(@VBNM2)'[VBORIG D
  1. . . S:VBORIG="VBECPRMS" VBLBL=$P($NA(@VBNM2),"(",2)
  1. . . S:VBORIG=$P($NA(@VBRSLT),")") VBLBL=$P($NA(@VBNM2),")")
  1. . . I VBORIG["VBECPRMS" D
  1. . . . S VBLBL=$P(VBLBL,")")
  1. . . I VBORIG'["VBECPRMS" D
  1. . . . S VBLBL=$P(VBLBL,"(",2)
  1. . . . S VBLBL=$P(VBLBL,$J)_$E(VBLBL,$F(VBLBL,$J)+1,$L(VBLBL))
  1. . . . S VBLBL=$TR(VBLBL,"""","'"),VBLBL="'"_$P(VBLBL,"XML_",2)
  1. . . S VBMAXLBL=$S($L(VBLBL)>VBMAXLBL:$L(VBLBL),1:VBMAXLBL)
  1. . S VBMAXLBL=$S(VBMAXLBL>30:30,1:VBMAXLBL+3)
  1. . S VBMAXDAT=80-VBMAXLBL-2
  1. . S VBORIG=$P(VBNM,")")
  1. . F S VBNM=$Q(@VBNM) Q:VBNM="" Q:$NA(@VBNM)'[VBORIG D
  1. . . S VBLCV=0
  1. . . S VBSUB=$NA(@VBNM),VBSUB=$TR(VBSUB,"""","")
  1. . . S:VBORIG="VBECPRMS" VBLBL=$P($NA(@VBNM),"(",2)
  1. . . S:VBORIG=$P($NA(@VBRSLT),")") VBLBL=$P($NA(@VBNM),")")
  1. . . I VBORIG["VBECPRMS" D
  1. . . . S VBLBL=$P(VBLBL,")")
  1. . . I VBORIG'["VBECPRMS" D
  1. . . . S VBLBL=$P(VBLBL,"(",2)
  1. . . . S VBLBL=$P(VBLBL,$J)_$E(VBLBL,$F(VBLBL,$J)+1,$L(VBLBL))
  1. . . . S VBLBL=$TR(VBLBL,"""","'"),VBLBL="'"_$P(VBLBL,"XML_",2)
  1. . . S VBSPACES="",$P(VBSPACES," ",VBMAXLBL-$L(VBLBL))=""
  1. . . S VBSPACES=VBSPACES
  1. . . S VBDATA=$G(@VBNM)
  1. . . K VBDONE
  1. . . F VBLCV=0:1:25 D Q:$D(VBDONE)
  1. . . . S VBSUB=$P(VBSUB,"||")
  1. . . . S VBSUB=VBSUB_"||"_VBLCV
  1. . . . S VBDATA(VBLCV)=" "_$E(VBDATA,1,VBMAXDAT)
  1. . . . S VBDATA=$E(VBDATA,VBMAXDAT+1,$L(VBDATA))
  1. . . . S:$L(VBDATA)'>0 VBDONE=1
  1. . . . I VBLCV<1 D Q
  1. . . . . I $L(VBLBL)'>VBMAXLBL D Q
  1. . . . . . S $P(VBSPACES," ",$L(VBLBL)-VBMAXLBL)=""
  1. . . . . . S VBLBL=VBLBL_VBSPACES
  1. . . . . . S VBOUT=VBLBL_VBDATA(VBLCV)
  1. . . . . . S @VBMT@(VBSUB)=VBOUT
  1. . . . . I $L(VBLBL)>VBMAXLBL D
  1. . . . . . S @VBMT@(VBSUB)=VBLBL
  1. . . . . . S VBSUB=VBSUB_"||"_VBLCV
  1. . . . . . S VBLBL=$E(VBBLANK,1,VBMAXLBL-1)
  1. . . . . . S VBOUT=VBLBL_VBDATA(VBLCV)
  1. . . . . . S VBSUB=$P(VBSUB,"||")
  1. . . . . . S VBLCV=VBLCV+1
  1. . . . . . S VBSUB=VBSUB_"||"_VBLCV
  1. . . . . . S @VBMT@(VBSUB)=VBOUT
  1. . . . I VBLCV>0 D
  1. . . . . S VBLBL=$E(VBBLANK,1,VBMAXLBL-1)
  1. . . . . S VBOUT=VBLBL_VBDATA(VBLCV)
  1. . . . . S @VBMT@(VBSUB)=VBOUT
  1. K VBDATA
  1. Q
  1. SENDMSG(VBMT,SENDER,RECEIVER,SUBJECT) ; Function - send message to mail group
  1. ;
  1. ; Input:
  1. ; VBMT - Array with error information for message text
  1. ; SENDER - Name of sender (routine tag and name)
  1. ; RECEIVER - Mail group or individual
  1. ; SUBJECT - Text for message subject
  1. ;
  1. N VBT ; node in array during $Q
  1. N VBLN ; message parameters
  1. N VBGROUP ; name of mail group to which message will be sent
  1. N VBCNT ; line count of VBLN array
  1. N VBUSERNM ; IEN of user's entry in NEW PERSON file
  1. N VBUSER ; name of user running this program
  1. N XMDUZ ; sender
  1. N XMSUB ; message subject
  1. N XMTEXT ; message text array
  1. N XMY ; recipient array
  1. N XMZ ; returned message number
  1. ;
  1. I '$D(VBMT) Q
  1. I '$D(SENDER) S SENDER="VBECS VistALink M Client"
  1. I '$D(RECEIVER) S RECEIVER="G.VBECS INTERFACE ADMIN"
  1. I '$D(SUBJECT) S SUBJECT="VBECS VistaLink Error"
  1. ;
  1. S VBCNT=1
  1. S VBT=$NA(@VBMT)
  1. ;
  1. S VBUSERNM=$$GET1^DIQ(200,DUZ,.01)
  1. ;
  1. S VBLN(VBCNT)="* * * VBECS VistALink Error Notification * * *"
  1. S VBCNT=VBCNT+1,VBLN(VBCNT)=" ",VBCNT=VBCNT+1
  1. S VBLN(VBCNT)=" Generated by: "_VBUSERNM
  1. S VBCNT=VBCNT+1,VBLN(VBCNT)=" "
  1. F S VBT=$Q(@VBT) Q:VBT="" Q:$NA(@VBT)'[$J D
  1. . S VBCNT=VBCNT+1
  1. . S:VBT["DILIST" VBLN(VBCNT)=$G(@VBT)
  1. . S:VBT'["DILIST" VBLN(VBCNT)=$P($G(@VBT),U)
  1. . S VBLN(VBCNT)=$TR(VBLN(VBCNT),"""","'")
  1. ;
  1. S XMDUZ=SENDER
  1. S XMSUB=SUBJECT
  1. S XMTEXT="VBLN("
  1. ; reactivate the following ling after testing:
  1. S XMY(RECEIVER)=""
  1. ;S XMY(VBUSERNM)=""
  1. D ^XMD
  1. Q