PXBUTL2 ;ISL/DCM - PCE Utilities ;5/21/96 12:15
;;1.0;PCE PATIENT CARE ENCOUNTER;**121,199**;Aug 12, 1996;Build 51
;
;
;
;
PRV(CLINIC) ;Get default provider and all providers associated with a clinic
;CLINIC - ifn of clinic in file 44
;External references: ^SC(DA(1),"PR",DA)
; ^VA(200,DA,0)
Q:'$G(CLINIC) Q:'$O(^SC(CLINIC,"PR",0))
K PXBPMT N IFN,X,NAME
S IFN=0 F S IFN=$O(^SC(CLINIC,"PR",IFN)) Q:IFN<1 S X=^(IFN,0) D
. S NAME=$P($G(^VA(200,+X,0)),"^") I $L(NAME) S PXBPMT("PRV",NAME,+X)="" S:$P(X,"^",2) PXBPMT("DEF",NAME,+X)=""
Q
POV(CLINIC,CODE) ;Get default diagnosis and all diagnosis associated with clinic
;CLINIC - ifn of clinic in file 44
;CODE - 1 (default) code, 2 diagnosis, 3 both
;External references: ^SC(DA(1),"DX",DA)
; ^ICD9(DA,0)
Q:'$G(CLINIC) Q:'$O(^SC(CLINIC,"DX",0))
K PXBPMT
N IFN,NAME,PXDXDATE,X
S PXDXDATE=$$CSDATE^PXDXUTL(PXBVST)
S:'$D(CODE) CODE=1
S IFN=0 F S IFN=$O(^SC(CLINIC,"DX",IFN)) Q:IFN<1 S X=^(IFN,0) D
. S NAME=$P($$ICDDATA^ICDXCODE("DIAG",+X,PXDXDATE,"I"),"^",2,4)
. I $P(NAME," ",1,2)="Invalid Code" S NAME="" ; ignore value if Invalid Code message is returned from $$ICDDATA
. ;jvs 7/22/96 allow selection of v codes
. I $L(NAME) S NAME=$S(CODE=2:$S($L($P(NAME,"^",3)):$P(NAME,"^",3),1:$P(NAME,"^")),CODE=3:$P(NAME,"^")_"--"_$P(NAME,"^",3),1:$P(NAME,"^")),PXBPMT("POV",NAME,+X)="" S:$P(X,"^",2) PXBPMT("DEF",NAME,+X)=""
Q
TSTPRV ;Test provider lookup
S DIC=44,DIC(0)="AEQLM" D ^DIC Q:Y<1 D PRV(+Y)
K DIC
Q
TSTPOV ;Test diagnosis lookup
S DIC=44,DIC(0)="AEQLM" D ^DIC Q:Y<1 D POV(+Y,3)
K DIC
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXBUTL2 1659 printed Oct 16, 2024@18:28:04 Page 2
PXBUTL2 ;ISL/DCM - PCE Utilities ;5/21/96 12:15
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**121,199**;Aug 12, 1996;Build 51
+2 ;
+3 ;
+4 ;
+5 ;
PRV(CLINIC) ;Get default provider and all providers associated with a clinic
+1 ;CLINIC - ifn of clinic in file 44
+2 ;External references: ^SC(DA(1),"PR",DA)
+3 ; ^VA(200,DA,0)
+4 if '$GET(CLINIC)
QUIT
if '$ORDER(^SC(CLINIC,"PR",0))
QUIT
+5 KILL PXBPMT
NEW IFN,X,NAME
+6 SET IFN=0
FOR
SET IFN=$ORDER(^SC(CLINIC,"PR",IFN))
if IFN<1
QUIT
SET X=^(IFN,0)
Begin DoDot:1
+7 SET NAME=$PIECE($GET(^VA(200,+X,0)),"^")
IF $LENGTH(NAME)
SET PXBPMT("PRV",NAME,+X)=""
if $PIECE(X,"^",2)
SET PXBPMT("DEF",NAME,+X)=""
End DoDot:1
+8 QUIT
POV(CLINIC,CODE) ;Get default diagnosis and all diagnosis associated with clinic
+1 ;CLINIC - ifn of clinic in file 44
+2 ;CODE - 1 (default) code, 2 diagnosis, 3 both
+3 ;External references: ^SC(DA(1),"DX",DA)
+4 ; ^ICD9(DA,0)
+5 if '$GET(CLINIC)
QUIT
if '$ORDER(^SC(CLINIC,"DX",0))
QUIT
+6 KILL PXBPMT
+7 NEW IFN,NAME,PXDXDATE,X
+8 SET PXDXDATE=$$CSDATE^PXDXUTL(PXBVST)
+9 if '$DATA(CODE)
SET CODE=1
+10 SET IFN=0
FOR
SET IFN=$ORDER(^SC(CLINIC,"DX",IFN))
if IFN<1
QUIT
SET X=^(IFN,0)
Begin DoDot:1
+11 SET NAME=$PIECE($$ICDDATA^ICDXCODE("DIAG",+X,PXDXDATE,"I"),"^",2,4)
+12 ; ignore value if Invalid Code message is returned from $$ICDDATA
IF $PIECE(NAME," ",1,2)="Invalid Code"
SET NAME=""
+13 ;jvs 7/22/96 allow selection of v codes
+14 IF $LENGTH(NAME)
SET NAME=$SELECT(CODE=2:$SELECT($LENGTH($PIECE(NAME,"^",3)):$PIECE(NAME,"^",3),1:$PIECE(NAME,"^")),CODE=3:$PIECE(NAME,"^")_"--"_$PIECE(NAME,"^",3),1:$PIECE(NAME,"^"))
SET PXBPMT("POV",NAME,+X)=""
if $PIECE(X,"^",2)
SET PXBPMT("DEF",NAME,+X)=""
End DoDot:1
+15 QUIT
TSTPRV ;Test provider lookup
+1 SET DIC=44
SET DIC(0)="AEQLM"
DO ^DIC
if Y<1
QUIT
DO PRV(+Y)
+2 KILL DIC
+3 QUIT
TSTPOV ;Test diagnosis lookup
+1 SET DIC=44
SET DIC(0)="AEQLM"
DO ^DIC
if Y<1
QUIT
DO POV(+Y,3)
+2 KILL DIC
+3 QUIT
