Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: VBECLU3

VBECLU3.m

Go to the documentation of this file.
  1. VBECLU3 ;HIOFO/BNT - VBECS Patient Lookup Utility ;04/13/2005 09:00
  1. ;;2.0;VBEC;;Jun 05, 2015;Build 4
  1. ;
  1. ; Note: This routine supports data exchange with an FDA registered
  1. ; medical device. As such, it may not be changed in any way without
  1. ; prior written approval from the medical device manufacturer.
  1. ;
  1. ; Integration Agreements:
  1. ;
  1. QUIT
  1. ; -- Get list of wards or clinics for patient lookup by ward
  1. ;
  1. ; -- Does not currently limit display by division, institution, etc. May need to.
  1. ;
  1. GETLIST(RESULT,PARAM) ;
  1. NEW X,CNT,VBECLINE,VBECESLT,OKAY
  1. SET (CNT,OKAY)=0
  1. IF '$D(DT) D DT^DICRW
  1. ;
  1. SET VBECLINE=0
  1. K ^TMP($J,"PLU-FILTER")
  1. SET VBECRSLT="^TMP($J,""PLU-FILTER"")"
  1. SET RESULT=$NA(@VBECRSLT)
  1. ;
  1. DO ADD^VBECLU($$XMLHDR^XOBVLIB)
  1. ;
  1. IF $$UP^XLFSTR(PARAM("TYPE"))="WARD" S OKAY=1 D
  1. . D ADD^VBECLU("<filterlist type='ward'>")
  1. . D WLIST("ward")
  1. . D ADD^VBECLU("</filterlist>")
  1. ;
  1. IF $$UP^XLFSTR(PARAM("TYPE"))="CLINIC" S OKAY=2 D
  1. . D ADD^VBECLU("<filterlist type='clinic'>")
  1. . D CLIST("clinic","C")
  1. . D ADD^VBECLU("</filterlist>")
  1. ;
  1. IF $$UP^XLFSTR(PARAM("TYPE"))="PROVIDER" S OKAY=3 D
  1. . D ADD^VBECLU("<filterlist type='provider'>")
  1. . D PLIST("provider")
  1. . D ADD^VBECLU("</filterlist>")
  1. ;
  1. IF OKAY<1 D
  1. . D ADD^VBECLU("<unspecified>")
  1. . D ADD^VBECLU("<error message='List type not supported or not specified!'>")
  1. . D ADD^VBECLU("</unspecified>")
  1. ;
  1. QUIT
  1. ;
  1. ; -- get list of clinics for patient lookup by clinic
  1. CLIST(ITEM,CHKVAL) ;
  1. NEW NAME,IEN,IDATE,RDATE
  1. SET IEN=0
  1. SET CNT=0
  1. FOR S IEN=$O(^SC("AC","C",IEN)) Q:IEN<1 DO ;loop through clinic xref
  1. . S IDATE=$P($G(^SC(IEN,"I")),"^",1) ;inactivate date
  1. . S RDATE=$P($G(^SC(IEN,"I")),"^",2) ;reactivate date
  1. . IF (IDATE="")!(IDATE'<DT)!((IDATE<DT)&(RDATE>IDATE)) DO
  1. . SET CNT=CNT+1
  1. . SET NAME=$P(^SC(IEN,0),"^",1)
  1. . DO ADD^VBECLU("<lineitem number='"_CNT_"' id='"_IEN_"' name='"_$$CHARCHK^XOBVLIB(NAME)_"'></lineitem>")
  1. ;FOR S NAME=$O(^SC("B",NAME)) Q:NAME="" DO
  1. ;. S IEN=0
  1. ;. FOR S IEN=$O(^SC("B",NAME,IEN)) Q:IEN<1 DO
  1. ;.. IF $P($G(^SC(IEN,0)),"^",3)=CHKVAL DO ;is a clinic
  1. ;... S IDATE=$P($G(^SC(IEN,"I")),"^",1) ;inactivate date
  1. ;... S RDATE=$P($G(^SC(IEN,"I")),"^",2) ;reactivate date
  1. ;... IF (IDATE="")!(IDATE'<DT)!((IDATE<DT)&(RDATE>IDATE)) DO
  1. ;.... SET CNT=CNT+1
  1. ;.... DO ADD^VBECLU("<lineitem number='"_CNT_"' id='"_IEN_"' name='"_$$CHARCHK^XOBVLIB(NAME)_"'></lineitem>")
  1. QUIT
  1. ;
  1. WLIST(ITEM) ;
  1. NEW NAME,IEN
  1. SET NAME=""
  1. SET CNT=0
  1. FOR S NAME=$O(^DIC(42,"B",NAME)) Q:NAME="" DO
  1. . S IEN=0
  1. . FOR S IEN=$O(^DIC(42,"B",NAME,IEN)) Q:IEN<1 DO
  1. .. SET CNT=CNT+1
  1. .. DO ADD^VBECLU("<lineitem number='"_CNT_"' id='"_IEN_"' name='"_$$CHARCHK^XOBVLIB(NAME)_"'></lineitem>")
  1. QUIT
  1. ; -- get list of providers for patient lookup by provider
  1. ; from ORQPTQ2
  1. PLIST(ITEM) ;
  1. NEW NAME,IEN
  1. SET (NAME,IEN)=""
  1. SET CNT=0
  1. K ^TMP($J,"PLU-F")
  1. FOR S IEN=$O(^XUSEC("PROVIDER",IEN)) Q:IEN<1 I $$ACTIVE^XUSER(IEN) DO
  1. . SET ^TMP($J,"PLU-F",$P(^VA(200,IEN,0),"^",1),IEN)=""
  1. SET NAME=""
  1. F S NAME=$O(^TMP($J,"PLU-F",NAME)) Q:NAME="" DO
  1. . SET IEN=0 F S IEN=$O(^TMP($J,"PLU-F",NAME,IEN)) Q:IEN<1 DO W IEN
  1. .. SET CNT=CNT+1
  1. .. DO ADD^VBECLU("<lineitem number='"_CNT_"' id='"_IEN_"' name='"_$$CHARCHK^XOBVLIB(NAME)_"'></lineitem>")
  1. ;
  1. ;FOR S NAME=$O(^VA(200,"B",NAME)) Q:NAME="" DO
  1. ;. S IEN=0
  1. ;. FOR S IEN=$O(^VA(200,"B",NAME,IEN)) Q:IEN<1 DO
  1. ;.. I $D(^XUSEC("PROVIDER",IEN)),$$ACTIVE^XUSER(IEN) DO
  1. ;... SET CNT=CNT+1
  1. ;... DO ADD^VBECLU("<lineitem number='"_CNT_"' id='"_IEN_"' name='"_$$CHARCHK^XOBVLIB(NAME)_"'></lineitem>")
  1. QUIT
  1. ;
  1. TEST ;
  1. NEW X,START,FINISH
  1. DO TESTC
  1. DO TESTP
  1. DO TESTW
  1. QUIT
  1. ;
  1. TESTW ;
  1. S START=$H
  1. W !,"WARD LIST"
  1. S X("TYPE")="wARd"
  1. D GETLIST(.RESULT,.X)
  1. S FINISH=$H
  1. D DISPLAY(.RESULT)
  1. W !,"Elapse Time: ",$P(FINISH,",",2)-$P(START,",",2)
  1. K RESULT
  1. QUIT
  1. ;
  1. TESTC ;
  1. S START=$H W !,"CLINIC LIST"
  1. S X("TYPE")="ClinIC"
  1. D GETLIST(.RESULT,.X)
  1. S FINISH=$H
  1. D DISPLAY(.RESULT)
  1. W !,"Elapse Time: ",$P(FINISH,",",2)-$P(START,",",2)
  1. K RESULT
  1. QUIT
  1. ;
  1. TESTP ;
  1. S START=$H W !,"PROVIDER LIST"
  1. S X("TYPE")="pROvIdER"
  1. D GETLIST(.RESULT,.X)
  1. S FINISH=$H
  1. D DISPLAY(.RESULT)
  1. W !,"Elapse Time: ",$P(FINISH,",",2)-$P(START,",",2)
  1. Q
  1. DISPLAY(RESULT) ;
  1. NEW I
  1. S I=-1 FOR SET I=$O(@RESULT@(I)) Q:I<1 W !!,@RESULT@(I)
  1. QUIT