BQIDCASN ;VNGT/HS/ALA-'Patients Assigned To' ; 15 Sep 2006 5:18 PM
;;2.4;ICARE MANAGEMENT SYSTEM;**2**;Apr 01, 2015;Build 10
;
Q
;
FND(FDATA,PARMS,MPARMS) ;EP - Find records
;
;Description
; Executable that finds all patients who are assigned to designated people
;Input
; PARMS = Array of parameters and their values
; MPARMS = Multiple array of a parameter
;Expected to return FDATA
;
NEW UID,PSTMFRAM,PSVISITS,PTMFRAME,PVISITS,TYPE,VDATA,RFROM
NEW TEAM,CAT,TYP,PROV,NOTA,SPEC,QFL,VISIT,VSDTM,PPIEN,RTHRU
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S FDATA=$NA(^TMP(UID,"BQIDCASN")),VDATA=$NA(^TMP(UID,"BQIFND"))
K @FDATA,@VDATA
;
; Set the parameters into variables
I '$D(PARMS) Q
;
S NM="" F S NM=$O(PARMS(NM)) Q:NM="" S @NM=PARMS(NM)
S PROV=$G(PROV,""),TYPE=$G(TYPE,""),NOTA=$G(NOTA,"")
S PPIEN=$$PP^BQIDCDF("PATIENTS ASSIGNED TO")
;
; If panel is patient not assigned to a DPCP
I $G(NOTA)'="" D Q
. NEW BQDFN
. S BQDFN=0
. F S BQDFN=$O(^AUPNPAT(BQDFN)) Q:'BQDFN D
.. I $P($G(^AUPNPAT(BQDFN,0)),"^",1)="" Q
.. I $P(^AUPNPAT(BQDFN,0),U,14)'="" Q
.. ; If patient has no active HRNs, quit
.. I '$$HRN^BQIUL1(BQDFN) Q
.. S @FDATA@(BQDFN)=""
;
; If team
I $G(TEAM)'="" D Q
. S CAT=$$CT("DESIGNATED PRIMARY PROVIDER")
. S PROV=""
. F S PROV=$O(^BSDPCT(TEAM,1,"B",PROV)) Q:PROV="" D DP
. D SAV
;
I '$D(MPARMS("TYPE")) D
. I TYPE="CMGR"!(TYPE="DPCP") S DATA=$NA(^TMP("BQIBDP",UID))
. I TYPE="PRIM"!(TYPE="PRSC") S DATA=$NA(^TMP("BQIPRV",UID))
. K @DATA
. I TYPE="PRIM" D PROV("P"),SAV Q
. I TYPE="PRSC" D PROV(""),SAV Q
. I TYPE="" Q
. D @TYPE,SAV
I $D(MPARMS("TYPE")) D
. ; types = CMGR,DPCP,PRIM,PRSC
. S TYP=""
. F S TYP=$O(MPARMS("TYPE",TYP)) Q:TYP="" D
.. I TYP="CMGR"!(TYP="DPCP") S DATA=$NA(^TMP("BQIBDP",UID))
.. I TYP="PRIM"!(TYP="PRSC") S DATA=$NA(^TMP("BQIPRV",UID))
.. K @DATA
.. I TYP="PRIM" D PROV("P"),SAV Q
.. I TYP="PRSC" D PROV(""),SAV Q
.. D @TYP,SAV
;
Q
;
SAV ; Save the data
K @FDATA
S DFN=""
F S DFN=$O(@DATA@(DFN)) Q:DFN="" S @FDATA@(DFN)=""
K @DATA
Q
;
CMGR ; Case Manager
I $$VERSION^XPDUTL("BDP")="" Q
;
NEW DFN,CAT,IEN,NM,IEN,Y,X,CSMGR
S CAT=$$CT("CASE MANAGER")
I 'CAT Q
;
; Go through the BDP DESG SPECIALTY PROVIDER File to find any patient
; with the specified case manager
;
I $D(MPARMS("PROV")) D
. S CSMGR=""
. F S CSMGR=$O(MPARMS("PROV",CSMGR)) Q:CSMGR="" S IEN="" D CM
I '$D(MPARMS("PROV")) S CSMGR=PROV,IEN="" D CM
Q
;
CM ;
F S IEN=$O(^BDPRECN("AC",CSMGR,IEN)) Q:IEN="" D
. ;I $$GET1^DIQ(90360.1,IEN_",",.01,"I")'=CAT Q
. I $P($G(^BDPRECN(IEN,0)),"^",1)'=CAT Q
. ;S DFN=$$GET1^DIQ(90360.1,IEN_",",.02,"I") I DFN="" Q
. S DFN=$P($G(^BDPRECN(IEN,0)),"^",2) I DFN="" Q
. S @DATA@(DFN)=""
Q
;
DPCP ;
; If the DSPM package is installed
I $$VERSION^XPDUTL("BDP")'="" D DSPM
;
; If the DSPM package is NOT installed, use the alternate
; primary provider definition
I $$VERSION^XPDUTL("BDP")="" D
. I $D(MPARMS("PROV")) D
.. S PROV=""
.. F S PROV=$O(MPARMS("PROV",PROV)) Q:PROV="" S IEN="" D DP
. I '$D(MPARMS("PROV")) S IEN="" D DP
. Q
. NEW IEN
. S IEN=""
. F S IEN=$O(^AUPNPAT("AK",PROV,IEN)) Q:IEN="" D
.. S @DATA@(IEN)=""
Q
;
DSPM ; Find the internal entry number
NEW DFN,DIC,IEN,Y,X
S CAT=$$CT("DESIGNATED PRIMARY PROVIDER")
I 'CAT Q
;
I $D(MPARMS("PROV")) D
. S PROV=""
. F S PROV=$O(MPARMS("PROV",PROV)) Q:PROV="" S IEN="" D DP
I '$D(MPARMS("PROV")) S IEN="" D DP
Q
;
DP ;
S IEN=""
F S IEN=$O(^BDPRECN("AC",PROV,IEN)) Q:IEN="" D
. ;I $$GET1^DIQ(90360.1,IEN_",",.01,"I")'=CAT Q
. I $P($G(^BDPRECN(IEN,0)),"^",1)'=CAT Q
. ;S DFN=$$GET1^DIQ(90360.1,IEN_",",.02,"I") I DFN="" Q
. S DFN=$P($G(^BDPRECN(IEN,0)),"^",2) I DFN="" Q
. S @DATA@(DFN)=""
;
; Also check patient file
NEW IEN
S IEN=""
F S IEN=$O(^AUPNPAT("AK",PROV,IEN)) Q:IEN="" D
. S @DATA@(IEN)=""
Q
;
PROV(FLAG) ;EP - Primary or Primary/Secondary Providers
; Input
; FLAG - "P" for Primary Only
;
NEW TMFRAME,VISITS,FDT,TDT,IEN
I $G(DT)="" D DT^DICRW
S FDT="",TDT=""
I FLAG="P" D
. I $G(PTMFRAME)'="" D
.. D RANGE^BQIDCAH1(PTMFRAME,PPIEN,"PTMFRAME")
.. S FDT=$G(RFROM,""),TDT=$G(RTHRU,"")
. S VISITS=$G(PVISITS,"")
I FLAG'="P" D
. I $G(PSTMFRAM)'="" D
.. D RANGE^BQIDCAH1(PSTMFRAM,PPIEN,"PSTMFRAM")
.. S FDT=$G(RFROM,""),TDT=$G(RTHRU,"")
. S VISITS=$G(PSVISITS,"")
S TDT=DT
I $G(PROV)'="" D PV
I $D(MPARMS("PROV")) D
. S PROV=""
. F S PROV=$O(MPARMS("PROV",PROV)) Q:PROV="" D PV
;
S DFN=""
F S DFN=$O(@VDATA@(DFN)) Q:DFN="" D
. ; if the number of visits for patient doesn't match the criteria, quit
. I @VDATA@(DFN)<VISITS Q ;Changed from '= to <
. S @DATA@(DFN)=""
;
K @VDATA
Q
;
; Go through the V PROVIDER File for the designated provider and
; find out if they are a primary or secondary provider AND if the
; visit falls within the time frame
PV ;
S IEN="",FLAG=$G(FLAG,"")
F S IEN=$O(^AUPNVPRV("B",PROV,IEN),-1) Q:IEN="" D
. ;I FLAG="P",$$GET1^DIQ(9000010.06,IEN_",",.04,"I")'="P" Q
. I FLAG="P",$P($G(^AUPNVPRV(IEN,0)),"^",4)'="P" Q
. ;S VISIT=$$GET1^DIQ(9000010.06,IEN_",",.03,"I") I VISIT="" Q
. S VISIT=$P($G(^AUPNVPRV(IEN,0)),"^",3) I VISIT="" Q
. ;S VSDTM=$$GET1^DIQ(9000010,VISIT_",",.01,"I")\1 I VSDTM=0 Q
. S VSDTM=$P($G(^AUPNVSIT(VISIT,0)),"^",1)\1 I VSDTM=0 Q
. ;S DFN=$$GET1^DIQ(9000010.06,IEN_",",.02,"I") I DFN="" Q
. S DFN=$P($G(^AUPNVPRV(IEN,0)),"^",2) I DFN="" Q
. I $D(@FDATA)>0,'$D(@FDATA@(DFN)) Q
. ;
. I FDT'="" S QFL=0 D Q:QFL
.. I VSDTM'<FDT,VSDTM'>TDT Q
.. S QFL=1
. ; Count number of visits for a patient
. S @VDATA@(DFN)=$G(@VDATA@(DFN))+1
;
Q
;
SPEC ; Find the entries for a specialty provider
NEW IEN,SPC,IEN
; If single specialty
I '$D(MPARMS("SPEC")) D
. ; Multiple providers
. I $D(MPARMS("PROV")) D
.. S PROV=""
.. F S PROV=$O(MPARMS("PROV",PROV)) Q:PROV="" S IEN="" D SPC(SPEC,PROV)
. ; Single Provider
. I '$D(MPARMS("PROV")) S IEN="" D SPC(SPEC,PROV) Q
;
; If multiple specialties
I $D(MPARMS("SPEC")) D
. S SPC=""
. F S SPC=$O(MPARMS("SPEC",SPC),-1) Q:SPC="" D
.. ; Multiple providers
.. I $D(MPARMS("PROV")) D
... S PROV=""
... F S PROV=$O(MPARMS("PROV",PROV)) Q:PROV="" S IEN="" D SPC(SPC,PROV)
.. ; Single Provider
.. I '$D(MPARMS("PROV")) S IEN="" D SPC(SPC,PROV) Q
Q
;
SPC(SPC,PRV) ;
S IEN=""
F S IEN=$O(^BDPRECN("B",SPC,IEN)) Q:IEN="" D
. I $P(^BDPRECN(IEN,0),U,3)'=PRV Q
. S DFN=$P(^BDPRECN(IEN,0),U,2)
. S @DATA@(DFN)=""
Q
;
CT(TEXT) ; Find value
Q $$FIND1^DIC(90360.3,,"X",TEXT)
BQIDCASN ;VNGT/HS/ALA-'Patients Assigned To' ; 15 Sep 2006 5:18 PM
+1 ;;2.4;ICARE MANAGEMENT SYSTEM;**2**;Apr 01, 2015;Build 10
+2 ;
+3 QUIT
+4 ;
FND(FDATA,PARMS,MPARMS) ;EP - Find records
+1 ;
+2 ;Description
+3 ; Executable that finds all patients who are assigned to designated people
+4 ;Input
+5 ; PARMS = Array of parameters and their values
+6 ; MPARMS = Multiple array of a parameter
+7 ;Expected to return FDATA
+8 ;
+9 NEW UID,PSTMFRAM,PSVISITS,PTMFRAME,PVISITS,TYPE,VDATA,RFROM
+10 NEW TEAM,CAT,TYP,PROV,NOTA,SPEC,QFL,VISIT,VSDTM,PPIEN,RTHRU
+11 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+12 SET FDATA=$NAME(^TMP(UID,"BQIDCASN"))
SET VDATA=$NAME(^TMP(UID,"BQIFND"))
+13 KILL @FDATA,@VDATA
+14 ;
+15 ; Set the parameters into variables
+16 IF '$DATA(PARMS)
QUIT
+17 ;
+18 SET NM=""
FOR
SET NM=$ORDER(PARMS(NM))
IF NM=""
QUIT
SET @NM=PARMS(NM)
+19 SET PROV=$GET(PROV,"")
SET TYPE=$GET(TYPE,"")
SET NOTA=$GET(NOTA,"")
+20 SET PPIEN=$$PP^BQIDCDF("PATIENTS ASSIGNED TO")
+21 ;
+22 ; If panel is patient not assigned to a DPCP
+23 IF $GET(NOTA)'=""
Begin DoDot:1
+24 NEW BQDFN
+25 SET BQDFN=0
+26 FOR
SET BQDFN=$ORDER(^AUPNPAT(BQDFN))
IF 'BQDFN
QUIT
Begin DoDot:2
+27 IF $PIECE($GET(^AUPNPAT(BQDFN,0)),"^",1)=""
QUIT
+28 IF $PIECE(^AUPNPAT(BQDFN,0),U,14)'=""
QUIT
+29 ; If patient has no active HRNs, quit
+30 IF '$$HRN^BQIUL1(BQDFN)
QUIT
+31 SET @FDATA@(BQDFN)=""
End DoDot:2
End DoDot:1
QUIT
+32 ;
+33 ; If team
+34 IF $GET(TEAM)'=""
Begin DoDot:1
+35 SET CAT=$$CT("DESIGNATED PRIMARY PROVIDER")
+36 SET PROV=""
+37 FOR
SET PROV=$ORDER(^BSDPCT(TEAM,1,"B",PROV))
IF PROV=""
QUIT
DO DP
+38 DO SAV
End DoDot:1
QUIT
+39 ;
+40 IF '$DATA(MPARMS("TYPE"))
Begin DoDot:1
+41 IF TYPE="CMGR"!(TYPE="DPCP")
SET DATA=$NAME(^TMP("BQIBDP",UID))
+42 IF TYPE="PRIM"!(TYPE="PRSC")
SET DATA=$NAME(^TMP("BQIPRV",UID))
+43 KILL @DATA
+44 IF TYPE="PRIM"
DO PROV("P")
DO SAV
QUIT
+45 IF TYPE="PRSC"
DO PROV("")
DO SAV
QUIT
+46 IF TYPE=""
QUIT
+47 DO @TYPE
DO SAV
End DoDot:1
+48 IF $DATA(MPARMS("TYPE"))
Begin DoDot:1
+49 ; types = CMGR,DPCP,PRIM,PRSC
+50 SET TYP=""
+51 FOR
SET TYP=$ORDER(MPARMS("TYPE",TYP))
IF TYP=""
QUIT
Begin DoDot:2
+52 IF TYP="CMGR"!(TYP="DPCP")
SET DATA=$NAME(^TMP("BQIBDP",UID))
+53 IF TYP="PRIM"!(TYP="PRSC")
SET DATA=$NAME(^TMP("BQIPRV",UID))
+54 KILL @DATA
+55 IF TYP="PRIM"
DO PROV("P")
DO SAV
QUIT
+56 IF TYP="PRSC"
DO PROV("")
DO SAV
QUIT
+57 DO @TYP
DO SAV
End DoDot:2
End DoDot:1
+58 ;
+59 QUIT
+60 ;
SAV ; Save the data
+1 KILL @FDATA
+2 SET DFN=""
+3 FOR
SET DFN=$ORDER(@DATA@(DFN))
IF DFN=""
QUIT
SET @FDATA@(DFN)=""
+4 KILL @DATA
+5 QUIT
+6 ;
CMGR ; Case Manager
+1 IF $$VERSION^XPDUTL("BDP")=""
QUIT
+2 ;
+3 NEW DFN,CAT,IEN,NM,IEN,Y,X,CSMGR
+4 SET CAT=$$CT("CASE MANAGER")
+5 IF 'CAT
QUIT
+6 ;
+7 ; Go through the BDP DESG SPECIALTY PROVIDER File to find any patient
+8 ; with the specified case manager
+9 ;
+10 IF $DATA(MPARMS("PROV"))
Begin DoDot:1
+11 SET CSMGR=""
+12 FOR
SET CSMGR=$ORDER(MPARMS("PROV",CSMGR))
IF CSMGR=""
QUIT
SET IEN=""
DO CM
End DoDot:1
+13 IF '$DATA(MPARMS("PROV"))
SET CSMGR=PROV
SET IEN=""
DO CM
+14 QUIT
+15 ;
CM ;
+1 FOR
SET IEN=$ORDER(^BDPRECN("AC",CSMGR,IEN))
IF IEN=""
QUIT
Begin DoDot:1
+2 ;I $$GET1^DIQ(90360.1,IEN_",",.01,"I")'=CAT Q
+3 IF $PIECE($GET(^BDPRECN(IEN,0)),"^",1)'=CAT
QUIT
+4 ;S DFN=$$GET1^DIQ(90360.1,IEN_",",.02,"I") I DFN="" Q
+5 SET DFN=$PIECE($GET(^BDPRECN(IEN,0)),"^",2)
IF DFN=""
QUIT
+6 SET @DATA@(DFN)=""
End DoDot:1
+7 QUIT
+8 ;
DPCP ;
+1 ; If the DSPM package is installed
+2 IF $$VERSION^XPDUTL("BDP")'=""
DO DSPM
+3 ;
+4 ; If the DSPM package is NOT installed, use the alternate
+5 ; primary provider definition
+6 IF $$VERSION^XPDUTL("BDP")=""
Begin DoDot:1
+7 IF $DATA(MPARMS("PROV"))
Begin DoDot:2
+8 SET PROV=""
+9 FOR
SET PROV=$ORDER(MPARMS("PROV",PROV))
IF PROV=""
QUIT
SET IEN=""
DO DP
End DoDot:2
+10 IF '$DATA(MPARMS("PROV"))
SET IEN=""
DO DP
+11 QUIT
+12 NEW IEN
+13 SET IEN=""
+14 FOR
SET IEN=$ORDER(^AUPNPAT("AK",PROV,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+15 SET @DATA@(IEN)=""
End DoDot:2
End DoDot:1
+16 QUIT
+17 ;
DSPM ; Find the internal entry number
+1 NEW DFN,DIC,IEN,Y,X
+2 SET CAT=$$CT("DESIGNATED PRIMARY PROVIDER")
+3 IF 'CAT
QUIT
+4 ;
+5 IF $DATA(MPARMS("PROV"))
Begin DoDot:1
+6 SET PROV=""
+7 FOR
SET PROV=$ORDER(MPARMS("PROV",PROV))
IF PROV=""
QUIT
SET IEN=""
DO DP
End DoDot:1
+8 IF '$DATA(MPARMS("PROV"))
SET IEN=""
DO DP
+9 QUIT
+10 ;
DP ;
+1 SET IEN=""
+2 FOR
SET IEN=$ORDER(^BDPRECN("AC",PROV,IEN))
IF IEN=""
QUIT
Begin DoDot:1
+3 ;I $$GET1^DIQ(90360.1,IEN_",",.01,"I")'=CAT Q
+4 IF $PIECE($GET(^BDPRECN(IEN,0)),"^",1)'=CAT
QUIT
+5 ;S DFN=$$GET1^DIQ(90360.1,IEN_",",.02,"I") I DFN="" Q
+6 SET DFN=$PIECE($GET(^BDPRECN(IEN,0)),"^",2)
IF DFN=""
QUIT
+7 SET @DATA@(DFN)=""
End DoDot:1
+8 ;
+9 ; Also check patient file
+10 NEW IEN
+11 SET IEN=""
+12 FOR
SET IEN=$ORDER(^AUPNPAT("AK",PROV,IEN))
IF IEN=""
QUIT
Begin DoDot:1
+13 SET @DATA@(IEN)=""
End DoDot:1
+14 QUIT
+15 ;
PROV(FLAG) ;EP - Primary or Primary/Secondary Providers
+1 ; Input
+2 ; FLAG - "P" for Primary Only
+3 ;
+4 NEW TMFRAME,VISITS,FDT,TDT,IEN
+5 IF $GET(DT)=""
DO DT^DICRW
+6 SET FDT=""
SET TDT=""
+7 IF FLAG="P"
Begin DoDot:1
+8 IF $GET(PTMFRAME)'=""
Begin DoDot:2
+9 DO RANGE^BQIDCAH1(PTMFRAME,PPIEN,"PTMFRAME")
+10 SET FDT=$GET(RFROM,"")
SET TDT=$GET(RTHRU,"")
End DoDot:2
+11 SET VISITS=$GET(PVISITS,"")
End DoDot:1
+12 IF FLAG'="P"
Begin DoDot:1
+13 IF $GET(PSTMFRAM)'=""
Begin DoDot:2
+14 DO RANGE^BQIDCAH1(PSTMFRAM,PPIEN,"PSTMFRAM")
+15 SET FDT=$GET(RFROM,"")
SET TDT=$GET(RTHRU,"")
End DoDot:2
+16 SET VISITS=$GET(PSVISITS,"")
End DoDot:1
+17 SET TDT=DT
+18 IF $GET(PROV)'=""
DO PV
+19 IF $DATA(MPARMS("PROV"))
Begin DoDot:1
+20 SET PROV=""
+21 FOR
SET PROV=$ORDER(MPARMS("PROV",PROV))
IF PROV=""
QUIT
DO PV
End DoDot:1
+22 ;
+23 SET DFN=""
+24 FOR
SET DFN=$ORDER(@VDATA@(DFN))
IF DFN=""
QUIT
Begin DoDot:1
+25 ; if the number of visits for patient doesn't match the criteria, quit
+26 ;Changed from '= to <
IF @VDATA@(DFN)<VISITS
QUIT
+27 SET @DATA@(DFN)=""
End DoDot:1
+28 ;
+29 KILL @VDATA
+30 QUIT
+31 ;
+32 ; Go through the V PROVIDER File for the designated provider and
+33 ; find out if they are a primary or secondary provider AND if the
+34 ; visit falls within the time frame
PV ;
+1 SET IEN=""
SET FLAG=$GET(FLAG,"")
+2 FOR
SET IEN=$ORDER(^AUPNVPRV("B",PROV,IEN),-1)
IF IEN=""
QUIT
Begin DoDot:1
+3 ;I FLAG="P",$$GET1^DIQ(9000010.06,IEN_",",.04,"I")'="P" Q
+4 IF FLAG="P"
IF $PIECE($GET(^AUPNVPRV(IEN,0)),"^",4)'="P"
QUIT
+5 ;S VISIT=$$GET1^DIQ(9000010.06,IEN_",",.03,"I") I VISIT="" Q
+6 SET VISIT=$PIECE($GET(^AUPNVPRV(IEN,0)),"^",3)
IF VISIT=""
QUIT
+7 ;S VSDTM=$$GET1^DIQ(9000010,VISIT_",",.01,"I")\1 I VSDTM=0 Q
+8 SET VSDTM=$PIECE($GET(^AUPNVSIT(VISIT,0)),"^",1)\1
IF VSDTM=0
QUIT
+9 ;S DFN=$$GET1^DIQ(9000010.06,IEN_",",.02,"I") I DFN="" Q
+10 SET DFN=$PIECE($GET(^AUPNVPRV(IEN,0)),"^",2)
IF DFN=""
QUIT
+11 IF $DATA(@FDATA)>0
IF '$DATA(@FDATA@(DFN))
QUIT
+12 ;
+13 IF FDT'=""
SET QFL=0
Begin DoDot:2
+14 IF VSDTM'<FDT
IF VSDTM'>TDT
QUIT
+15 SET QFL=1
End DoDot:2
IF QFL
QUIT
+16 ; Count number of visits for a patient
+17 SET @VDATA@(DFN)=$GET(@VDATA@(DFN))+1
End DoDot:1
+18 ;
+19 QUIT
+20 ;
SPEC ; Find the entries for a specialty provider
+1 NEW IEN,SPC,IEN
+2 ; If single specialty
+3 IF '$DATA(MPARMS("SPEC"))
Begin DoDot:1
+4 ; Multiple providers
+5 IF $DATA(MPARMS("PROV"))
Begin DoDot:2
+6 SET PROV=""
+7 FOR
SET PROV=$ORDER(MPARMS("PROV",PROV))
IF PROV=""
QUIT
SET IEN=""
DO SPC(SPEC,PROV)
End DoDot:2
+8 ; Single Provider
+9 IF '$DATA(MPARMS("PROV"))
SET IEN=""
DO SPC(SPEC,PROV)
QUIT
End DoDot:1
+10 ;
+11 ; If multiple specialties
+12 IF $DATA(MPARMS("SPEC"))
Begin DoDot:1
+13 SET SPC=""
+14 FOR
SET SPC=$ORDER(MPARMS("SPEC",SPC),-1)
IF SPC=""
QUIT
Begin DoDot:2
+15 ; Multiple providers
+16 IF $DATA(MPARMS("PROV"))
Begin DoDot:3
+17 SET PROV=""
+18 FOR
SET PROV=$ORDER(MPARMS("PROV",PROV))
IF PROV=""
QUIT
SET IEN=""
DO SPC(SPC,PROV)
End DoDot:3
+19 ; Single Provider
+20 IF '$DATA(MPARMS("PROV"))
SET IEN=""
DO SPC(SPC,PROV)
QUIT
End DoDot:2
End DoDot:1
+21 QUIT
+22 ;
SPC(SPC,PRV) ;
+1 SET IEN=""
+2 FOR
SET IEN=$ORDER(^BDPRECN("B",SPC,IEN))
IF IEN=""
QUIT
Begin DoDot:1
+3 IF $PIECE(^BDPRECN(IEN,0),U,3)'=PRV
QUIT
+4 SET DFN=$PIECE(^BDPRECN(IEN,0),U,2)
+5 SET @DATA@(DFN)=""
End DoDot:1
+6 QUIT
+7 ;
CT(TEXT) ; Find value
+1 QUIT $$FIND1^DIC(90360.3,,"X",TEXT)
