PXBUTL2.m

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