- 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 Mar 13, 2025@21:49:28 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
