VPRHST ;SLC/MKB -- Test HS utilities ;09/18/18 4:36pm
;;1.0;VIRTUAL PATIENT RECORD;**8,25,27**;Sep 01, 2011;Build 10
;;Per VA Directive 6402, this routine should not be modified.
;
; External References DBIA#
; ------------------- -----
; %ZIS 10086
; DIC 2051
; DID 2052
; DIR 10026
;
EN ; -- test VPRHS, write results to screen
N DFN,TYPE,VPRZTEST S VPRZTEST=1
F S DFN=$$PATIENT Q:DFN<1 D
. F S TYPE=$$SOURCE Q:"^"[TYPE D RUN W !! ;$$CONTNR
Q
;
RUN ; -- get search parameters, run and display
N START,STOP,MAX,ID,FMT,IN,OUT,TOTAL,I,X,RTN,DONE,QUIT
S START=$$START Q:START="^"
I START S STOP=$$STOP(START) Q:STOP="^"
S MAX=$$TOTAL Q:MAX="^"
; ID=$$ITEM Q:ID="^"
S FMT=1 ;$$FORMAT Q:FMT="^"
;
S:$G(START) IN("start")=START
S:$G(STOP) IN("stop")=STOP
S:$G(MAX) IN("max")=MAX
D GET^VPRHS(DFN,TYPE,,.IN,1,.OUT)
D ^%ZIS
;
S TOTAL=$O(@OUT@("A"),-1),RTN=$S(FMT:"XML",1:"JSON")_"^VPRHST1(X)"
W !!,"#Results: "_TOTAL Q:TOTAL<1
S I=0 F S I=$O(@OUT@(I)) Q:I<1 D Q:$G(QUIT)
. I '$G(DONE) D READ Q:$G(QUIT)
. W !,"Result #"_I,! S X=@OUT@(I) D @RTN
K @OUT
D HOME^%ZIS
Q
;
READ ; -- continue?
N X K DONE,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
;
SOURCE() ; -- select SDA source
N X,Y,DIC,DA,FN
S DIC=560.1,DIC(0)="AEQMZ",DIC("A")="Select CONTAINER: "
S DIC("S")="I $O(^(1,0))" D ^DIC I Y<1 Q "^"
S DA=+Y,Y=$P(Y(0),U,2)
I $P($G(^VPRC(560.1,DA,1,0)),U,4)>1 D
. S FN=$$FILE(DA) S:FN>1 Y=Y_";"_FN
. I FN="^" S Y="^"
Q Y
;
FILE(CONT) ; -- select optional source file for CONTainer
N I,X,Y,Z,DIR,GBL S CONT=$G(CONT)
S CONT=$S(CONT:+CONT,$L(CONT):+$O(^VPRC(560.1,"C",CONT,0)),1:0)
S DIR("A")="Select SOURCE FILE: ",DIR(0)="SAO^",Y=""
F I=1:1 S X=$G(^VPRC(560.1,CONT,1,I,0)) Q:X="" D
. S Z=$$GET1^DID(+X,,,"NAME")
. I Z="" S GBL="^DD(+X,0,""NM"")",Z=$O(@GBL@("")) ;subfile
. S DIR(0)=DIR(0)_+X_":"_Z_";"
S DIR("?")="Select a VistA source file for this container, or press return for all."
K X D:CONT ^DIR
Q Y
;
CONTNR() ; -- select SDA container
N X,Y,DIC
S DIC="^VPRC(560.1,",DIC(0)="AEQMZ",DIC("A")="Select CONTAINER: "
S DIC("S")="I $O(^(1,0))" D ^DIC I Y<1 Q "^"
S Y=$P($G(Y(0)),U,2)
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:99999",DIR("A")="Select TOTAL #items: "
S DIR("?")="Enter an optional maximum number of items to return per VistA source for this container, up to 99999"
D ^DIR S:$D(DTOUT) Y="^"
Q Y
;
ITEM() ; -- select an item ID to return
N X,Y,DIR,DUOUT,DTOUT
S DIR(0)="FAO^1:20",DIR("A")="ID: "
S DIR("?")="Enter the id of a record to return, if known; press return to view all records in this container."
D ^DIR S:$D(DTOUT) Y="^"
Q Y
;
FORMAT() ; -- select output format
N X,Y,DIR,DUOUT,DTOUT
S DIR(0)="SAO^0:JSON;1:XML;",DIR("A")="Select FORMAT: ",DIR("B")="XML"
S DIR("?")="Choose your desired output format, XML or JSON"
D ^DIR S:$D(DUOUT) Y="^"
Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVPRHST 3693 printed Dec 13, 2024@02:45:16 Page 2
VPRHST ;SLC/MKB -- Test HS utilities ;09/18/18 4:36pm
+1 ;;1.0;VIRTUAL PATIENT RECORD;**8,25,27**;Sep 01, 2011;Build 10
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; External References DBIA#
+5 ; ------------------- -----
+6 ; %ZIS 10086
+7 ; DIC 2051
+8 ; DID 2052
+9 ; DIR 10026
+10 ;
EN ; -- test VPRHS, write results to screen
+1 NEW DFN,TYPE,VPRZTEST
SET VPRZTEST=1
+2 FOR
SET DFN=$$PATIENT
if DFN<1
QUIT
Begin DoDot:1
+3 ;$$CONTNR
FOR
SET TYPE=$$SOURCE
if "^"[TYPE
QUIT
DO RUN
WRITE !!
End DoDot:1
+4 QUIT
+5 ;
RUN ; -- get search parameters, run and display
+1 NEW START,STOP,MAX,ID,FMT,IN,OUT,TOTAL,I,X,RTN,DONE,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 Q:ID="^"
+6 ;$$FORMAT Q:FMT="^"
SET FMT=1
+7 ;
+8 if $GET(START)
SET IN("start")=START
+9 if $GET(STOP)
SET IN("stop")=STOP
+10 if $GET(MAX)
SET IN("max")=MAX
+11 DO GET^VPRHS(DFN,TYPE,,.IN,1,.OUT)
+12 DO ^%ZIS
+13 ;
+14 SET TOTAL=$ORDER(@OUT@("A"),-1)
SET RTN=$SELECT(FMT:"XML",1:"JSON")_"^VPRHST1(X)"
+15 WRITE !!,"#Results: "_TOTAL
if TOTAL<1
QUIT
+16 SET I=0
FOR
SET I=$ORDER(@OUT@(I))
if I<1
QUIT
Begin DoDot:1
+17 IF '$GET(DONE)
DO READ
if $GET(QUIT)
QUIT
+18 WRITE !,"Result #"_I,!
SET X=@OUT@(I)
DO @RTN
End DoDot:1
if $GET(QUIT)
QUIT
+19 KILL @OUT
+20 DO HOME^%ZIS
+21 QUIT
+22 ;
READ ; -- continue?
+1 NEW X
KILL DONE,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 ;
SOURCE() ; -- select SDA source
+1 NEW X,Y,DIC,DA,FN
+2 SET DIC=560.1
SET DIC(0)="AEQMZ"
SET DIC("A")="Select CONTAINER: "
+3 SET DIC("S")="I $O(^(1,0))"
DO ^DIC
IF Y<1
QUIT "^"
+4 SET DA=+Y
SET Y=$PIECE(Y(0),U,2)
+5 IF $PIECE($GET(^VPRC(560.1,DA,1,0)),U,4)>1
Begin DoDot:1
+6 SET FN=$$FILE(DA)
if FN>1
SET Y=Y_";"_FN
+7 IF FN="^"
SET Y="^"
End DoDot:1
+8 QUIT Y
+9 ;
FILE(CONT) ; -- select optional source file for CONTainer
+1 NEW I,X,Y,Z,DIR,GBL
SET CONT=$GET(CONT)
+2 SET CONT=$SELECT(CONT:+CONT,$LENGTH(CONT):+$ORDER(^VPRC(560.1,"C",CONT,0)),1:0)
+3 SET DIR("A")="Select SOURCE FILE: "
SET DIR(0)="SAO^"
SET Y=""
+4 FOR I=1:1
SET X=$GET(^VPRC(560.1,CONT,1,I,0))
if X=""
QUIT
Begin DoDot:1
+5 SET Z=$$GET1^DID(+X,,,"NAME")
+6 ;subfile
IF Z=""
SET GBL="^DD(+X,0,""NM"")"
SET Z=$ORDER(@GBL@(""))
+7 SET DIR(0)=DIR(0)_+X_":"_Z_";"
End DoDot:1
+8 SET DIR("?")="Select a VistA source file for this container, or press return for all."
+9 KILL X
if CONT
DO ^DIR
+10 QUIT Y
+11 ;
CONTNR() ; -- select SDA container
+1 NEW X,Y,DIC
+2 SET DIC="^VPRC(560.1,"
SET DIC(0)="AEQMZ"
SET DIC("A")="Select CONTAINER: "
+3 SET DIC("S")="I $O(^(1,0))"
DO ^DIC
IF Y<1
QUIT "^"
+4 SET Y=$PIECE($GET(Y(0)),U,2)
+5 QUIT Y
+6 ;
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:99999"
SET DIR("A")="Select TOTAL #items: "
+3 SET DIR("?")="Enter an optional maximum number of items to return per VistA source for this container, up to 99999"
+4 DO ^DIR
if $DATA(DTOUT)
SET Y="^"
+5 QUIT Y
+6 ;
ITEM() ; -- select an item ID to return
+1 NEW X,Y,DIR,DUOUT,DTOUT
+2 SET DIR(0)="FAO^1:20"
SET DIR("A")="ID: "
+3 SET DIR("?")="Enter the id of a record to return, if known; press return to view all records in this container."
+4 DO ^DIR
if $DATA(DTOUT)
SET Y="^"
+5 QUIT Y
+6 ;
FORMAT() ; -- select output format
+1 NEW X,Y,DIR,DUOUT,DTOUT
+2 SET DIR(0)="SAO^0:JSON;1:XML;"
SET DIR("A")="Select FORMAT: "
SET DIR("B")="XML"
+3 SET DIR("?")="Choose your desired output format, XML or JSON"
+4 DO ^DIR
if $DATA(DUOUT)
SET Y="^"
+5 QUIT Y
