PXCAVST2.m

PXCAVST2 ;ISL/dee & LEA/Chylton - Validates data from the PCE Device Interface for the Visit and Providers ;3/14/97

 ;;1.0;PCE PATIENT CARE ENCOUNTER;**27,33**;Aug 12, 1996

 Q

 ;

PROVIDER ;Now do the providers

 N PXCAPERR,PXCAPRCK

 S PXCAPERR=1

 S (PXCAITEM,PXCAPRCK)=+$P(PXCAENC,"^",4)

 I PXCAPRCK,'$$ACTIVPRV^PXAPI(PXCAITEM,PXCADT) S PXCAPERR=0,PXCA("ERROR","ENCOUNTER",0,0,4)="Provider is not active or valid^"_PXCAITEM

 ;  add check if no provider sent

 I 'PXCAPRCK S PXCAPERR=0,PXCA("ERROR","ENCOUNTER",0,0,4)="No Provider entered"

 S PXCAITEM=$P(PXCAENC,"^",15)

 I PXCAPRCK,'(PXCAITEM="P"!(PXCAITEM="S")) S PXCAPERR=0,PXCA("ERROR","ENCOUNTER",0,0,15)="Provider indicator code must be P|S^"_PXCAITEM

 E  I PXCAITEM="P" D

 . I 'PXCAPPRV S PXCAPPRV=+$P(PXCAENC,"^",4)

 . E  I PXCAPPRV'=+$P(PXCAENC,"^",4) D

 .. S PXCA("WARNING","ENCOUNTER",0,0,15)="There is already a Primary Provider this one is changed to Secondary^"_PXCAITEM

 .. S $P(PXCAENC,"^",15)="S"

 S PXCAITEM=$P(PXCAENC,"^",16)

 I PXCAITEM]"" D

 . I '$$ACTIVPRV^PXAPI(PXCAITEM,PXCADT) S PXCAPERR=0,PXCA("ERROR","ENCOUNTER",0,0,16)="Attending Provider is not active or valid^"_PXCAITEM

 I PXCABULD&PXCAPERR!PXCAERRS D PROVIDER^PXCAPRV(PXCAENC)

 Q

 ;

EVALCODE(PXCAEVAL) ;Now do the Evaluation and Management CPT

 S PXCAITEM=+$P(PXCAENC,"^",5)

 I PXCAITEM D

 . N DIC,DR,DA,DIQ,PXCADIQ1

 . S DIC=357.69

 . S DR=".01;4"

 . S DA=+PXCAITEM

 . S DIQ="PXCADIQ1("

 . S DIQ(0)="I"

 . D EN^DIQ1

 . I $G(PXCADIQ1(357.69,DA,.01,"I"))="" S PXCA("ERROR","ENCOUNTER",0,0,5)="Evaluation and Management CPT code not in File 357.69^"_PXCAITEM Q

 . I $G(PXCADIQ1(357.69,DA,4,"I")) S PXCA("ERROR","ENCOUNTER",0,0,5)="Evaluation and Management CPT code is INACTIVE^"_PXCAITEM Q

 . S PXCAEVAL=1

 Q

 ;

PXCAVST2  ;ISL/dee & LEA/Chylton - Validates data from the PCE Device Interface for the Visit and Providers ;3/14/97

 +1       ;;1.0;PCE PATIENT CARE ENCOUNTER;**27,33**;Aug 12, 1996

 +2        QUIT 

 +3       ;

PROVIDER  ;Now do the providers

 +1        NEW PXCAPERR,PXCAPRCK

 +2        SET PXCAPERR=1

 +3        SET (PXCAITEM,PXCAPRCK)=+$PIECE(PXCAENC,"^",4)

 +4        IF PXCAPRCK

               IF '$$ACTIVPRV^PXAPI(PXCAITEM,PXCADT)

                   SET PXCAPERR=0

                   SET PXCA("ERROR","ENCOUNTER",0,0,4)="Provider is not active or valid^"_PXCAITEM

 +5       ;  add check if no provider sent

 +6        IF 'PXCAPRCK

               SET PXCAPERR=0

               SET PXCA("ERROR","ENCOUNTER",0,0,4)="No Provider entered"

 +7        SET PXCAITEM=$PIECE(PXCAENC,"^",15)

 +8        IF PXCAPRCK

               IF '(PXCAITEM="P"!(PXCAITEM="S"))

                   SET PXCAPERR=0

                   SET PXCA("ERROR","ENCOUNTER",0,0,15)="Provider indicator code must be P|S^"_PXCAITEM

 +9       IF '$TEST

               IF PXCAITEM="P"

                   Begin DoDot:1

 +10                   IF 'PXCAPPRV

                           SET PXCAPPRV=+$PIECE(PXCAENC,"^",4)

 +11                  IF '$TEST

                           IF PXCAPPRV'=+$PIECE(PXCAENC,"^",4)

                               Begin DoDot:2

 +12                               SET PXCA("WARNING","ENCOUNTER",0,0,15)="There is already a Primary Provider this one is changed to Secondary^"_PXCAITEM

 +13                               SET $PIECE(PXCAENC,"^",15)="S"

                               End DoDot:2

                   End DoDot:1

 +14       SET PXCAITEM=$PIECE(PXCAENC,"^",16)

 +15       IF PXCAITEM]""

               Begin DoDot:1

 +16               IF '$$ACTIVPRV^PXAPI(PXCAITEM,PXCADT)

                       SET PXCAPERR=0

                       SET PXCA("ERROR","ENCOUNTER",0,0,16)="Attending Provider is not active or valid^"_PXCAITEM

               End DoDot:1

 +17       IF PXCABULD&PXCAPERR!PXCAERRS

               DO PROVIDER^PXCAPRV(PXCAENC)

 +18       QUIT 

 +19      ;

EVALCODE(PXCAEVAL) ;Now do the Evaluation and Management CPT

 +1        SET PXCAITEM=+$PIECE(PXCAENC,"^",5)

 +2        IF PXCAITEM

               Begin DoDot:1

 +3                NEW DIC,DR,DA,DIQ,PXCADIQ1

 +4                SET DIC=357.69

 +5                SET DR=".01;4"

 +6                SET DA=+PXCAITEM

 +7                SET DIQ="PXCADIQ1("

 +8                SET DIQ(0)="I"

 +9                DO EN^DIQ1

 +10               IF $GET(PXCADIQ1(357.69,DA,.01,"I"))=""

                       SET PXCA("ERROR","ENCOUNTER",0,0,5)="Evaluation and Management CPT code not in File 357.69^"_PXCAITEM

                       QUIT 

 +11               IF $GET(PXCADIQ1(357.69,DA,4,"I"))

                       SET PXCA("ERROR","ENCOUNTER",0,0,5)="Evaluation and Management CPT code is INACTIVE^"_PXCAITEM

                       QUIT 

 +12               SET PXCAEVAL=1

               End DoDot:1

 +13       QUIT 

 +14      ;