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

DGRRLU3.m

Go to the documentation of this file.
  1. DGRRLU3 ;alb/aas - DG Replacement and Rehosting RPC for VADPT ;8/8/05 15:38
  1. ;;5.3;Registration;**538,1015**;Aug 13, 1993;Build 21
  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. ; Input: PARAM("TYPE")="ward" returns a list of wards
  1. ; PARAM("TYPE")="clinic" returns a list of clinics
  1. ; PARAM("TYPE")="provider" returns a list of providers
  1. ; PARAM("TYPE")="specialty" returns a list of specialties
  1. ; PARAM("VALUE")= Beginning lookup value or null to start
  1. ; at the beginning or end of the file.
  1. ; PARAM("MAXNUM")= Number of records to be returned. If a
  1. ; negative number, traverse backwards.
  1. ;
  1. NEW X,CNT,DGRRLINE,DGRRESLT,OKAY
  1. SET (CNT,OKAY)=0
  1. IF '$D(DT) D DT^DICRW
  1. ;
  1. SET DGRRLINE=0
  1. K ^TMP($J,"PLU-FILTER")
  1. SET DGRRESLT="^TMP($J,""PLU-FILTER"")"
  1. SET RESULT=$NA(@DGRRESLT)
  1. ;
  1. DO ADD^DGRRUTL($$XMLHDR^DGRRUTL)
  1. ;
  1. IF $$UP^XLFSTR($G(PARAM("TYPE")))="WARD" S OKAY=1 D
  1. . D ADD^DGRRUTL("<filterlist type='ward'>")
  1. . D WLIST("ward",$G(PARAM("VALUE")),$G(PARAM("MAXNUM")))
  1. . D ADD^DGRRUTL("</filterlist>")
  1. ;
  1. IF $$UP^XLFSTR($G(PARAM("TYPE")))="CLINIC" S OKAY=2 D
  1. . D ADD^DGRRUTL("<filterlist type='clinic'>")
  1. . D CLIST("clinic","C",$G(PARAM("VALUE")),$G(PARAM("MAXNUM")))
  1. . D ADD^DGRRUTL("</filterlist>")
  1. ;
  1. IF $$UP^XLFSTR($G(PARAM("TYPE")))="PROVIDER" S OKAY=3 D
  1. . D ADD^DGRRUTL("<filterlist type='provider'>")
  1. . D PLIST("provider",$G(PARAM("VALUE")),$G(PARAM("MAXNUM")))
  1. . D ADD^DGRRUTL("</filterlist>")
  1. ;
  1. IF $$UP^XLFSTR($G(PARAM("TYPE")))="SPECIALTY" S OKAY=4 D
  1. . D ADD^DGRRUTL("<filterlist type='specialty'>")
  1. . D SLIST("specialty",$G(PARAM("VALUE")),$G(PARAM("MAXNUM")))
  1. . D ADD^DGRRUTL("</filterlist>")
  1. ;
  1. IF OKAY<1 D
  1. . D ADD^DGRRUTL("<unspecified>")
  1. . D ADD^DGRRUTL("<error message='List type not supported or not specified!'>")
  1. . D ADD^DGRRUTL("</unspecified>")
  1. ;
  1. QUIT
  1. ;
  1. ; -- get list of clinics for patient lookup by clinic
  1. CLIST(ITEM,CHKVAL,VALUE,MAXNUM) ;
  1. NEW NAME,IEN,IDATE,RDATE,DIR,CNT2,DGRRB,FLAG
  1. S VALUE=$$UP^XLFSTR($G(VALUE))
  1. S NAME=$G(VALUE)
  1. S MAXNUM=$G(MAXNUM)
  1. S DGRRB=0
  1. K ^TMP("DGRRLU3-CLIST",$J)
  1. I $E(MAXNUM)="-" D
  1. . S DGRRB=1 ; ****
  1. .I MAXNUM="-" S MAXNUM="" Q ; ****
  1. .S MAXNUM=$$ABS^XLFMTH(MAXNUM)
  1. S (FLAG,CNT)=0
  1. I $L(NAME)>0,DGRRB=0,$D(^SC("B",NAME)) S NAME=$O(^SC("B",NAME),-1) ; ****
  1. I $L(NAME)>0,DGRRB=1,$D(^SC("B",NAME)) S NAME=$O(^SC("B",NAME)) ; ****
  1. I 'DGRRB D
  1. . S DIR=1
  1. .FOR S NAME=$O(^SC("B",NAME)) Q:NAME="" DO Q:FLAG=1
  1. .. S IEN=0
  1. .. FOR S IEN=$O(^SC("B",NAME,IEN)) Q:IEN<1 DO Q:FLAG=1
  1. ...N STATUS
  1. ...S STATUS=$$STATUS(IEN,CHKVAL)
  1. ...I STATUS=1 D
  1. ....S CNT=CNT+1 I MAXNUM,CNT>MAXNUM S FLAG=1 Q ; ****
  1. .... ;DO ADD^DGRRUTL("<lineitem number='"_CNT_"' id='"_IEN_"' name='"_$$CHARCHK^DGRRUTL(NAME)_"'></lineitem>")
  1. .... S ^TMP("DGRRLU3-CLIST",$J,CNT)=IEN_U_NAME
  1. I DGRRB D
  1. . S DIR=-1
  1. .FOR S NAME=$O(^SC("B",NAME),-1) Q:NAME="" DO Q:FLAG=1
  1. .. S IEN=0
  1. .. FOR S IEN=$O(^SC("B",NAME,IEN)) Q:IEN<1 DO Q:FLAG=1
  1. ...N STATUS
  1. ...S STATUS=$$STATUS(IEN,CHKVAL)
  1. ...I STATUS=1 D
  1. ....S CNT=CNT+1 I MAXNUM,CNT>MAXNUM S FLAG=1 Q ; ****
  1. .... ; DO ADD^DGRRUTL("<lineitem number='"_CNT_"' id='"_IEN_"' name='"_$$CHARCHK^DGRRUTL(NAME)_"'></lineitem>")
  1. .... S ^TMP("DGRRLU3-CLIST",$J,CNT)=IEN_U_NAME
  1. S CNT2="",CNT=0
  1. F S CNT2=$O(^TMP("DGRRLU3-CLIST",$J,CNT2),DIR) Q:CNT2="" D
  1. . S IEN=+^TMP("DGRRLU3-CLIST",$J,CNT2)
  1. . S NAME=$P(^TMP("DGRRLU3-CLIST",$J,CNT2),U,2)
  1. . S CNT=CNT+1
  1. . DO ADD^DGRRUTL("<lineitem number='"_CNT_"' id='"_IEN_"' name='"_$$CHARCHK^DGRRUTL(NAME)_"'></lineitem>")
  1. QUIT
  1. STATUS(IEN,CHKVAL) ;
  1. N IDATE,RDATE,STATUS
  1. S STATUS=0
  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)) S STATUS=1
  1. Q STATUS
  1. ;
  1. WLIST(ITEM,VALUE,MAXNUM) ;
  1. ; Input: VALUE - Beginning value or null to start at the beginning
  1. ; or end of the file.
  1. ; MAXNUM - Number of entries to be returned. Defaults to
  1. ; traversing forward but if MAXNUM is a negative
  1. ; number, traverses through the file backwards.
  1. N FLAG,ERROR,CNT,DGRRB,BACKMTCH,CNT2
  1. S CNT=0
  1. ;I VALUE is null and MAXNUM is set to "-" or null, all wards returned
  1. S VALUE=$$UP^XLFSTR($G(VALUE))
  1. S MAXNUM=$G(MAXNUM)
  1. S FLAG=""
  1. I $E(MAXNUM)="-" D
  1. .;Set direction for traversing file to backwards and remove - from
  1. .;maximum number of records returned.
  1. .S FLAG="B"
  1. .I MAXNUM="-" S MAXNUM="" Q
  1. .S MAXNUM=$$ABS^XLFMTH(MAXNUM)
  1. ;Look for exact match
  1. K ^TMP("DILIST",$J)
  1. I ($G(VALUE)'="") D EXMTCH
  1. ;Call File Manager for remaining matches
  1. ; K ^TMP("DILIST",$J)
  1. I MAXNUM'=0 D LIST^DIC(42,,.01,$G(FLAG),MAXNUM,VALUE,,"B",,,,"ERROR")
  1. Q:$D(ERROR)
  1. N DGRRI
  1. S DGRRI=""
  1. I $G(BACKMTCH) D
  1. . S ^TMP("DILIST",$J,2,"ZZ")=+BACKMTCH
  1. . S ^TMP("DILIST",$J,1,"ZZ")=$P(BACKMTCH,U,2)
  1. S DGRRB=1 ; I FLAG="B" S DGRRB=-1
  1. F S DGRRI=$O(^TMP("DILIST",$J,1,DGRRI),DGRRB) Q:DGRRI="" D
  1. .N IEN,NAME
  1. .S CNT=CNT+1
  1. .S NAME=$G(^TMP("DILIST",$J,1,DGRRI))
  1. .S IEN=$G(^TMP("DILIST",$J,2,DGRRI))
  1. .DO ADD^DGRRUTL("<lineitem number='"_CNT_"' id='"_IEN_"' name='"_$$CHARCHK^DGRRUTL(NAME)_"'></lineitem>")
  1. ; I FLAG="B",($G(VALUE)'="") D EXMTCH
  1. Q
  1. EXMTCH ;Look for exact match
  1. I $D(^DIC(42,"B",VALUE)) D
  1. .N IEN
  1. .S IEN=0
  1. .F S IEN=$O(^DIC(42,"B",VALUE,IEN)) Q:IEN="" D
  1. ..N NAME
  1. ..S NAME=$P($G(^DIC(42,+IEN,0)),U)
  1. .. ; S CNT=CNT+1
  1. .. I MAXNUM'="" S MAXNUM=MAXNUM-1
  1. .. I FLAG'="B" S CNT=CNT+1 DO ADD^DGRRUTL("<lineitem number='"_CNT_"' id='"_IEN_"' name='"_$$CHARCHK^DGRRUTL(NAME)_"'></lineitem>")
  1. .. I FLAG="B" S BACKMTCH=IEN_U_NAME
  1. Q
  1. ; -- get list of providers for patient lookup by provider
  1. ; from ORQPTQ2
  1. PLIST(ITEM,VALUE,MAXNUM) ;
  1. NEW NAME,IEN,DGRRB,FLAG,CNT2,DGRRSCR,DGRRFMT
  1. S VALUE=$$UP^XLFSTR($G(VALUE))
  1. S NAME=$G(VALUE)
  1. S MAXNUM=$G(MAXNUM)
  1. S DGRRB=1
  1. ;K ^TMP("DGRRLU3-PLIST",$J)
  1. K ^TMP("DILIST",$J)
  1. I $E(MAXNUM)="-" D
  1. . S DGRRB=-1 ; *****
  1. . I MAXNUM="-" S MAXNUM="" Q ; *****
  1. .S MAXNUM=$$ABS^XLFMTH(MAXNUM)
  1. S (FLAG,CNT)=0
  1. ;I $L(NAME)>0,DGRRB=1,$D(^VA(200,"B",NAME)) S NAME=$O(^VA(200,"B",NAME),-1)
  1. ;I $L(NAME)>0,DGRRB=-1,$D(^VA(200,"B",NAME)) S NAME=$O(^VA(200,"B",NAME))
  1. ;FOR S NAME=$O(^VA(200,"B",NAME),DGRRB) Q:NAME="" DO Q:FLAG=1
  1. ;. S IEN=0
  1. ;. FOR S IEN=$O(^VA(200,"B",NAME,IEN)) Q:IEN<1 DO Q:FLAG=1
  1. ;.. I $D(^XUSEC("PROVIDER",IEN)),$$ACTIVE^XUSER(IEN) DO
  1. ;... SET CNT=CNT+1
  1. ;... S ^TMP("DGRRLU3-PLIST",$J,CNT)=IEN_U_NAME
  1. ;... I MAXNUM,CNT>(MAXNUM-1) S FLAG=1
  1. ;S CNT2="",CNT=0
  1. ;F S CNT2=$O(^TMP("DGRRLU3-PLIST",$J,CNT2),DGRRB) Q:CNT2="" D
  1. ;. S IEN=+^TMP("DGRRLU3-PLIST",$J,CNT2)
  1. ;. S NAME=$P(^TMP("DGRRLU3-PLIST",$J,CNT2),U,2)
  1. ;. S CNT=CNT+1
  1. ;. DO ADD^DGRRUTL("<lineitem number='"_CNT_"' id='"_IEN_"' name='"_$$CHARCHK^DGRRUTL(NAME)_"'></lineitem>")
  1. I $L(NAME)>0,DGRRB=1,$D(^VA(200,"AK.PROVIDER",NAME)) S NAME=$O(^VA(200,"AK.PROVIDER",NAME),-1)
  1. I $L(NAME)>0,DGRRB=-1,$D(^VA(200,"AK.PROVIDER",NAME)) S NAME=$O(^VA(200,"AK.PROVIDER",NAME))
  1. S DGRRSCR="I $$ACTIVE^XUSER(+Y)"
  1. S DGRRFMT="P"_$S(DGRRB=-1:"B",1:"")
  1. D LIST^DIC(200,,"@;.01",DGRRFMT,MAXNUM,NAME,,"AK.PROVIDER",DGRRSCR)
  1. S (CNT2,CNT)=0
  1. F S CNT2=$O(^TMP("DILIST",$J,CNT2)) Q:CNT2="" D
  1. . S IEN=+$G(^TMP("DILIST",$J,CNT2,0))
  1. . S NAME=$P($G(^TMP("DILIST",$J,CNT2,0)),U,2)
  1. . S CNT=CNT+1
  1. . DO ADD^DGRRUTL("<lineitem number='"_CNT_"' id='"_IEN_"' name='"_$$CHARCHK^DGRRUTL(NAME)_"'></lineitem>")
  1. K ^TMP("DILIST",$J)
  1. D CLEAN^DILF
  1. QUIT
  1. ;
  1. SLIST(ITEM,VALUE,MAXNUM) ;Returns active specialties in Facility TreatingSpecialty (#45.7) file
  1. ;
  1. N NAME,IEN,CNT,FLAG,DGRRB,DGRRD,CNT2
  1. S NAME=$$UP^XLFSTR($G(VALUE))
  1. ; S NAME=$G(VALUE)
  1. S (FLAG,IEN,CNT)=0
  1. S MAXNUM=$G(MAXNUM)
  1. S DGRRB=1
  1. K ^TMP("DGRRLU3-SLIST",$J)
  1. I $E(MAXNUM)="-" D
  1. .S DGRRB=-1
  1. .S MAXNUM=$$ABS^XLFMTH(MAXNUM)
  1. ;Capture exact matches
  1. I $L(NAME),$D(^DIC(45.7,"B",NAME)) D
  1. .N DGRRD
  1. .S DGRRD=$S(DGRRB=1:-1,1:1)
  1. .S NAME=$O(^DIC(45.7,"B",NAME),DGRRD)
  1. F S NAME=$O(^DIC(45.7,"B",NAME),DGRRB) Q:NAME="" D Q:FLAG=1
  1. .F S IEN=$O(^DIC(45.7,"B",NAME,IEN)) Q:IEN'>0 D Q:FLAG=1
  1. ..I $$ACTIVE^DGACT(45.7,IEN) D
  1. ...S CNT=CNT+1
  1. ...I MAXNUM,(CNT>MAXNUM) S FLAG=1 Q
  1. ...; DO ADD^DGRRUTL("<lineitem number='"_CNT_"' id='"_IEN_"' name='"_$$CHARCHK^DGRRUTL(NAME)_"'></lineitem>")
  1. ...S ^TMP("DGRRLU3-SLIST",$J,CNT)=IEN_U_NAME
  1. S CNT=1,CNT2=""
  1. S DGRRD=$S(DGRRB=1:1,1:-1)
  1. F S CNT2=$O(^TMP("DGRRLU3-SLIST",$J,CNT2),DGRRD) Q:CNT2="" D
  1. . S IEN=+^TMP("DGRRLU3-SLIST",$J,CNT2)
  1. . S NAME=$P(^TMP("DGRRLU3-SLIST",$J,CNT2),U,2)
  1. . DO ADD^DGRRUTL("<lineitem number='"_CNT_"' id='"_IEN_"' name='"_$$CHARCHK^DGRRUTL(NAME)_"'></lineitem>")
  1. . S CNT=CNT+1
  1. Q
  1. ;
  1. DISPLAY(RESULT) ;
  1. NEW I
  1. S I=-1 FOR SET I=$O(@RESULT@(I)) Q:I<1 W !!,@RESULT@(I)
  1. QUIT