- PXBUTL2 ;ISL/DCM - PCE Utilities ;5/21/96 12:15
- ;;1.0;PCE PATIENT CARE ENCOUNTER;;Aug 12, 1996
- ;
- ;
- ;
- ;
- 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,X,NAME
- 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($G(^ICD9(+X,0)),"^",1,3)
- . ;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
- PXBUTL2 ;ISL/DCM - PCE Utilities ;5/21/96 12:15
- +1 ;;1.0;PCE PATIENT CARE ENCOUNTER;;Aug 12, 1996
- +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
- NEW IFN,X,NAME
- +7 IF '$DATA(CODE)
- SET CODE=1
- +8 SET IFN=0
- FOR
- SET IFN=$ORDER(^SC(CLINIC,"DX",IFN))
- IF IFN<1
- QUIT
- SET X=^(IFN,0)
- Begin DoDot:1
- +9 SET NAME=$PIECE($GET(^ICD9(+X,0)),"^",1,3)
- +10 ;jvs 7/22/96 allow selection of v codes
- +11 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
- +12 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
