VBECRPCD ;DALOI/RLM - Lookup HOSPITAL LOCATION based on DIVISION ;12 January 2004
;;2.0;VBEC;;Jun 05, 2015;Build 4
;
; Note: This routine supports data exchange with an FDA registered
; medical device. As such, it may not be changed in any way without
; prior written approval from the medical device manufacturer.
;
; Integration Agreements:
; Reference to ^SC( supported by IA #10040
; Reference to $$SITE^VASITE supported by IA #10112
; Reference to $$CHARCHK^XOBVLIB supported by IA #4090
;
; This routine should not be called from the top.
QUIT
;
LOC(RESULTS,DIV) ; Main RPC Entry
S VBECCNT=0
S RESULTS=$NA(^TMP("VBECHLOC",$J))
K @RESULTS
D BEGROOT^VBECRPC("HospitalLocations")
I DIV="" D Q
. D ADD^VBECRPC("<Error>No Division Provided</Error>")
. D ENDROOT^VBECRPC("HospitalLocations")
. Q
I DIV]"" D LOOK
D ENDROOT^VBECRPC("HospitalLocations")
Q
LOOK ;
S VBECA=0 F S VBECA=$O(^SC(VBECA)) Q:'VBECA D
. Q:'$P(^SC(VBECA,0),U,15) ;No Division
. S IDATE=$P($G(^SC(VBECA,"I")),"^",1) ;inactivate date
. S RDATE=$P($G(^SC(VBECA,"I")),"^",2) ;reactivate date
. I IDATE]"",IDATE<DT,RDATE="" Q ;past inactivate date, no reactivate date
. I IDATE]"",IDATE<DT,RDATE>DT Q ;past inactivate date, future reactivate date
. ;Q:$D(^SC(VBECA,"I")) ;Inactive Location???
. Q:"CWOR"'[$P(^SC(VBECA,0),U,3) ;Clinic, Ward, or Operating Room
. I DIV=$P($$SITE^VASITE(DT,+$P(^SC(VBECA,0),U,15)),U,3) D
. . D BEGROOT^VBECRPC("Location")
. . D ADD^VBECRPC("<LocationName>"_$$CHARCHK^XOBVLIB($$WSTRIP($P(^SC(VBECA,0),U)))_"</LocationName>")
. . D ADD^VBECRPC("<LocationIEN>"_$$CHARCHK^XOBVLIB(VBECA)_"</LocationIEN>")
. . D ADD^VBECRPC("<LocationType>"_$$CHARCHK^XOBVLIB($P(^SC(VBECA,0),U,3))_"</LocationType>")
. . D ENDROOT^VBECRPC("Location")
Q
KILL ;
K DIV,VBDATA,VBECA,VBECCNT
Q
WSTRIP(VBDATA) ;Strip White Space
F Q:$E(VBDATA,$L(VBDATA))'=" " S VBDATA=$E(VBDATA,1,$L(VBDATA)-1)
F Q:$E(VBDATA,1)'=" " S VBDATA=$E(VBDATA,2,$L(VBDATA))
Q VBDATA
;
TESTLOC ; Entry point to write the results of the Get Hospital Locations RPC
; Function in XML format
;
S VBECTST=1
D LOC(.RESULTS,"589")
S X=0
F S X=$O(@RESULTS@(X)) Q:X="" D
. W @RESULTS@(X)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVBECRPCD 2265 printed Oct 16, 2024@18:44:48 Page 2
VBECRPCD ;DALOI/RLM - Lookup HOSPITAL LOCATION based on DIVISION ;12 January 2004
+1 ;;2.0;VBEC;;Jun 05, 2015;Build 4
+2 ;
+3 ; Note: This routine supports data exchange with an FDA registered
+4 ; medical device. As such, it may not be changed in any way without
+5 ; prior written approval from the medical device manufacturer.
+6 ;
+7 ; Integration Agreements:
+8 ; Reference to ^SC( supported by IA #10040
+9 ; Reference to $$SITE^VASITE supported by IA #10112
+10 ; Reference to $$CHARCHK^XOBVLIB supported by IA #4090
+11 ;
+12 ; This routine should not be called from the top.
+13 QUIT
+14 ;
LOC(RESULTS,DIV) ; Main RPC Entry
+1 SET VBECCNT=0
+2 SET RESULTS=$NAME(^TMP("VBECHLOC",$JOB))
+3 KILL @RESULTS
+4 DO BEGROOT^VBECRPC("HospitalLocations")
+5 IF DIV=""
Begin DoDot:1
+6 DO ADD^VBECRPC("<Error>No Division Provided</Error>")
+7 DO ENDROOT^VBECRPC("HospitalLocations")
+8 QUIT
End DoDot:1
QUIT
+9 IF DIV]""
DO LOOK
+10 DO ENDROOT^VBECRPC("HospitalLocations")
+11 QUIT
LOOK ;
+1 SET VBECA=0
FOR
SET VBECA=$ORDER(^SC(VBECA))
if 'VBECA
QUIT
Begin DoDot:1
+2 ;No Division
if '$PIECE(^SC(VBECA,0),U,15)
QUIT
+3 ;inactivate date
SET IDATE=$PIECE($GET(^SC(VBECA,"I")),"^",1)
+4 ;reactivate date
SET RDATE=$PIECE($GET(^SC(VBECA,"I")),"^",2)
+5 ;past inactivate date, no reactivate date
IF IDATE]""
IF IDATE<DT
IF RDATE=""
QUIT
+6 ;past inactivate date, future reactivate date
IF IDATE]""
IF IDATE<DT
IF RDATE>DT
QUIT
+7 ;Q:$D(^SC(VBECA,"I")) ;Inactive Location???
+8 ;Clinic, Ward, or Operating Room
if "CWOR"'[$PIECE(^SC(VBECA,0),U,3)
QUIT
+9 IF DIV=$PIECE($$SITE^VASITE(DT,+$PIECE(^SC(VBECA,0),U,15)),U,3)
Begin DoDot:2
+10 DO BEGROOT^VBECRPC("Location")
+11 DO ADD^VBECRPC("<LocationName>"_$$CHARCHK^XOBVLIB($$WSTRIP($PIECE(^SC(VBECA,0),U)))_"</LocationName>")
+12 DO ADD^VBECRPC("<LocationIEN>"_$$CHARCHK^XOBVLIB(VBECA)_"</LocationIEN>")
+13 DO ADD^VBECRPC("<LocationType>"_$$CHARCHK^XOBVLIB($PIECE(^SC(VBECA,0),U,3))_"</LocationType>")
+14 DO ENDROOT^VBECRPC("Location")
End DoDot:2
End DoDot:1
+15 QUIT
KILL ;
+1 KILL DIV,VBDATA,VBECA,VBECCNT
+2 QUIT
WSTRIP(VBDATA) ;Strip White Space
+1 FOR
if $EXTRACT(VBDATA,$LENGTH(VBDATA))'=" "
QUIT
SET VBDATA=$EXTRACT(VBDATA,1,$LENGTH(VBDATA)-1)
+2 FOR
if $EXTRACT(VBDATA,1)'=" "
QUIT
SET VBDATA=$EXTRACT(VBDATA,2,$LENGTH(VBDATA))
+3 QUIT VBDATA
+4 ;
TESTLOC ; Entry point to write the results of the Get Hospital Locations RPC
+1 ; Function in XML format
+2 ;
+3 SET VBECTST=1
+4 DO LOC(.RESULTS,"589")
+5 SET X=0
+6 FOR
SET X=$ORDER(@RESULTS@(X))
if X=""
QUIT
Begin DoDot:1
+7 WRITE @RESULTS@(X)
End DoDot:1
+8 QUIT
