VPRDJT ;SLC/MKB -- Test VistA data JSON RPC ;10/18/12 6:26pm
;;1.0;VIRTUAL PATIENT RECORD;**2,32**;Sep 01, 2011;Build 6
;;Per VHA Directive 2004-038, this routine should not be modified.
;
; External References DBIA#
; ------------------- -----
; DIC 2051
; DIR 10026
;
EN ; -- test GET^VPRDJ, write results to screen
N DFN,TYPE,TEXT,START,STOP,MAX,ID,IN,OUT,IDX,QUIT
F S DFN=$$PATIENT Q:DFN<1 D
. F S TYPE=$$DOMAIN Q:"^"[TYPE D
.. D RPC W !!
.. K IN,TEXT,START,STOP,MAX,QUIT
Q
;
RPC ; -- get search parameters, run and display
I TYPE="DOCUMENT" S TEXT=$$SHOW Q:TEXT="^"
S START=$$START Q:START="^"
I START S STOP=$$STOP(START) Q:STOP="^"
S MAX=$$TOTAL Q:MAX="^"
; ID=$$ITEM
;
S IN("patientId")=+$G(DFN)
S IN("domain")=$G(TYPE)
S:$L($G(TEXT)) IN("text")=TEXT
S:$G(START) IN("start")=START
S:$G(STOP) IN("stop")=STOP
S:$G(MAX) IN("max")=MAX
S:$D(ID) IN("id")=ID
D GET^VPRDJ(.OUT,.IN)
;
W ! F IDX=.5:.1:.9 W:$D(@OUT@(IDX)) !,@OUT@(IDX) ;version and total
F S IDX=$O(@OUT@(IDX)) Q:IDX<1 D Q:$G(QUIT)
. I $G(@OUT@(IDX))="]}}" W !,@OUT@(IDX) S QUIT=1 Q
. D READ Q:$G(QUIT) W !!
. S I=.9 F S I=$O(@OUT@(IDX,I)) Q:I<1 W @OUT@(IDX,I)
K @OUT
;S IDX=OUT W !
;F S IDX=$Q(@IDX) Q:IDX'?1"^TMP(""VPR"","1.N.E Q:+$P(IDX,",",2)'=$J W !,@IDX
Q
;
READ ; -- continue?
N X K QUIT
W !!,"Press <return> to continue or ^ to exit results ..." R X:DTIME
S:X["^" QUIT=1
Q
;
PATIENT() ; -- select patient
N X,Y,DIC
S DIC=2,DIC(0)="AEQM" D ^DIC
Q Y
;
DOMAIN() ; -- select domain
N X,Y,I,DIR,VPR
S DIR(0)="SAO^",DIR("A")="Select DOMAIN: "
F I=1:1 S X=$P($T(TYPE+I),";",3) Q:X=99 S DIR(0)=DIR(0)_X_";",VPR(+X)=$P(X,":",2)
D ^DIR S:Y Y=VPR(Y)
I Y="RADIOLOGY" S Y="IMAGE"
Q Y
;
TYPE ;;CODE:NAME
;;1:ALLERGY
;;2:APPOINTMENT
;;3:CONSULT
;;4:CPT
;;5:DOCUMENT
;;6:EDUCATION
;;7:EXAM
;;8:FACTOR
;;9:IMMUNIZATION
;;10:LAB
;;11:MED
;;12:OBSERVATION
;;13:ORDER
;;14:PATIENT
;;15:POV
;;16:PROBLEM
;;17:PROCEDURE
;;18:RADIOLOGY
;;19:SKIN
;;20:SURGERY
;;21:VISIT
;;22:VITAL
;;99
;
SHOW() ; -- true/false to include body of note
N X,Y,DIR,DUOUT,DTOUT
S DIR(0)="YAO",DIR("A")="Include the text of each document? "
D ^DIR S:$D(DTOUT) Y="^"
Q Y
;
START() ; -- select a start date
N X,Y,DIR,DUOUT,DTOUT
S DIR(0)="DAO^::AEPT",DIR("A")="Select START DATE: "
S DIR("?")="Enter an optional date[.time] to begin searching for data"
D ^DIR S:$D(DTOUT) Y="^"
Q Y
;
STOP(START) ; -- select a stop date
N X,Y,DIR,DUOUT,DTOUT
S DIR(0)="DA^"_START_"::AEPT",DIR("A")="Select STOP DATE: "
S DIR("?")="Enter a date[.time] after the START to end searching for data"
D ^DIR S:$D(DTOUT) Y="^"
Q Y
;
TOTAL() ; -- select the max# to return
N X,Y,DIR,DUOUT,DTOUT
S DIR(0)="NAO^1:9999",DIR("A")="Select TOTAL #items: "
S DIR("?")="Enter an optional maximum number of items to return, up to 9999"
D ^DIR S:$D(DTOUT) Y="^"
Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVPRDJT 3055 printed Apr 09, 2024@21:47:10 Page 2
VPRDJT ;SLC/MKB -- Test VistA data JSON RPC ;10/18/12 6:26pm
+1 ;;1.0;VIRTUAL PATIENT RECORD;**2,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 ; DIC 2051
+7 ; DIR 10026
+8 ;
EN ; -- test GET^VPRDJ, write results to screen
+1 NEW DFN,TYPE,TEXT,START,STOP,MAX,ID,IN,OUT,IDX,QUIT
+2 FOR
SET DFN=$$PATIENT
if DFN<1
QUIT
Begin DoDot:1
+3 FOR
SET TYPE=$$DOMAIN
if "^"[TYPE
QUIT
Begin DoDot:2
+4 DO RPC
WRITE !!
+5 KILL IN,TEXT,START,STOP,MAX,QUIT
End DoDot:2
End DoDot:1
+6 QUIT
+7 ;
RPC ; -- get search parameters, run and display
+1 IF TYPE="DOCUMENT"
SET TEXT=$$SHOW
if TEXT="^"
QUIT
+2 SET START=$$START
if START="^"
QUIT
+3 IF START
SET STOP=$$STOP(START)
if STOP="^"
QUIT
+4 SET MAX=$$TOTAL
if MAX="^"
QUIT
+5 ; ID=$$ITEM
+6 ;
+7 SET IN("patientId")=+$GET(DFN)
+8 SET IN("domain")=$GET(TYPE)
+9 if $LENGTH($GET(TEXT))
SET IN("text")=TEXT
+10 if $GET(START)
SET IN("start")=START
+11 if $GET(STOP)
SET IN("stop")=STOP
+12 if $GET(MAX)
SET IN("max")=MAX
+13 if $DATA(ID)
SET IN("id")=ID
+14 DO GET^VPRDJ(.OUT,.IN)
+15 ;
+16 ;version and total
WRITE !
FOR IDX=.5:.1:.9
if $DATA(@OUT@(IDX))
WRITE !,@OUT@(IDX)
+17 FOR
SET IDX=$ORDER(@OUT@(IDX))
if IDX<1
QUIT
Begin DoDot:1
+18 IF $GET(@OUT@(IDX))="]}}"
WRITE !,@OUT@(IDX)
SET QUIT=1
QUIT
+19 DO READ
if $GET(QUIT)
QUIT
WRITE !!
+20 SET I=.9
FOR
SET I=$ORDER(@OUT@(IDX,I))
if I<1
QUIT
WRITE @OUT@(IDX,I)
End DoDot:1
if $GET(QUIT)
QUIT
+21 KILL @OUT
+22 ;S IDX=OUT W !
+23 ;F S IDX=$Q(@IDX) Q:IDX'?1"^TMP(""VPR"","1.N.E Q:+$P(IDX,",",2)'=$J W !,@IDX
+24 QUIT
+25 ;
READ ; -- continue?
+1 NEW X
KILL QUIT
+2 WRITE !!,"Press <return> to continue or ^ to exit results ..."
READ X:DTIME
+3 if X["^"
SET QUIT=1
+4 QUIT
+5 ;
PATIENT() ; -- select patient
+1 NEW X,Y,DIC
+2 SET DIC=2
SET DIC(0)="AEQM"
DO ^DIC
+3 QUIT Y
+4 ;
DOMAIN() ; -- select domain
+1 NEW X,Y,I,DIR,VPR
+2 SET DIR(0)="SAO^"
SET DIR("A")="Select DOMAIN: "
+3 FOR I=1:1
SET X=$PIECE($TEXT(TYPE+I),";",3)
if X=99
QUIT
SET DIR(0)=DIR(0)_X_";"
SET VPR(+X)=$PIECE(X,":",2)
+4 DO ^DIR
if Y
SET Y=VPR(Y)
+5 IF Y="RADIOLOGY"
SET Y="IMAGE"
+6 QUIT Y
+7 ;
TYPE ;;CODE:NAME
+1 ;;1:ALLERGY
+2 ;;2:APPOINTMENT
+3 ;;3:CONSULT
+4 ;;4:CPT
+5 ;;5:DOCUMENT
+6 ;;6:EDUCATION
+7 ;;7:EXAM
+8 ;;8:FACTOR
+9 ;;9:IMMUNIZATION
+10 ;;10:LAB
+11 ;;11:MED
+12 ;;12:OBSERVATION
+13 ;;13:ORDER
+14 ;;14:PATIENT
+15 ;;15:POV
+16 ;;16:PROBLEM
+17 ;;17:PROCEDURE
+18 ;;18:RADIOLOGY
+19 ;;19:SKIN
+20 ;;20:SURGERY
+21 ;;21:VISIT
+22 ;;22:VITAL
+23 ;;99
+24 ;
SHOW() ; -- true/false to include body of note
+1 NEW X,Y,DIR,DUOUT,DTOUT
+2 SET DIR(0)="YAO"
SET DIR("A")="Include the text of each document? "
+3 DO ^DIR
if $DATA(DTOUT)
SET Y="^"
+4 QUIT Y
+5 ;
START() ; -- select a start date
+1 NEW X,Y,DIR,DUOUT,DTOUT
+2 SET DIR(0)="DAO^::AEPT"
SET DIR("A")="Select START DATE: "
+3 SET DIR("?")="Enter an optional date[.time] to begin searching for data"
+4 DO ^DIR
if $DATA(DTOUT)
SET Y="^"
+5 QUIT Y
+6 ;
STOP(START) ; -- select a stop date
+1 NEW X,Y,DIR,DUOUT,DTOUT
+2 SET DIR(0)="DA^"_START_"::AEPT"
SET DIR("A")="Select STOP DATE: "
+3 SET DIR("?")="Enter a date[.time] after the START to end searching for data"
+4 DO ^DIR
if $DATA(DTOUT)
SET Y="^"
+5 QUIT Y
+6 ;
TOTAL() ; -- select the max# to return
+1 NEW X,Y,DIR,DUOUT,DTOUT
+2 SET DIR(0)="NAO^1:9999"
SET DIR("A")="Select TOTAL #items: "
+3 SET DIR("?")="Enter an optional maximum number of items to return, up to 9999"
+4 DO ^DIR
if $DATA(DTOUT)
SET Y="^"
+5 QUIT Y
