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
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXCAVST2 1780 printed Dec 13, 2024@02:27:47 Page 2
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 ;
