- DGRRLU ;alb/aas - DG Replacement and Rehosting RPC for VADPT ;12/22/05 14:53
- ;;5.3;Registration;**538**;Aug 13, 1993
- ;
- 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
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGRRLU 7152 printed Jan 18, 2025@03:58:13 Page 2
- DGRRLU ;alb/aas - DG Replacement and Rehosting RPC for VADPT ;12/22/05 14:53
- +1 ;;5.3;Registration;**538**;Aug 13, 1993
- +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 ;