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

VPRUTILS.m

Go to the documentation of this file.
  1. VPRUTILS ;SLC/AGP -- VPR utilities routine ;8/14/13 11:22
  1. ;;1.0;VIRTUAL PATIENT RECORD;**2**;Sep 01, 2011;Build 317
  1. ;
  1. ; External References DBIA#
  1. ; ------------------- -----
  1. ; XLFCRC 3156
  1. ; XLFDT 10103
  1. ; XLFUTL 2622
  1. ; XUPARAM 2541
  1. ;
  1. Q
  1. ;
  1. SETERROR(RESULT,ERROR,EXTERROR,DATA) ; -- error text for JSON
  1. N CNT,TEMP,VPRTEMP,XCNT
  1. S VPRTEMP="VPRXTEMP ERRORS"
  1. I '$D(^XTMP(VPRTEMP,0)) S ^XTMP(VPRTEMP,0)=$$FMADD^XLFDT(DT,7)_U_DT_U_"VPR ERROR GLOBAL"
  1. S RESULT("success")="false"
  1. I $D(DATA) S XCNT=$O(^XTMP(VPRTEMP,""),-1)+1 M ^XTMP(VPRTEMP,XCNT,"ERROR")=DATA
  1. I $D(ERROR) D SETERRTX(.TEMP,.ERROR) S RESULT("error","code")=TEMP
  1. I +$G(XCNT)>0 S RESULT("error","code")=$G(RESULT("error","code"))_" See ^XTMP("_VPRTEMP_","_XCNT_",DATA) for data"
  1. I $D(EXTERROR) D SETERRTX(.TEMP,.EXTERROR) I TEMP'="" S RESULT("error","message")=TEMP
  1. ;
  1. Q
  1. ;
  1. SETERRTX(TEMP,ERROR) ;
  1. S TEMP=""
  1. S CNT=0 F S CNT=$O(ERROR(CNT)) Q:CNT'>0 D
  1. .S TEMP=$S(TEMP'="":TEMP=TEMP_$C(13,10)_ERROR(CNT),1:ERROR(CNT))
  1. Q
  1. ;
  1. SETTEXT(X,VALUE) ; -- format word processing
  1. N FIRST,I,LINE
  1. S FIRST=1
  1. S I=0 F S I=$O(@X@(I)) Q:I<1 D
  1. .S LINE=$S($D(@X@(I,0)):@X@(I,0),1:@X@(I))
  1. .; FIRST=1 S @VALUE@(I)=LINE,FIRST=0 Q
  1. .S @VALUE@(I)=LINE_$C(13)_$C(10)
  1. Q
  1. ;
  1. SPLITVAL(NODE,ARRAY) ; -- split a value into a list
  1. N CNT,NAME,VALUE,FIELD
  1. S NAME="" F S NAME=$O(ARRAY(NAME)) Q:NAME="" D
  1. .S CNT=+ARRAY(NAME)
  1. .S VALUE=$P($G(NODE),U,CNT)
  1. .I NAME="Code" S FIELD=$P(ARRAY(NAME),U,2) S VALUE=$$SETVURN(FIELD,VALUE)
  1. .S ARRAY(NAME)=VALUE
  1. Q
  1. ;
  1. SETPROV(NODE,PROV) ; -- providers
  1. S PROV("providerUid")=$$SETUID("user",,+NODE)
  1. S PROV("providerName")=$P(NODE,U,2)
  1. Q
  1. ;
  1. SETUID(DOMAIN,PAT,ID,ADDDATA) ; -- create uid string
  1. N RESULT,SYS
  1. S SYS=$S($D(VPRSYS):VPRSYS,1:$$GET^XPAR("SYS","VPR SYSTEM NAME"))
  1. S RESULT="urn:va:"_DOMAIN_":"_SYS_":"_$S($G(PAT):PAT_":",1:"")_ID
  1. I $L($G(ADDDATA)) S RESULT=RESULT_":"_ADDDATA
  1. Q RESULT
  1. ;
  1. SETFCURN(DOMAIN,FACILITY,VALUE) ; -- create facility urn
  1. Q "urn:va:"_DOMAIN_":"_FACILITY_":"_VALUE
  1. ;
  1. SETVURN(DOMAIN,VALUE) ; -- create VA urn
  1. N RESULT S RESULT=""
  1. S RESULT="urn:va:"_DOMAIN_":"_VALUE
  1. Q RESULT
  1. ;
  1. SYS() ; -- return hashed system name
  1. Q $$BASE^XLFUTL($$CRC16^XLFCRC($$KSP^XUPARAM("WHERE")),10,16)
  1. ;
  1. SETNCS(CODESET,VALUE) ; -- create national codeset urn
  1. Q "urn:"_CODESET_":"_VALUE
  1. ;
  1. JSONDT(X) ; -- convert FileMan DT to HL7 DT for JSON
  1. N D,DATE,M,TIME,Y
  1. S DATE=$P($$FMTHL7^XLFDT(X),"-")
  1. I $L(DATE)>8 S TIME=$E(DATE,9,$L(DATE))
  1. S Y=$E(DATE,1,4),M=$E(DATE,5,6),D=$E(DATE,7,8)
  1. K DATE
  1. S DATE=Y I M>0 S DATE=DATE_M S:D>0 DATE=DATE_D
  1. I $G(TIME)'="" S DATE=DATE_TIME
  1. Q DATE
  1. ;
  1. FACILITY(X,Y) ; -- add facility info to array for JSON
  1. ; X=STATION NUMBER^STATION NAME
  1. ; Y=Variable array name
  1. ; >D FACILITY^VPRUTILS("500^CAMP MASTER","LAB")
  1. ;
  1. S @Y@("facilityCode")=$P(X,"^")
  1. S @Y@("facilityName")=$P(X,"^",2)
  1. Q