DGRRLU ;alb/aas - DG Replacement and Rehosting RPC for VADPT ;12/22/05 14:53
;;5.3;Registration;**538,1015**;Aug 13, 1993;Build 21
;
SET X="You Can't Enter DGRRLU at top of routine!"
QUIT
;
SEARCH(RESULT,PARAMS) ; -- return patient data in XML format
; -- RPC: DGRR PATIENT LOOKUP SEARCH
;
; -- input PARAMS ARRAY
; PARAMS("SEARCH_TYPE") = "NAME","SSN","ICN","SSN4","DFN", "PRVLUP"
; PARAMS("SEARCH_VALUE") = value to search for.
; PARAMS("JOB") = a unique job # used to check for cancelled jobs
;
NEW I,X,Y,DGRRAPTS,DGRRIENS,DGRRPCNT,DGRRLINE,DGRRLIST,DGRRESLT,SEARCH,VALUE,FILTER,FILTERV,BDATE,EDATE,CODE,CANCEL,JOB ; ****
NEW MAXSIZE,MAXSIZRE,LINENO,DELIM,DOMAIN,RESTRICT,ERRMSG,SITENM,SITENO,PRODSTAT,DGERR
; NEW MSCREEN ; references to MSCREEN removed by sgg 05/06/04 advised by babul no longer required
IF '$D(DT) D DT^DICRW
KILL RESULT
SET DGRRPCNT=0
SET DGRRLINE=0
K ^TMP($J,"PLU-SEARCH")
SET DGRRESLT="^TMP($J,""PLU-SEARCH"")"
SET RESULT=$NA(@DGRRESLT)
DO ADD($$XMLHDR^DGRRUTL)
;
SET CANCEL=0 ; ****
SET SEARCH=$$UP^XLFSTR($GET(PARAMS("SEARCH_TYPE")))
SET VALUE=$$UP^XLFSTR($GET(PARAMS("SEARCH_VALUE")))
SET MAXSIZE=+$GET(PARAMS("MAX_PATIENTS"),50),MAXSIZRE=0
;
IF (MAXSIZE<5) SET MAXSIZE=5
IF (MAXSIZE>100) SET MAXSIZE=100
;
SET FILTER=$$UP^XLFSTR($GET(PARAMS("FILTER_TYPE")))
SET FILTERV=$G(PARAMS("FILTER_VALUE"))
SET BDATE=$G(PARAMS("CLINIC_STARTDATE"))
SET EDATE=$G(PARAMS("CLINIC_ENDDATE"))
SET JOB=$G(PARAMS("JOB")) ; ****
I JOB="" S JOB=0 ; **** Until Job parameter is used
;SET MSCREEN=$$UP^XLFSTR($G(PARAMS("MSCREEN")))
;IF MSCREEN'="" DO
;. SET X=MSCREEN D ^DIM IF $D(X)=0 SET MSCREEN="" SET ERRMSG="MSCREEN is invalid M code" Q
;. IF $E(MSCREEN)'="I" SET MSCREEN="" SET ERRMSG="MSCREEN Deleted, must start with an If statement." Q
;. IF MSCREEN[" S "!(MSCREEN[" SET ")!(MSCREEN[" S:")!(MSCREEN["SET:") SET MSCREEN="" SET ERRMSG="MSCREEN Deleted, can not set values." Q
;. IF MSCREEN[" K "!(MSCREEN[" KILL ")!(MSCREEN[" K:")!(MSCREEN["SET:") SET MSCREEN="" SET ERRMSG="MSCREEN Deleted, can not kill values." Q
;. IF MSCREEN[" W "!(MSCREEN[" WRITE ")!(MSCREEN[" W:")!(MSCREEN["WRITE:") SET MSCREEN="" SET ERRMSG="MSCREEN Deleted, can not WRITE." Q
SET DELIM=$G(PARAMS("DELIMITER"),",") ; Defaults to comma to support old way.
;
SET SITENM=$$CHARCHK^DGRRUTL($$SITENAM^DGRRUTL())
SET SITENO=$$CHARCHK^DGRRUTL($$SITENO^DGRRUTL())
SET X=$$PRODST1^DGRRUTL()
SET Y=$$PRODST2^DGRRUTL()
SET PRODSTAT=$$CHARCHK^DGRRUTL(X+Y)
SET DOMAIN=$$CHARCHK^DGRRUTL($$KSP^XUPARAM("WHERE"))
;SET RESTRICT=$G(^VA(200,+$G(DUZ),101))
S DGRRIENS=$$IENS^DILF(+$G(DUZ))
D GETS^DIQ(200,DGRRIENS,"101.01;101.02","I","DGRRLIST")
S RESTRICT=$G(DGRRLIST(200,DGRRIENS,101.01,"I"))_U_$G(DGRRLIST(200,DGRRIENS,101.02,"I"))
IF +RESTRICT S CODE="I $D(^OR(100.21,"_$P(RESTRICT,"^",2)_",10,""B"",+$G(DFN)_"";DPT(""))"
;.IF MSCREEN'="" S MSCREEN=" "_CODE Q
;.IF MSCREEN="" S MSCREEN=CODE
IF (FILTER'=""),(FILTERV'="") DO BYFILTER^DGRRLU0(FILTER,FILTERV,BDATE,EDATE,SEARCH,VALUE,DELIM) GOTO DONE1
IF (SEARCH="PRVLUP") DO PRVLUP^DGRRLU5(.RESULT,.PARAMS) GOTO DONE1
IF (SEARCH="NAME"),($G(PARAMS("VERSION 1"))="") DO BYNAME^DGRRLU6 GOTO DONE1 ; v2 sgg 05/06/04
DO ADD("<record count='0'>")
SET LINENO=DGRRLINE
IF SEARCH="DFN" D Q:$G(DGERR)=1
.D DFNLST(VALUE)
.I $G(DGERR)=1 D DONE1
IF (SEARCH="NAME")!(SEARCH="SSN")!(SEARCH="ICN")!(SEARCH="SSN4") D BYNAME I $G(DGERR)=1 G DONE1 ; ****
IF ("|NAME|SSN|ICN|SSN4|DFN|PRVLUP|"'[SEARCH)!(SEARCH="") DO GOTO DONE1 ; *****
. DO ADD("<error message='Searching for patients by "_$S(SEARCH="":"Empty String",1:SEARCH)_" not yet implemented!'></error>") ; ****
;
D DONE
IF CANCEL=1 DO CLEAN^DILF ; ****
QUIT
;
BYNAME ;
NEW FULLCNT,DGRR,NODE,DFN,XREF,DIERR
;; copied From scutbk11
;; DO FIND^DIC(2,,".01;.03;.363;.09","PS",VALUE,300,"B^BS^BS5^SSN")
;
IF VALUE="" DO Q
. DO ADD("<error message='Not Enough Information Provided to Search for Patients. Search Type = """_SEARCH_""" Search For = """_VALUE_"""'></error>")
. S DGERR=1
;
IF SEARCH="NAME" SET XREF="B^NOP" IF VALUE[", " DO
. SET VALUE=$P(VALUE,", ")_","_$P(VALUE,", ",2) ;REMOVE FIRST SPACE
IF SEARCH="SSN" SET XREF="SSN",VALUE=$TR(VALUE," -","") ; REMOVE DASHES AND SPACES
IF SEARCH="SSN4" SET XREF="BS5" DO
. IF $L(VALUE)>5 SET VALUE=$E(VALUE,1,5) ; can't exceed 5 characters, if P for psuedo on end take it off.
IF SEARCH="ICN" SET XREF="AICN" DO
. SET VALUE=$P(VALUE,"V",1)
IF $D(^XTMP("DGRRLU",JOB,1)) S CANCEL=1 Q ; *****
;DO FIND^DIC(2,,".01;.03;.09","PS",VALUE,300,XREF) ; replaced sgg 05/04/04
;DO FIND^DIC(2,,".01;.03;.09","PS",VALUE,MAXSIZE+3,XREF)
;IF $G(DIERR) DO Q
;. DO ADD("<error message='Error occurred in ""Mumps"" during patient lookup'></error>")
;. DO CLEAN^DILF
;. S DGERR=1
;SET FULLCNT=+$G(^TMP("DILIST",$J,0))
;DO ADD("<record count='0'>")
;SET LINENO=DGRRLINE
;
K ^TMP($J,"DGRRPTS")
N DGRRARRY,DGRRLST,DGRRI,DPTPSREF
S DGRRARRY="^TMP($J,""DGRRPTS"")"
; Set variable to cross references to be used by $$LIST^DPTLK1 call
S DPTPSREF=$TR(XREF,"^",",")
S DGRRLST=$$LIST^DPTLK1(VALUE,MAXSIZE,DGRRARRY)
S DGRRI=0
F S DGRRI=$O(^TMP($J,"DGRRPTS",DGRRI)) Q:'DGRRI D Q:$$STOP^XOBVLIB() Q:CANCEL=1
.N DGRRCA
.S NODE=$G(^TMP($J,"DGRRPTS",DGRRI))
.S DFN=$P(NODE,"^")
.I $P(NODE,"^",2)'=$P(NODE,"^",3) S DGRRCA=1_"^"_$P(NODE,"^",3)
.D PTDATA^DGRRLUA(+NODE,.DGRRPCNT)
.I $D(^XTMP("DGRRLU",JOB,1)) S CANCEL=1
;
;FOR DGRR=1:1:FULLCNT D Q:$$STOP^XOBVLIB() Q:CANCEL=1 ; ****
;. SET NODE=^TMP("DILIST",$J,DGRR,0)
;. SET DFN=$P(NODE,"^",1)
;. D PTDATA^DGRRLUA(+NODE,.DGRRPCNT)
;. IF $D(^XTMP("DGRRLU",JOB,1)) S CANCEL=1 ; *****
K ^TMP($J,"DGRRPTS")
Q
;
DONE IF CANCEL=1 Q ; *****
IF ($G(MAXSIZRE)<1) DO ADD("<maximum message=''></maximum>") ; sgg moved one line to maintain consistent order
DO ADD("<error message=''>"_$G(ERRMSG)_"</error>")
SET @DGRRESLT@(LINENO)="<record count='"_DGRRPCNT_"'>"
;
DONE1 D ADD("<institution name='"_SITENM_"' number='"_SITENO_"' productiondatabase='"_PRODSTAT_"' domain='"_DOMAIN_"' ></institution>")
IF (SEARCH="PRVLUP") DO ADD("</persons>")
;IF (SEARCH="NAME")!(SEARCH="SSN")!(SEARCH="ICN")!(SEARCH="SSN4") DO ADD("</record>")
IF (SEARCH'="PRVLUP") DO ADD("</record>")
QUIT
;
ADD(STR) ; -- add string to array
SET DGRRLINE=DGRRLINE+1
SET @DGRRESLT@(DGRRLINE)=STR
QUIT
;
CANCEL(RESULT,PARAM) ; Cancel a patient search ; ****
S JOB=$G(PARAM) ; ****
I JOB="" S RESULT=0 Q
N DGRRCDT
S DGRRCDT=$$FMADD^XLFDT(DT,2)
S ^XTMP("DGRRLU",JOB,0)=DGRRCDT_"^"_DT ; ****
S ^XTMP("DGRRLU",JOB,1)=JOB ; ****
S RESULT=1
Q ; ****
;
DFNLST(DGRRVAL) ;Loop through DFN list
;
N DGRRDFN,DGRRI
IF DGRRVAL="" DO Q
. DO ADD("<error message='Not Enough Information Provided to Search for Patients. Search Type = """_SEARCH_""" Search For = """_DGRRVAL_"""'></error>")
. S DGERR=1
F DGRRI=1:1 S DGRRDFN=$P(DGRRVAL,U,DGRRI) Q:DGRRDFN="" D
.I $D(^DPT(+DGRRDFN,0)) D
..D PTDATA^DGRRLUA(+DGRRDFN,.DGRRPCNT)
Q
;
DGRRLU ;alb/aas - DG Replacement and Rehosting RPC for VADPT ;12/22/05 14:53
+1 ;;5.3;Registration;**538,1015**;Aug 13, 1993;Build 21
+2 ;
+3 SET X="You Can't Enter DGRRLU at top of routine!"
+4 QUIT
+5 ;
SEARCH(RESULT,PARAMS) ; -- return patient data in XML format
+1 ; -- RPC: DGRR PATIENT LOOKUP SEARCH
+2 ;
+3 ; -- input PARAMS ARRAY
+4 ; PARAMS("SEARCH_TYPE") = "NAME","SSN","ICN","SSN4","DFN", "PRVLUP"
+5 ; PARAMS("SEARCH_VALUE") = value to search for.
+6 ; PARAMS("JOB") = a unique job # used to check for cancelled jobs
+7 ;
+8 ; ****
NEW I,X,Y,DGRRAPTS,DGRRIENS,DGRRPCNT,DGRRLINE,DGRRLIST,DGRRESLT,SEARCH,VALUE,FILTER,FILTERV,BDATE,EDATE,CODE,CANCEL,JOB
+9 NEW MAXSIZE,MAXSIZRE,LINENO,DELIM,DOMAIN,RESTRICT,ERRMSG,SITENM,SITENO,PRODSTAT,DGERR
+10 ; NEW MSCREEN ; references to MSCREEN removed by sgg 05/06/04 advised by babul no longer required
+11 IF '$DATA(DT)
DO DT^DICRW
+12 KILL RESULT
+13 SET DGRRPCNT=0
+14 SET DGRRLINE=0
+15 KILL ^TMP($JOB,"PLU-SEARCH")
+16 SET DGRRESLT="^TMP($J,""PLU-SEARCH"")"
+17 SET RESULT=$NAME(@DGRRESLT)
+18 DO ADD($$XMLHDR^DGRRUTL)
+19 ;
+20 ; ****
SET CANCEL=0
+21 SET SEARCH=$$UP^XLFSTR($GET(PARAMS("SEARCH_TYPE")))
+22 SET VALUE=$$UP^XLFSTR($GET(PARAMS("SEARCH_VALUE")))
+23 SET MAXSIZE=+$GET(PARAMS("MAX_PATIENTS"),50)
SET MAXSIZRE=0
+24 ;
+25 IF (MAXSIZE<5)
SET MAXSIZE=5
+26 IF (MAXSIZE>100)
SET MAXSIZE=100
+27 ;
+28 SET FILTER=$$UP^XLFSTR($GET(PARAMS("FILTER_TYPE")))
+29 SET FILTERV=$GET(PARAMS("FILTER_VALUE"))
+30 SET BDATE=$GET(PARAMS("CLINIC_STARTDATE"))
+31 SET EDATE=$GET(PARAMS("CLINIC_ENDDATE"))
+32 ; ****
SET JOB=$GET(PARAMS("JOB"))
+33 ; **** Until Job parameter is used
IF JOB=""
SET JOB=0
+34 ;SET MSCREEN=$$UP^XLFSTR($G(PARAMS("MSCREEN")))
+35 ;IF MSCREEN'="" DO
+36 ;. SET X=MSCREEN D ^DIM IF $D(X)=0 SET MSCREEN="" SET ERRMSG="MSCREEN is invalid M code" Q
+37 ;. IF $E(MSCREEN)'="I" SET MSCREEN="" SET ERRMSG="MSCREEN Deleted, must start with an If statement." Q
+38 ;. IF MSCREEN[" S "!(MSCREEN[" SET ")!(MSCREEN[" S:")!(MSCREEN["SET:") SET MSCREEN="" SET ERRMSG="MSCREEN Deleted, can not set values." Q
+39 ;. IF MSCREEN[" K "!(MSCREEN[" KILL ")!(MSCREEN[" K:")!(MSCREEN["SET:") SET MSCREEN="" SET ERRMSG="MSCREEN Deleted, can not kill values." Q
+40 ;. IF MSCREEN[" W "!(MSCREEN[" WRITE ")!(MSCREEN[" W:")!(MSCREEN["WRITE:") SET MSCREEN="" SET ERRMSG="MSCREEN Deleted, can not WRITE." Q
+41 ; Defaults to comma to support old way.
SET DELIM=$GET(PARAMS("DELIMITER"),",")
+42 ;
+43 SET SITENM=$$CHARCHK^DGRRUTL($$SITENAM^DGRRUTL())
+44 SET SITENO=$$CHARCHK^DGRRUTL($$SITENO^DGRRUTL())
+45 SET X=$$PRODST1^DGRRUTL()
+46 SET Y=$$PRODST2^DGRRUTL()
+47 SET PRODSTAT=$$CHARCHK^DGRRUTL(X+Y)
+48 SET DOMAIN=$$CHARCHK^DGRRUTL($$KSP^XUPARAM("WHERE"))
+49 ;SET RESTRICT=$G(^VA(200,+$G(DUZ),101))
+50 SET DGRRIENS=$$IENS^DILF(+$GET(DUZ))
+51 DO GETS^DIQ(200,DGRRIENS,"101.01;101.02","I","DGRRLIST")
+52 SET RESTRICT=$GET(DGRRLIST(200,DGRRIENS,101.01,"I"))_U_$GET(DGRRLIST(200,DGRRIENS,101.02,"I"))
+53 IF +RESTRICT
SET CODE="I $D(^OR(100.21,"_$PIECE(RESTRICT,"^",2)_",10,""B"",+$G(DFN)_"";DPT(""))"
+54 ;.IF MSCREEN'="" S MSCREEN=" "_CODE Q
+55 ;.IF MSCREEN="" S MSCREEN=CODE
+56 IF (FILTER'="")
IF (FILTERV'="")
DO BYFILTER^DGRRLU0(FILTER,FILTERV,BDATE,EDATE,SEARCH,VALUE,DELIM)
GOTO DONE1
+57 IF (SEARCH="PRVLUP")
DO PRVLUP^DGRRLU5(.RESULT,.PARAMS)
GOTO DONE1
+58 ; v2 sgg 05/06/04
IF (SEARCH="NAME")
IF ($GET(PARAMS("VERSION 1"))="")
DO BYNAME^DGRRLU6
GOTO DONE1
+59 DO ADD("<record count='0'>")
+60 SET LINENO=DGRRLINE
+61 IF SEARCH="DFN"
Begin DoDot:1
+62 DO DFNLST(VALUE)
+63 IF $GET(DGERR)=1
DO DONE1
End DoDot:1
IF $GET(DGERR)=1
QUIT
+64 ; ****
IF (SEARCH="NAME")!(SEARCH="SSN")!(SEARCH="ICN")!(SEARCH="SSN4")
DO BYNAME
IF $GET(DGERR)=1
GOTO DONE1
+65 ; *****
IF ("|NAME|SSN|ICN|SSN4|DFN|PRVLUP|"'[SEARCH)!(SEARCH="")
Begin DoDot:1
+66 ; ****
DO ADD("<error message='Searching for patients by "_$SELECT(SEARCH="":"Empty String",1:SEARCH)_" not yet implemented!'></error>")
End DoDot:1
GOTO DONE1
+67 ;
+68 DO DONE
+69 ; ****
IF CANCEL=1
DO CLEAN^DILF
+70 QUIT
+71 ;
BYNAME ;
+1 NEW FULLCNT,DGRR,NODE,DFN,XREF,DIERR
+2 ;; copied From scutbk11
+3 ;; DO FIND^DIC(2,,".01;.03;.363;.09","PS",VALUE,300,"B^BS^BS5^SSN")
+4 ;
+5 IF VALUE=""
Begin DoDot:1
+6 DO ADD("<error message='Not Enough Information Provided to Search for Patients. Search Type = """_SEARCH_""" Search For = """_VALUE_"""'></error>")
+7 SET DGERR=1
End DoDot:1
QUIT
+8 ;
+9 IF SEARCH="NAME"
SET XREF="B^NOP"
IF VALUE[", "
Begin DoDot:1
+10 ;REMOVE FIRST SPACE
SET VALUE=$PIECE(VALUE,", ")_","_$PIECE(VALUE,", ",2)
End DoDot:1
+11 ; REMOVE DASHES AND SPACES
IF SEARCH="SSN"
SET XREF="SSN"
SET VALUE=$TRANSLATE(VALUE," -","")
+12 IF SEARCH="SSN4"
SET XREF="BS5"
Begin DoDot:1
+13 ; can't exceed 5 characters, if P for psuedo on end take it off.
IF $LENGTH(VALUE)>5
SET VALUE=$EXTRACT(VALUE,1,5)
End DoDot:1
+14 IF SEARCH="ICN"
SET XREF="AICN"
Begin DoDot:1
+15 SET VALUE=$PIECE(VALUE,"V",1)
End DoDot:1
+16 ; *****
IF $DATA(^XTMP("DGRRLU",JOB,1))
SET CANCEL=1
QUIT
+17 ;DO FIND^DIC(2,,".01;.03;.09","PS",VALUE,300,XREF) ; replaced sgg 05/04/04
+18 ;DO FIND^DIC(2,,".01;.03;.09","PS",VALUE,MAXSIZE+3,XREF)
+19 ;IF $G(DIERR) DO Q
+20 ;. DO ADD("<error message='Error occurred in ""Mumps"" during patient lookup'></error>")
+21 ;. DO CLEAN^DILF
+22 ;. S DGERR=1
+23 ;SET FULLCNT=+$G(^TMP("DILIST",$J,0))
+24 ;DO ADD("<record count='0'>")
+25 ;SET LINENO=DGRRLINE
+26 ;
+27 KILL ^TMP($JOB,"DGRRPTS")
+28 NEW DGRRARRY,DGRRLST,DGRRI,DPTPSREF
+29 SET DGRRARRY="^TMP($J,""DGRRPTS"")"
+30 ; Set variable to cross references to be used by $$LIST^DPTLK1 call
+31 SET DPTPSREF=$TRANSLATE(XREF,"^",",")
+32 SET DGRRLST=$$LIST^DPTLK1(VALUE,MAXSIZE,DGRRARRY)
+33 SET DGRRI=0
+34 FOR
SET DGRRI=$ORDER(^TMP($JOB,"DGRRPTS",DGRRI))
IF 'DGRRI
QUIT
Begin DoDot:1
+35 NEW DGRRCA
+36 SET NODE=$GET(^TMP($JOB,"DGRRPTS",DGRRI))
+37 SET DFN=$PIECE(NODE,"^")
+38 IF $PIECE(NODE,"^",2)'=$PIECE(NODE,"^",3)
SET DGRRCA=1_"^"_$PIECE(NODE,"^",3)
+39 DO PTDATA^DGRRLUA(+NODE,.DGRRPCNT)
+40 IF $DATA(^XTMP("DGRRLU",JOB,1))
SET CANCEL=1
End DoDot:1
IF $$STOP^XOBVLIB()
QUIT
IF CANCEL=1
QUIT
+41 ;
+42 ;FOR DGRR=1:1:FULLCNT D Q:$$STOP^XOBVLIB() Q:CANCEL=1 ; ****
+43 ;. SET NODE=^TMP("DILIST",$J,DGRR,0)
+44 ;. SET DFN=$P(NODE,"^",1)
+45 ;. D PTDATA^DGRRLUA(+NODE,.DGRRPCNT)
+46 ;. IF $D(^XTMP("DGRRLU",JOB,1)) S CANCEL=1 ; *****
+47 KILL ^TMP($JOB,"DGRRPTS")
+48 QUIT
+49 ;
DONE ; *****
IF CANCEL=1
QUIT
+1 ; sgg moved one line to maintain consistent order
IF ($GET(MAXSIZRE)<1)
DO ADD("<maximum message=''></maximum>")
+2 DO ADD("<error message=''>"_$GET(ERRMSG)_"</error>")
+3 SET @DGRRESLT@(LINENO)="<record count='"_DGRRPCNT_"'>"
+4 ;
DONE1 DO ADD("<institution name='"_SITENM_"' number='"_SITENO_"' productiondatabase='"_PRODSTAT_"' domain='"_DOMAIN_"' ></institution>")
+1 IF (SEARCH="PRVLUP")
DO ADD("</persons>")
+2 ;IF (SEARCH="NAME")!(SEARCH="SSN")!(SEARCH="ICN")!(SEARCH="SSN4") DO ADD("</record>")
+3 IF (SEARCH'="PRVLUP")
DO ADD("</record>")
+4 QUIT
+5 ;
ADD(STR) ; -- add string to array
+1 SET DGRRLINE=DGRRLINE+1
+2 SET @DGRRESLT@(DGRRLINE)=STR
+3 QUIT
+4 ;
CANCEL(RESULT,PARAM) ; Cancel a patient search ; ****
+1 ; ****
SET JOB=$GET(PARAM)
+2 IF JOB=""
SET RESULT=0
QUIT
+3 NEW DGRRCDT
+4 SET DGRRCDT=$$FMADD^XLFDT(DT,2)
+5 ; ****
SET ^XTMP("DGRRLU",JOB,0)=DGRRCDT_"^"_DT
+6 ; ****
SET ^XTMP("DGRRLU",JOB,1)=JOB
+7 SET RESULT=1
+8 ; ****
QUIT
+9 ;
DFNLST(DGRRVAL) ;Loop through DFN list
+1 ;
+2 NEW DGRRDFN,DGRRI
+3 IF DGRRVAL=""
Begin DoDot:1
+4 DO ADD("<error message='Not Enough Information Provided to Search for Patients. Search Type = """_SEARCH_""" Search For = """_DGRRVAL_"""'></error>")
+5 SET DGERR=1
End DoDot:1
QUIT
+6 FOR DGRRI=1:1
SET DGRRDFN=$PIECE(DGRRVAL,U,DGRRI)
IF DGRRDFN=""
QUIT
Begin DoDot:1
+7 IF $DATA(^DPT(+DGRRDFN,0))
Begin DoDot:2
+8 DO PTDATA^DGRRLUA(+DGRRDFN,.DGRRPCNT)
End DoDot:2
End DoDot:1
+9 QUIT
+10 ;
