- 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 Feb 19, 2025@00:12:32 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