- 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 Feb 19, 2025@00:10:50 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