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