VBECLU3 ;HIOFO/BNT - VBECS Patient Lookup Utility ;04/13/2005 09:00
;;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:
;
QUIT
; -- Get list of wards or clinics for patient lookup by ward
;
; -- Does not currently limit display by division, institution, etc. May need to.
;
GETLIST(RESULT,PARAM) ;
NEW X,CNT,VBECLINE,VBECESLT,OKAY
SET (CNT,OKAY)=0
IF '$D(DT) D DT^DICRW
;
SET VBECLINE=0
K ^TMP($J,"PLU-FILTER")
SET VBECRSLT="^TMP($J,""PLU-FILTER"")"
SET RESULT=$NA(@VBECRSLT)
;
DO ADD^VBECLU($$XMLHDR^XOBVLIB)
;
IF $$UP^XLFSTR(PARAM("TYPE"))="WARD" S OKAY=1 D
. D ADD^VBECLU("<filterlist type='ward'>")
. D WLIST("ward")
. D ADD^VBECLU("</filterlist>")
;
IF $$UP^XLFSTR(PARAM("TYPE"))="CLINIC" S OKAY=2 D
. D ADD^VBECLU("<filterlist type='clinic'>")
. D CLIST("clinic","C")
. D ADD^VBECLU("</filterlist>")
;
IF $$UP^XLFSTR(PARAM("TYPE"))="PROVIDER" S OKAY=3 D
. D ADD^VBECLU("<filterlist type='provider'>")
. D PLIST("provider")
. D ADD^VBECLU("</filterlist>")
;
IF OKAY<1 D
. D ADD^VBECLU("<unspecified>")
. D ADD^VBECLU("<error message='List type not supported or not specified!'>")
. D ADD^VBECLU("</unspecified>")
;
QUIT
;
; -- get list of clinics for patient lookup by clinic
CLIST(ITEM,CHKVAL) ;
NEW NAME,IEN,IDATE,RDATE
SET IEN=0
SET CNT=0
FOR S IEN=$O(^SC("AC","C",IEN)) Q:IEN<1 DO ;loop through clinic xref
. S IDATE=$P($G(^SC(IEN,"I")),"^",1) ;inactivate date
. S RDATE=$P($G(^SC(IEN,"I")),"^",2) ;reactivate date
. IF (IDATE="")!(IDATE'<DT)!((IDATE<DT)&(RDATE>IDATE)) DO
. SET CNT=CNT+1
. SET NAME=$P(^SC(IEN,0),"^",1)
. DO ADD^VBECLU("<lineitem number='"_CNT_"' id='"_IEN_"' name='"_$$CHARCHK^XOBVLIB(NAME)_"'></lineitem>")
;FOR S NAME=$O(^SC("B",NAME)) Q:NAME="" DO
;. S IEN=0
;. FOR S IEN=$O(^SC("B",NAME,IEN)) Q:IEN<1 DO
;.. IF $P($G(^SC(IEN,0)),"^",3)=CHKVAL DO ;is a clinic
;... S IDATE=$P($G(^SC(IEN,"I")),"^",1) ;inactivate date
;... S RDATE=$P($G(^SC(IEN,"I")),"^",2) ;reactivate date
;... IF (IDATE="")!(IDATE'<DT)!((IDATE<DT)&(RDATE>IDATE)) DO
;.... SET CNT=CNT+1
;.... DO ADD^VBECLU("<lineitem number='"_CNT_"' id='"_IEN_"' name='"_$$CHARCHK^XOBVLIB(NAME)_"'></lineitem>")
QUIT
;
WLIST(ITEM) ;
NEW NAME,IEN
SET NAME=""
SET CNT=0
FOR S NAME=$O(^DIC(42,"B",NAME)) Q:NAME="" DO
. S IEN=0
. FOR S IEN=$O(^DIC(42,"B",NAME,IEN)) Q:IEN<1 DO
.. SET CNT=CNT+1
.. DO ADD^VBECLU("<lineitem number='"_CNT_"' id='"_IEN_"' name='"_$$CHARCHK^XOBVLIB(NAME)_"'></lineitem>")
QUIT
; -- get list of providers for patient lookup by provider
; from ORQPTQ2
PLIST(ITEM) ;
NEW NAME,IEN
SET (NAME,IEN)=""
SET CNT=0
K ^TMP($J,"PLU-F")
FOR S IEN=$O(^XUSEC("PROVIDER",IEN)) Q:IEN<1 I $$ACTIVE^XUSER(IEN) DO
. SET ^TMP($J,"PLU-F",$P(^VA(200,IEN,0),"^",1),IEN)=""
SET NAME=""
F S NAME=$O(^TMP($J,"PLU-F",NAME)) Q:NAME="" DO
. SET IEN=0 F S IEN=$O(^TMP($J,"PLU-F",NAME,IEN)) Q:IEN<1 DO W IEN
.. SET CNT=CNT+1
.. DO ADD^VBECLU("<lineitem number='"_CNT_"' id='"_IEN_"' name='"_$$CHARCHK^XOBVLIB(NAME)_"'></lineitem>")
;
;FOR S NAME=$O(^VA(200,"B",NAME)) Q:NAME="" DO
;. S IEN=0
;. FOR S IEN=$O(^VA(200,"B",NAME,IEN)) Q:IEN<1 DO
;.. I $D(^XUSEC("PROVIDER",IEN)),$$ACTIVE^XUSER(IEN) DO
;... SET CNT=CNT+1
;... DO ADD^VBECLU("<lineitem number='"_CNT_"' id='"_IEN_"' name='"_$$CHARCHK^XOBVLIB(NAME)_"'></lineitem>")
QUIT
;
TEST ;
NEW X,START,FINISH
DO TESTC
DO TESTP
DO TESTW
QUIT
;
TESTW ;
S START=$H
W !,"WARD LIST"
S X("TYPE")="wARd"
D GETLIST(.RESULT,.X)
S FINISH=$H
D DISPLAY(.RESULT)
W !,"Elapse Time: ",$P(FINISH,",",2)-$P(START,",",2)
K RESULT
QUIT
;
TESTC ;
S START=$H W !,"CLINIC LIST"
S X("TYPE")="ClinIC"
D GETLIST(.RESULT,.X)
S FINISH=$H
D DISPLAY(.RESULT)
W !,"Elapse Time: ",$P(FINISH,",",2)-$P(START,",",2)
K RESULT
QUIT
;
TESTP ;
S START=$H W !,"PROVIDER LIST"
S X("TYPE")="pROvIdER"
D GETLIST(.RESULT,.X)
S FINISH=$H
D DISPLAY(.RESULT)
W !,"Elapse Time: ",$P(FINISH,",",2)-$P(START,",",2)
Q
DISPLAY(RESULT) ;
NEW I
S I=-1 FOR SET I=$O(@RESULT@(I)) Q:I<1 W !!,@RESULT@(I)
QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVBECLU3 4403 printed Apr 09, 2024@21:46 Page 2
VBECLU3 ;HIOFO/BNT - VBECS Patient Lookup Utility ;04/13/2005 09:00
+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 ;
+9 QUIT
+10 ; -- Get list of wards or clinics for patient lookup by ward
+11 ;
+12 ; -- Does not currently limit display by division, institution, etc. May need to.
+13 ;
GETLIST(RESULT,PARAM) ;
+1 NEW X,CNT,VBECLINE,VBECESLT,OKAY
+2 SET (CNT,OKAY)=0
+3 IF '$DATA(DT)
DO DT^DICRW
+4 ;
+5 SET VBECLINE=0
+6 KILL ^TMP($JOB,"PLU-FILTER")
+7 SET VBECRSLT="^TMP($J,""PLU-FILTER"")"
+8 SET RESULT=$NAME(@VBECRSLT)
+9 ;
+10 DO ADD^VBECLU($$XMLHDR^XOBVLIB)
+11 ;
+12 IF $$UP^XLFSTR(PARAM("TYPE"))="WARD"
SET OKAY=1
Begin DoDot:1
+13 DO ADD^VBECLU("<filterlist type='ward'>")
+14 DO WLIST("ward")
+15 DO ADD^VBECLU("</filterlist>")
End DoDot:1
+16 ;
+17 IF $$UP^XLFSTR(PARAM("TYPE"))="CLINIC"
SET OKAY=2
Begin DoDot:1
+18 DO ADD^VBECLU("<filterlist type='clinic'>")
+19 DO CLIST("clinic","C")
+20 DO ADD^VBECLU("</filterlist>")
End DoDot:1
+21 ;
+22 IF $$UP^XLFSTR(PARAM("TYPE"))="PROVIDER"
SET OKAY=3
Begin DoDot:1
+23 DO ADD^VBECLU("<filterlist type='provider'>")
+24 DO PLIST("provider")
+25 DO ADD^VBECLU("</filterlist>")
End DoDot:1
+26 ;
+27 IF OKAY<1
Begin DoDot:1
+28 DO ADD^VBECLU("<unspecified>")
+29 DO ADD^VBECLU("<error message='List type not supported or not specified!'>")
+30 DO ADD^VBECLU("</unspecified>")
End DoDot:1
+31 ;
+32 QUIT
+33 ;
+34 ; -- get list of clinics for patient lookup by clinic
CLIST(ITEM,CHKVAL) ;
+1 NEW NAME,IEN,IDATE,RDATE
+2 SET IEN=0
+3 SET CNT=0
+4 ;loop through clinic xref
FOR
SET IEN=$ORDER(^SC("AC","C",IEN))
if IEN<1
QUIT
Begin DoDot:1
+5 ;inactivate date
SET IDATE=$PIECE($GET(^SC(IEN,"I")),"^",1)
+6 ;reactivate date
SET RDATE=$PIECE($GET(^SC(IEN,"I")),"^",2)
+7 IF (IDATE="")!(IDATE'<DT)!((IDATE<DT)&(RDATE>IDATE))
Begin DoDot:2
End DoDot:2
+8 SET CNT=CNT+1
+9 SET NAME=$PIECE(^SC(IEN,0),"^",1)
+10 DO ADD^VBECLU("<lineitem number='"_CNT_"' id='"_IEN_"' name='"_$$CHARCHK^XOBVLIB(NAME)_"'></lineitem>")
End DoDot:1
+11 ;FOR S NAME=$O(^SC("B",NAME)) Q:NAME="" DO
+12 ;. S IEN=0
+13 ;. FOR S IEN=$O(^SC("B",NAME,IEN)) Q:IEN<1 DO
+14 ;.. IF $P($G(^SC(IEN,0)),"^",3)=CHKVAL DO ;is a clinic
+15 ;... S IDATE=$P($G(^SC(IEN,"I")),"^",1) ;inactivate date
+16 ;... S RDATE=$P($G(^SC(IEN,"I")),"^",2) ;reactivate date
+17 ;... IF (IDATE="")!(IDATE'<DT)!((IDATE<DT)&(RDATE>IDATE)) DO
+18 ;.... SET CNT=CNT+1
+19 ;.... DO ADD^VBECLU("<lineitem number='"_CNT_"' id='"_IEN_"' name='"_$$CHARCHK^XOBVLIB(NAME)_"'></lineitem>")
+20 QUIT
+21 ;
WLIST(ITEM) ;
+1 NEW NAME,IEN
+2 SET NAME=""
+3 SET CNT=0
+4 FOR
SET NAME=$ORDER(^DIC(42,"B",NAME))
if NAME=""
QUIT
Begin DoDot:1
+5 SET IEN=0
+6 FOR
SET IEN=$ORDER(^DIC(42,"B",NAME,IEN))
if IEN<1
QUIT
Begin DoDot:2
+7 SET CNT=CNT+1
+8 DO ADD^VBECLU("<lineitem number='"_CNT_"' id='"_IEN_"' name='"_$$CHARCHK^XOBVLIB(NAME)_"'></lineitem>")
End DoDot:2
End DoDot:1
+9 QUIT
+10 ; -- get list of providers for patient lookup by provider
+11 ; from ORQPTQ2
PLIST(ITEM) ;
+1 NEW NAME,IEN
+2 SET (NAME,IEN)=""
+3 SET CNT=0
+4 KILL ^TMP($JOB,"PLU-F")
+5 FOR
SET IEN=$ORDER(^XUSEC("PROVIDER",IEN))
if IEN<1
QUIT
IF $$ACTIVE^XUSER(IEN)
Begin DoDot:1
+6 SET ^TMP($JOB,"PLU-F",$PIECE(^VA(200,IEN,0),"^",1),IEN)=""
End DoDot:1
+7 SET NAME=""
+8 FOR
SET NAME=$ORDER(^TMP($JOB,"PLU-F",NAME))
if NAME=""
QUIT
Begin DoDot:1
+9 SET IEN=0
FOR
SET IEN=$ORDER(^TMP($JOB,"PLU-F",NAME,IEN))
if IEN<1
QUIT
Begin DoDot:2
+10 SET CNT=CNT+1
+11 DO ADD^VBECLU("<lineitem number='"_CNT_"' id='"_IEN_"' name='"_$$CHARCHK^XOBVLIB(NAME)_"'></lineitem>")
End DoDot:2
WRITE IEN
End DoDot:1
+12 ;
+13 ;FOR S NAME=$O(^VA(200,"B",NAME)) Q:NAME="" DO
+14 ;. S IEN=0
+15 ;. FOR S IEN=$O(^VA(200,"B",NAME,IEN)) Q:IEN<1 DO
+16 ;.. I $D(^XUSEC("PROVIDER",IEN)),$$ACTIVE^XUSER(IEN) DO
+17 ;... SET CNT=CNT+1
+18 ;... DO ADD^VBECLU("<lineitem number='"_CNT_"' id='"_IEN_"' name='"_$$CHARCHK^XOBVLIB(NAME)_"'></lineitem>")
+19 QUIT
+20 ;
TEST ;
+1 NEW X,START,FINISH
+2 DO TESTC
+3 DO TESTP
+4 DO TESTW
+5 QUIT
+6 ;
TESTW ;
+1 SET START=$HOROLOG
+2 WRITE !,"WARD LIST"
+3 SET X("TYPE")="wARd"
+4 DO GETLIST(.RESULT,.X)
+5 SET FINISH=$HOROLOG
+6 DO DISPLAY(.RESULT)
+7 WRITE !,"Elapse Time: ",$PIECE(FINISH,",",2)-$PIECE(START,",",2)
+8 KILL RESULT
+9 QUIT
+10 ;
TESTC ;
+1 SET START=$HOROLOG
WRITE !,"CLINIC LIST"
+2 SET X("TYPE")="ClinIC"
+3 DO GETLIST(.RESULT,.X)
+4 SET FINISH=$HOROLOG
+5 DO DISPLAY(.RESULT)
+6 WRITE !,"Elapse Time: ",$PIECE(FINISH,",",2)-$PIECE(START,",",2)
+7 KILL RESULT
+8 QUIT
+9 ;
TESTP ;
+1 SET START=$HOROLOG
WRITE !,"PROVIDER LIST"
+2 SET X("TYPE")="pROvIdER"
+3 DO GETLIST(.RESULT,.X)
+4 SET FINISH=$HOROLOG
+5 DO DISPLAY(.RESULT)
+6 WRITE !,"Elapse Time: ",$PIECE(FINISH,",",2)-$PIECE(START,",",2)
+7 QUIT
DISPLAY(RESULT) ;
+1 NEW I
+2 SET I=-1
FOR
SET I=$ORDER(@RESULT@(I))
if I<1
QUIT
WRITE !!,@RESULT@(I)
+3 QUIT
