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

VPRDJT.m

Go to the documentation of this file. 
  1. 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
  1.  ;;Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;
  1.  ; External References          DBIA#
  1.  ; -------------------          -----
  1.  ; DIC                           2051
  1.  ; DIR                          10026
  1.  ;
  1. EN ; -- test GET^VPRDJ, write results to screen
  1.  N DFN,TYPE,TEXT,START,STOP,MAX,ID,IN,OUT,IDX,QUIT
  1.  F  S DFN=$$PATIENT Q:DFN<1  D 
  1.  . F  S TYPE=$$DOMAIN Q:"^"[TYPE  D
  1.  .. D RPC W !!
  1.  .. K IN,TEXT,START,STOP,MAX,QUIT
  1.  Q
  1.  ;
  1. RPC ; -- get search parameters, run and display
  1.  I TYPE="DOCUMENT" S TEXT=$$SHOW Q:TEXT="^"
  1.  S START=$$START Q:START="^"
  1.  I START S STOP=$$STOP(START) Q:STOP="^"
  1.  S MAX=$$TOTAL Q:MAX="^"
  1.  ; ID=$$ITEM
  1.  ;
  1.  S IN("patientId")=+$G(DFN)
  1.  S IN("domain")=$G(TYPE)
  1.  S:$L($G(TEXT)) IN("text")=TEXT
  1.  S:$G(START) IN("start")=START
  1.  S:$G(STOP) IN("stop")=STOP
  1.  S:$G(MAX) IN("max")=MAX
  1.  S:$D(ID) IN("id")=ID
  1.  D GET^VPRDJ(.OUT,.IN)
  1.  ;
  1.  W ! F IDX=.5:.1:.9 W:$D(@OUT@(IDX)) !,@OUT@(IDX) ;version and total
  1.  F  S IDX=$O(@OUT@(IDX)) Q:IDX<1  D  Q:$G(QUIT)
  1.  . I $G(@OUT@(IDX))="]}}" W !,@OUT@(IDX) S QUIT=1 Q
  1.  . D READ Q:$G(QUIT)  W !!
  1.  . S I=.9 F  S I=$O(@OUT@(IDX,I)) Q:I<1  W @OUT@(IDX,I)
  1.  K @OUT
  1.  ;S IDX=OUT W !
  1.  ;F  S IDX=$Q(@IDX) Q:IDX'?1"^TMP(""VPR"","1.N.E  Q:+$P(IDX,",",2)'=$J  W !,@IDX
  1.  Q
  1.  ;
  1. READ ; -- continue?
  1.  N X K QUIT
  1.  W !!,"Press <return> to continue or ^ to exit results ..." R X:DTIME
  1.  S:X["^" QUIT=1
  1.  Q
  1.  ;
  1. PATIENT() ; -- select patient
  1.  N X,Y,DIC
  1.  S DIC=2,DIC(0)="AEQM" D ^DIC
  1.  Q Y
  1.  ;
  1. DOMAIN() ; -- select domain
  1.  N X,Y,I,DIR,VPR
  1.  S DIR(0)="SAO^",DIR("A")="Select DOMAIN: "
  1.  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)
  1.  D ^DIR S:Y Y=VPR(Y)
  1.  I Y="RADIOLOGY" S Y="IMAGE"
  1.  Q Y
  1.  ;
  1. TYPE ;;CODE:NAME
  1.  ;;1:ALLERGY
  1.  ;;2:APPOINTMENT
  1.  ;;3:CONSULT
  1.  ;;4:CPT
  1.  ;;5:DOCUMENT
  1.  ;;6:EDUCATION
  1.  ;;7:EXAM
  1.  ;;8:FACTOR
  1.  ;;9:IMMUNIZATION
  1.  ;;10:LAB
  1.  ;;11:MED
  1.  ;;12:OBSERVATION
  1.  ;;13:ORDER
  1.  ;;14:PATIENT
  1.  ;;15:POV
  1.  ;;16:PROBLEM
  1.  ;;17:PROCEDURE
  1.  ;;18:RADIOLOGY
  1.  ;;19:SKIN
  1.  ;;20:SURGERY
  1.  ;;21:VISIT
  1.  ;;22:VITAL
  1.  ;;99
  1.  ;
  1. SHOW() ; -- true/false to include body of note
  1.  N X,Y,DIR,DUOUT,DTOUT
  1.  S DIR(0)="YAO",DIR("A")="Include the text of each document? "
  1.  D ^DIR S:$D(DTOUT) Y="^"
  1.  Q Y
  1.  ;
  1. START() ; -- select a start date
  1.  N X,Y,DIR,DUOUT,DTOUT
  1.  S DIR(0)="DAO^::AEPT",DIR("A")="Select START DATE: "
  1.  S DIR("?")="Enter an optional date[.time] to begin searching for data"
  1.  D ^DIR S:$D(DTOUT) Y="^"
  1.  Q Y
  1.  ;
  1. STOP(START) ; -- select a stop date
  1.  N X,Y,DIR,DUOUT,DTOUT
  1.  S DIR(0)="DA^"_START_"::AEPT",DIR("A")="Select STOP DATE: "
  1.  S DIR("?")="Enter a date[.time] after the START to end searching for data"
  1.  D ^DIR S:$D(DTOUT) Y="^"
  1.  Q Y
  1.  ;
  1. TOTAL() ; -- select the max# to return
  1.  N X,Y,DIR,DUOUT,DTOUT
  1.  S DIR(0)="NAO^1:9999",DIR("A")="Select TOTAL #items: "
  1.  S DIR("?")="Enter an optional maximum number of items to return, up to 9999"
  1.  D ^DIR S:$D(DTOUT) Y="^"
  1.  Q Y