- 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 Feb 18, 2025@23:53:39 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