- VPRD ;SLC/MKB -- Serve VistA data as XML via RPC ;8/2/11 15:29
- ;;1.0;VIRTUAL PATIENT RECORD;**1,2,4,5,6,32**;Sep 01, 2011;Build 6
- ;;Per VHA Directive 2004-038, this routine should not be modified.
- ;
- ; External References DBIA#
- ; ------------------- -----
- ; ^DPT 10035
- ; ^SC 10040
- ; ^USC(8932.1) 4984
- ; ^VA(200 10060
- ; DIQ 2056
- ; MPIF001 2701
- ; VASITE 10112
- ; XLFDT 10103
- ; XLFSTR 10104
- ; XPAR 2263
- ; XUAF4 2171
- ; XUSTAX 4911
- ;
- GET(VPR,DFN,TYPE,START,STOP,MAX,ID,FILTER) ; -- Return search results as XML in @VPR@(n)
- ; RPC = VPR GET PATIENT DATA
- N ICN,VPRI,VPRTOTL,VPRTEXT
- S VPR=$NA(^TMP("VPR",$J)) K @VPR
- S VPRTEXT=+$G(FILTER("text")) ;include report/document text?
- ;
- ; parse & validate input parameters
- S ICN=+$P($G(DFN),";",2),DFN=+$G(DFN),ID=$G(ID)
- I DFN<1,ICN S DFN=+$$GETDFN^MPIF001(ICN)
- I DFN<1!'$D(^DPT(DFN)) D ERR(1,DFN) G GTQ
- S TYPE=$$LOW^XLFSTR($G(TYPE)) I TYPE="" S TYPE=$$ALL
- S:'$G(START) START=1410102 S:'$G(STOP) STOP=4141015 S:'$G(MAX) MAX=9999
- I START,STOP,STOP<START N X S X=START,START=STOP,STOP=X ;switch
- I STOP,$L(STOP,".")<2 S STOP=STOP_".24"
- I ID="",$D(FILTER("id")) S ID=FILTER("id")
- ;
- ; extract data
- N VPRTYPE,VPRP,VPRHDR,VPRTAG,VPRTN
- D ADD("<results version='"_$$GET^XPAR("ALL","VPR VERSION")_"' timeZone='"_$$TZ^XLFDT_"' >")
- S VPRTYPE=TYPE
- F VPRP=1:1:$L(VPRTYPE,";") S VPRTAG=$P(VPRTYPE,";",VPRP) I $L(VPRTAG) D
- . S VPRTN="EN^"_$$RTN(.VPRTAG) Q:'$L($T(@VPRTN)) ;D ERR(2) Q
- . D ADD("<"_VPRTAG) S VPRHDR=VPRI,VPRTOTL=0
- . D @(VPRTN_"(DFN,START,STOP,MAX,ID)")
- . S @VPR@(VPRHDR)=@VPR@(VPRHDR)_" total='"_+$G(VPRTOTL)_"' >" D ADD("</"_VPRTAG_">")
- D ADD("</results>")
- ;
- GTQ ; end
- K ^TMP("VPRD",$J)
- Q
- ;
- RTN(X) ; -- Return name of VPRDxxxx routine for clinical domain X
- ; X is also enforced as expected group tag name, if passed by ref
- N Y S Y="VPRD",X=$G(X) I X="" Q Y
- I X["accession" S Y="VPRDLRA",X="accessions"
- I X["allerg" S Y="VPRDGMRA",X="reactions"
- I X["appointment" S Y="VPRDSDAM",X="appointments"
- I X["clinicalproc" S Y="VPRDMC",X="clinicalProcedures"
- I X["consult" S Y="VPRDGMRC",X="consults"
- I X["demograph" S Y="VPRDPT",X="demographics"
- I X["document" S Y="VPRDTIU",X="documents"
- I X["factor" S Y="VPRDPXHF",X="healthFactors"
- I X["flag" S Y="VPRDGPF",X="flags"
- I X["function" S Y="VPRDRMIM",X="functionalMeasurements"
- I X="fim" S Y="VPRDRMIM",X="functionalMeasurements"
- I X["immunization" S Y="VPRDPXIM",X="immunizations"
- I X["skin" S Y="VPRDPXSK",X="skinTests"
- I X?1"exam".E S Y="VPRDPXAM",X="exams"
- I X["educat" S Y="VPRDPXED",X="educationTopics"
- I X["insur" S Y="VPRDIB",X="insurancePolicies"
- I X["polic" S Y="VPRDIB",X="insurancePolicies"
- I X["lab" S Y="VPRDLR",X="labs"
- I X["panel" S Y="VPRDLRO",X="panels"
- I X["med" S Y="VPRDPS",X="meds"
- I X["pharm" S Y="VPRDPSOR",X="meds"
- I X["observ" S Y="VPRDMDC",X="observations"
- I X["order" S Y="VPRDOR",X="orders"
- I X["patient" S Y="VPRDPT",X="demographics"
- I X["problem" S Y="VPRDGMPL",X="problems"
- I X?1"procedure".E S Y="VPRDPROC",X="procedures"
- I X["reaction" S Y="VPRDGMRA",X="reactions"
- I X["reminder" S Y="VPRDPXRM",X="reminders"
- I X["surg" S Y="VPRDSR",X="surgeries"
- I X["visit" S Y="VPRDVSIT",X="visits"
- I X["vital" S Y="VPRDGMV",X="vitals"
- I X["rad" S Y="VPRDRA",X="radiologyExams"
- I X["xray" S Y="VPRDRA",X="radiologyExams"
- Q Y
- ;
- TAG(X) ; -- return plural name for group tags
- N Y S:X'?1.L X=$$LOW^XLFSTR(X)
- I $E(X,$L(X))="s" S Y=X
- I $E(X,$L(X))="y" S Y=$E(X,1,$L(X)-1)_"ies"
- E S Y=X_"s"
- Q Y
- ;
- ALL() ; -- return string for all types of data
- Q "demographics;reactions;problems;vitals;labs;meds;immunizations;observations;visits;appointments;documents;procedures;consults;flags;factors;skinTests;exams;education;insurance;reminders"
- ;
- ERR(X,VAL) ; -- return error message
- N MSG S MSG="Error"
- I X=1 S MSG="Patient with DFN '"_$G(VAL)_"' not found"
- I X=2 S MSG="Requested domain type '"_$G(VAL)_"' not recognized"
- I X=99 S MSG="Unknown request"
- ;
- D ADD("<error>")
- D ADD("<message>"_MSG_"</message>")
- D ADD("</error>")
- Q
- ;
- ESC(X) ; -- escape outgoing XML
- ; Q $ZCONVERT(X,"O","HTML") ; uncomment for fastest performance on Cache
- ;
- N I,Y,QOT S QOT=""""
- F I=1:1:8,11,12,14:1:31 S X=$TR(X,$C(I))
- S Y=$P(X,"&") F I=2:1:$L(X,"&") S Y=Y_"&"_$P(X,"&",I)
- S X=Y,Y=$P(X,"<") F I=2:1:$L(X,"<") S Y=Y_"<"_$P(X,"<",I)
- S X=Y,Y=$P(X,">") F I=2:1:$L(X,">") S Y=Y_">"_$P(X,">",I)
- S X=Y,Y=$P(X,"'") F I=2:1:$L(X,"'") S Y=Y_"'"_$P(X,"'",I)
- S X=Y,Y=$P(X,QOT) F I=2:1:$L(X,QOT) S Y=Y_"""_$P(X,QOT,I)
- Q Y
- ;
- ADD(X) ; Add a line @VPR@(n)=X
- S VPRI=$G(VPRI)+1
- S @VPR@(VPRI)=X
- Q
- ;
- STRING(ARRAY) ; -- Return text in ARRAY(n) or ARRAY(n,0) as a string
- N I,X,Y S Y=""
- N CRLF S CRLF=+$G(FILTER("nowrap")) ;1=insert CRLF between lines
- S I=+$O(ARRAY("")) I I=0 S I=+$O(ARRAY(0))
- S Y=$S($D(ARRAY(I,0)):ARRAY(I,0),1:$G(ARRAY(I)))
- F S I=$O(ARRAY(I)) Q:I<1 D
- . S X=$S($D(ARRAY(I,0)):ARRAY(I,0),1:ARRAY(I))
- . I $E(X)=" " S Y=Y_$C(13,10)_X Q
- . I CRLF S Y=Y_$C(13,10)_X Q
- . S Y=Y_$S($E(Y,$L(Y))=" ":"",1:" ")_X
- Q Y
- ;
- FAC(X) ; -- return Institution file station# for location X
- N HLOC,FAC,Y0,Y S Y=""
- S HLOC=$G(^SC(+$G(X),0)),FAC=$P(HLOC,U,4)
- ; Get P:4 via Med Ctr Div, if not directly linked
- I 'FAC,$P(HLOC,U,15) S FAC=$$GET1^DIQ(44,+$G(X)_",","3.5:.07","I")
- S Y0=$S(FAC:$$NS^XUAF4(FAC),1:$P($$SITE^VASITE,U,2,3)) ;name^stn#
- S:$L(Y0) Y=$P(Y0,U,2)_U_$P(Y0,U) ;switch to stn#^name
- I $L(Y),'Y S $P(Y,U)=FAC
- Q Y
- ;
- PROVTAGS() ; -- Return attribute tags for provider info as built below
- Q "officePhone^analogPager^fax^email^taxonomyCode^providerType^classification^specialization^service"
- ;
- PROVSPC(NP) ; -- Return contact & specialty info for provider NP
- ; save strings in ^TMP("VPRD",$J,NP) for efficiency
- N X,Y,I,CLS,RES,X13,X15 S NP=+$G(NP) ;protect I for calling routine
- S RES=$G(^TMP("VPRD",$J,NP)) I $L(RES) Q RES
- S X13=$G(^VA(200,NP,.13)),X15=$G(^(.15))
- S RES=$P(X13,U,2)_U_$P(X13,U,7)_U_$P(X13,U,6)_U_$P(X15,U)_U
- S X=$$TAXIND^XUSTAX(NP) I $P(X,U,2) D ;= X12 code ^ #8932.1 ien
- . S CLS=$G(^USC(8932.1,$P(X,U,2),0)) Q:CLS=""
- . S RES=RES_$P(X,U)_U_$P(CLS,U,1,3) ;X12^type^class^specialization
- S $P(RES,U,9)=$$GET1^DIQ(200,NP_",",29)
- S ^TMP("VPRD",$J,NP)=RES
- Q RES
- ;
- VUID(IEN,FILE) ; -- Return VUID for item
- Q $$GET1^DIQ(FILE,IEN_",",99.99)
- ;
- VERSION(RET) ; -- Return current version of data extracts
- S RET=$$GET^XPAR("ALL","VPR VERSION")
- Q
- ;
- TEST(DFN,TYPE,ID,START,STOP,MAX,TEXT,IN) ; -- test GET, write results to screen
- N OUT,IDX S U="^"
- S DFN=+$G(DFN) Q:DFN<1
- S TYPE=$G(TYPE) Q:TYPE=""
- D GET(.OUT,DFN,TYPE,$G(START),$G(STOP),$G(MAX),$G(ID),.IN)
- ;
- S IDX=OUT
- F S IDX=$Q(@IDX) Q:IDX'?1"^TMP(""VPR"","1.N.E Q:+$P(IDX,",",2)'=$J W !,@IDX
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVPRD 7333 printed Feb 19, 2025@00:10:51 Page 2
- VPRD ;SLC/MKB -- Serve VistA data as XML via RPC ;8/2/11 15:29
- +1 ;;1.0;VIRTUAL PATIENT RECORD;**1,2,4,5,6,32**;Sep 01, 2011;Build 6
- +2 ;;Per VHA Directive 2004-038, this routine should not be modified.
- +3 ;
- +4 ; External References DBIA#
- +5 ; ------------------- -----
- +6 ; ^DPT 10035
- +7 ; ^SC 10040
- +8 ; ^USC(8932.1) 4984
- +9 ; ^VA(200 10060
- +10 ; DIQ 2056
- +11 ; MPIF001 2701
- +12 ; VASITE 10112
- +13 ; XLFDT 10103
- +14 ; XLFSTR 10104
- +15 ; XPAR 2263
- +16 ; XUAF4 2171
- +17 ; XUSTAX 4911
- +18 ;
- GET(VPR,DFN,TYPE,START,STOP,MAX,ID,FILTER) ; -- Return search results as XML in @VPR@(n)
- +1 ; RPC = VPR GET PATIENT DATA
- +2 NEW ICN,VPRI,VPRTOTL,VPRTEXT
- +3 SET VPR=$NAME(^TMP("VPR",$JOB))
- KILL @VPR
- +4 ;include report/document text?
- SET VPRTEXT=+$GET(FILTER("text"))
- +5 ;
- +6 ; parse & validate input parameters
- +7 SET ICN=+$PIECE($GET(DFN),";",2)
- SET DFN=+$GET(DFN)
- SET ID=$GET(ID)
- +8 IF DFN<1
- IF ICN
- SET DFN=+$$GETDFN^MPIF001(ICN)
- +9 IF DFN<1!'$DATA(^DPT(DFN))
- DO ERR(1,DFN)
- GOTO GTQ
- +10 SET TYPE=$$LOW^XLFSTR($GET(TYPE))
- IF TYPE=""
- SET TYPE=$$ALL
- +11 if '$GET(START)
- SET START=1410102
- if '$GET(STOP)
- SET STOP=4141015
- if '$GET(MAX)
- SET MAX=9999
- +12 ;switch
- IF START
- IF STOP
- IF STOP<START
- NEW X
- SET X=START
- SET START=STOP
- SET STOP=X
- +13 IF STOP
- IF $LENGTH(STOP,".")<2
- SET STOP=STOP_".24"
- +14 IF ID=""
- IF $DATA(FILTER("id"))
- SET ID=FILTER("id")
- +15 ;
- +16 ; extract data
- +17 NEW VPRTYPE,VPRP,VPRHDR,VPRTAG,VPRTN
- +18 DO ADD("<results version='"_$$GET^XPAR("ALL","VPR VERSION")_"' timeZone='"_$$TZ^XLFDT_"' >")
- +19 SET VPRTYPE=TYPE
- +20 FOR VPRP=1:1:$LENGTH(VPRTYPE,";")
- SET VPRTAG=$PIECE(VPRTYPE,";",VPRP)
- IF $LENGTH(VPRTAG)
- Begin DoDot:1
- +21 ;D ERR(2) Q
- SET VPRTN="EN^"_$$RTN(.VPRTAG)
- if '$LENGTH($TEXT(@VPRTN))
- QUIT
- +22 DO ADD("<"_VPRTAG)
- SET VPRHDR=VPRI
- SET VPRTOTL=0
- +23 DO @(VPRTN_"(DFN,START,STOP,MAX,ID)")
- +24 SET @VPR@(VPRHDR)=@VPR@(VPRHDR)_" total='"_+$GET(VPRTOTL)_"' >"
- DO ADD("</"_VPRTAG_">")
- End DoDot:1
- +25 DO ADD("</results>")
- +26 ;
- GTQ ; end
- +1 KILL ^TMP("VPRD",$JOB)
- +2 QUIT
- +3 ;
- RTN(X) ; -- Return name of VPRDxxxx routine for clinical domain X
- +1 ; X is also enforced as expected group tag name, if passed by ref
- +2 NEW Y
- SET Y="VPRD"
- SET X=$GET(X)
- IF X=""
- QUIT Y
- +3 IF X["accession"
- SET Y="VPRDLRA"
- SET X="accessions"
- +4 IF X["allerg"
- SET Y="VPRDGMRA"
- SET X="reactions"
- +5 IF X["appointment"
- SET Y="VPRDSDAM"
- SET X="appointments"
- +6 IF X["clinicalproc"
- SET Y="VPRDMC"
- SET X="clinicalProcedures"
- +7 IF X["consult"
- SET Y="VPRDGMRC"
- SET X="consults"
- +8 IF X["demograph"
- SET Y="VPRDPT"
- SET X="demographics"
- +9 IF X["document"
- SET Y="VPRDTIU"
- SET X="documents"
- +10 IF X["factor"
- SET Y="VPRDPXHF"
- SET X="healthFactors"
- +11 IF X["flag"
- SET Y="VPRDGPF"
- SET X="flags"
- +12 IF X["function"
- SET Y="VPRDRMIM"
- SET X="functionalMeasurements"
- +13 IF X="fim"
- SET Y="VPRDRMIM"
- SET X="functionalMeasurements"
- +14 IF X["immunization"
- SET Y="VPRDPXIM"
- SET X="immunizations"
- +15 IF X["skin"
- SET Y="VPRDPXSK"
- SET X="skinTests"
- +16 IF X?1"exam".E
- SET Y="VPRDPXAM"
- SET X="exams"
- +17 IF X["educat"
- SET Y="VPRDPXED"
- SET X="educationTopics"
- +18 IF X["insur"
- SET Y="VPRDIB"
- SET X="insurancePolicies"
- +19 IF X["polic"
- SET Y="VPRDIB"
- SET X="insurancePolicies"
- +20 IF X["lab"
- SET Y="VPRDLR"
- SET X="labs"
- +21 IF X["panel"
- SET Y="VPRDLRO"
- SET X="panels"
- +22 IF X["med"
- SET Y="VPRDPS"
- SET X="meds"
- +23 IF X["pharm"
- SET Y="VPRDPSOR"
- SET X="meds"
- +24 IF X["observ"
- SET Y="VPRDMDC"
- SET X="observations"
- +25 IF X["order"
- SET Y="VPRDOR"
- SET X="orders"
- +26 IF X["patient"
- SET Y="VPRDPT"
- SET X="demographics"
- +27 IF X["problem"
- SET Y="VPRDGMPL"
- SET X="problems"
- +28 IF X?1"procedure".E
- SET Y="VPRDPROC"
- SET X="procedures"
- +29 IF X["reaction"
- SET Y="VPRDGMRA"
- SET X="reactions"
- +30 IF X["reminder"
- SET Y="VPRDPXRM"
- SET X="reminders"
- +31 IF X["surg"
- SET Y="VPRDSR"
- SET X="surgeries"
- +32 IF X["visit"
- SET Y="VPRDVSIT"
- SET X="visits"
- +33 IF X["vital"
- SET Y="VPRDGMV"
- SET X="vitals"
- +34 IF X["rad"
- SET Y="VPRDRA"
- SET X="radiologyExams"
- +35 IF X["xray"
- SET Y="VPRDRA"
- SET X="radiologyExams"
- +36 QUIT Y
- +37 ;
- TAG(X) ; -- return plural name for group tags
- +1 NEW Y
- if X'?1.L
- SET X=$$LOW^XLFSTR(X)
- +2 IF $EXTRACT(X,$LENGTH(X))="s"
- SET Y=X
- +3 IF $EXTRACT(X,$LENGTH(X))="y"
- SET Y=$EXTRACT(X,1,$LENGTH(X)-1)_"ies"
- +4 IF '$TEST
- SET Y=X_"s"
- +5 QUIT Y
- +6 ;
- ALL() ; -- return string for all types of data
- +1 QUIT "demographics;reactions;problems;vitals;labs;meds;immunizations;observations;visits;appointments;documents;procedures;consults;flags;factors;skinTests;exams;education;insurance;reminders"
- +2 ;
- ERR(X,VAL) ; -- return error message
- +1 NEW MSG
- SET MSG="Error"
- +2 IF X=1
- SET MSG="Patient with DFN '"_$GET(VAL)_"' not found"
- +3 IF X=2
- SET MSG="Requested domain type '"_$GET(VAL)_"' not recognized"
- +4 IF X=99
- SET MSG="Unknown request"
- +5 ;
- +6 DO ADD("<error>")
- +7 DO ADD("<message>"_MSG_"</message>")
- +8 DO ADD("</error>")
- +9 QUIT
- +10 ;
- ESC(X) ; -- escape outgoing XML
- +1 ; Q $ZCONVERT(X,"O","HTML") ; uncomment for fastest performance on Cache
- +2 ;
- +3 NEW I,Y,QOT
- SET QOT=""""
- +4 FOR I=1:1:8,11,12,14:1:31
- SET X=$TRANSLATE(X,$CHAR(I))
- +5 SET Y=$PIECE(X,"&")
- FOR I=2:1:$LENGTH(X,"&")
- SET Y=Y_"&"_$PIECE(X,"&",I)
- +6 SET X=Y
- SET Y=$PIECE(X,"<")
- FOR I=2:1:$LENGTH(X,"<")
- SET Y=Y_"<"_$PIECE(X,"<",I)
- +7 SET X=Y
- SET Y=$PIECE(X,">")
- FOR I=2:1:$LENGTH(X,">")
- SET Y=Y_">"_$PIECE(X,">",I)
- +8 SET X=Y
- SET Y=$PIECE(X,"'")
- FOR I=2:1:$LENGTH(X,"'")
- SET Y=Y_"'"_$PIECE(X,"'",I)
- +9 SET X=Y
- SET Y=$PIECE(X,QOT)
- FOR I=2:1:$LENGTH(X,QOT)
- SET Y=Y_"""_$PIECE(X,QOT,I)
- +10 QUIT Y
- +11 ;
- ADD(X) ; Add a line @VPR@(n)=X
- +1 SET VPRI=$GET(VPRI)+1
- +2 SET @VPR@(VPRI)=X
- +3 QUIT
- +4 ;
- STRING(ARRAY) ; -- Return text in ARRAY(n) or ARRAY(n,0) as a string
- +1 NEW I,X,Y
- SET Y=""
- +2 ;1=insert CRLF between lines
- NEW CRLF
- SET CRLF=+$GET(FILTER("nowrap"))
- +3 SET I=+$ORDER(ARRAY(""))
- IF I=0
- SET I=+$ORDER(ARRAY(0))
- +4 SET Y=$SELECT($DATA(ARRAY(I,0)):ARRAY(I,0),1:$GET(ARRAY(I)))
- +5 FOR
- SET I=$ORDER(ARRAY(I))
- if I<1
- QUIT
- Begin DoDot:1
- +6 SET X=$SELECT($DATA(ARRAY(I,0)):ARRAY(I,0),1:ARRAY(I))
- +7 IF $EXTRACT(X)=" "
- SET Y=Y_$CHAR(13,10)_X
- QUIT
- +8 IF CRLF
- SET Y=Y_$CHAR(13,10)_X
- QUIT
- +9 SET Y=Y_$SELECT($EXTRACT(Y,$LENGTH(Y))=" ":"",1:" ")_X
- End DoDot:1
- +10 QUIT Y
- +11 ;
- FAC(X) ; -- return Institution file station# for location X
- +1 NEW HLOC,FAC,Y0,Y
- SET Y=""
- +2 SET HLOC=$GET(^SC(+$GET(X),0))
- SET FAC=$PIECE(HLOC,U,4)
- +3 ; Get P:4 via Med Ctr Div, if not directly linked
- +4 IF 'FAC
- IF $PIECE(HLOC,U,15)
- SET FAC=$$GET1^DIQ(44,+$GET(X)_",","3.5:.07","I")
- +5 ;name^stn#
- SET Y0=$SELECT(FAC:$$NS^XUAF4(FAC),1:$PIECE($$SITE^VASITE,U,2,3))
- +6 ;switch to stn#^name
- if $LENGTH(Y0)
- SET Y=$PIECE(Y0,U,2)_U_$PIECE(Y0,U)
- +7 IF $LENGTH(Y)
- IF 'Y
- SET $PIECE(Y,U)=FAC
- +8 QUIT Y
- +9 ;
- PROVTAGS() ; -- Return attribute tags for provider info as built below
- +1 QUIT "officePhone^analogPager^fax^email^taxonomyCode^providerType^classification^specialization^service"
- +2 ;
- PROVSPC(NP) ; -- Return contact & specialty info for provider NP
- +1 ; save strings in ^TMP("VPRD",$J,NP) for efficiency
- +2 ;protect I for calling routine
- NEW X,Y,I,CLS,RES,X13,X15
- SET NP=+$GET(NP)
- +3 SET RES=$GET(^TMP("VPRD",$JOB,NP))
- IF $LENGTH(RES)
- QUIT RES
- +4 SET X13=$GET(^VA(200,NP,.13))
- SET X15=$GET(^(.15))
- +5 SET RES=$PIECE(X13,U,2)_U_$PIECE(X13,U,7)_U_$PIECE(X13,U,6)_U_$PIECE(X15,U)_U
- +6 ;= X12 code ^ #8932.1 ien
- SET X=$$TAXIND^XUSTAX(NP)
- IF $PIECE(X,U,2)
- Begin DoDot:1
- +7 SET CLS=$GET(^USC(8932.1,$PIECE(X,U,2),0))
- if CLS=""
- QUIT
- +8 ;X12^type^class^specialization
- SET RES=RES_$PIECE(X,U)_U_$PIECE(CLS,U,1,3)
- End DoDot:1
- +9 SET $PIECE(RES,U,9)=$$GET1^DIQ(200,NP_",",29)
- +10 SET ^TMP("VPRD",$JOB,NP)=RES
- +11 QUIT RES
- +12 ;
- VUID(IEN,FILE) ; -- Return VUID for item
- +1 QUIT $$GET1^DIQ(FILE,IEN_",",99.99)
- +2 ;
- VERSION(RET) ; -- Return current version of data extracts
- +1 SET RET=$$GET^XPAR("ALL","VPR VERSION")
- +2 QUIT
- +3 ;
- TEST(DFN,TYPE,ID,START,STOP,MAX,TEXT,IN) ; -- test GET, write results to screen
- +1 NEW OUT,IDX
- SET U="^"
- +2 SET DFN=+$GET(DFN)
- if DFN<1
- QUIT
- +3 SET TYPE=$GET(TYPE)
- if TYPE=""
- QUIT
- +4 DO GET(.OUT,DFN,TYPE,$GET(START),$GET(STOP),$GET(MAX),$GET(ID),.IN)
- +5 ;
- +6 SET IDX=OUT
- +7 FOR
- SET IDX=$QUERY(@IDX)
- if IDX'?1"^TMP(""VPR"","1.N.E
- QUIT
- if +$PIECE(IDX,",",2)'=$JOB
- QUIT
- WRITE !,@IDX
- +8 QUIT