PXCACPT ;ISL/dee & LEA/Chylton - Validates & Translates data from the PCE Device Interface into PCE's PXK format for CPTs ;3/14/97
;;1.0;PCE PATIENT CARE ENCOUNTER;**27,33,73**;Aug 12, 1996
Q
; Variables
; PXCAPROC Copy of a Procedure node of the PXCA array
; PXCAPRV Pointer to the provider (200)
; PXCANUMB Count of the number of CPTs and treatments
; PXCAINDX Count of the number of procedures for one provider
; PXCAPNAR Pointer to the provider narrative (9999999.27)
; PXCATRT Pointer to the Treatment file (9999999.17)
;
PROC(PXCA,PXCABULD,PXCAERRS,PXCAEVAL) ;
I '$D(PXCA("PROCEDURE")),'PXCAEVAL,$P($G(^PX(815,1,"DI")),"^",1),'$D(^AUPNVCPT("AD",+PXCAVSIT)) S PXCA("WARNING","PROCEDURE",0,0,0)="PROCEDURE data missing" Q
N PXCAPROC,PXCAPRV,PXCANUMB,PXCAINDX,PXCAITEM,PXCALEN
N PXCAPNAR,PXCANARC
S PXCAPRV=""
S PXCANUMB=1
F S PXCAPRV=$O(PXCA("PROCEDURE",PXCAPRV)) Q:PXCAPRV']"" D
. I PXCAPRV>0 D
.. I '$$ACTIVPRV^PXAPI(PXCAPRV,PXCADT) S PXCA("ERROR","PROCEDURE",PXCAPRV,0,0)="Provider is not active or valid^"_PXCAPRV
. I '$T&PXCABULD!PXCAERRS D ANOTHPRV^PXCAPRV(PXCAPRV)
. S PXCAINDX=0
. F S PXCAINDX=$O(PXCA("PROCEDURE",PXCAPRV,PXCAINDX)) Q:PXCAINDX']"" D
.. N PXCATRT
.. S PXCANUMB=PXCANUMB+1
.. S PXCAPROC=$G(PXCA("PROCEDURE",PXCAPRV,PXCAINDX))
.. I PXCAPROC="" S PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,0)="PROCEDURE data missing" Q
.. S PXCAITEM=$P(PXCAPROC,U,1)
.. I PXCAITEM]"" D
... S D=$G(^ICPT(+PXCAITEM,0))
... I D="" S PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,1)="CPT code not in File 81^"_PXCAITEM
... E I '(+$$CPTSCREN^PXBUTL(PXCAITEM,+PXCADT)) S PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,1)="CPT code is INACTIVE^"_PXCAITEM
.. E D
... S PXCATRT=$O(^AUTTTRT("B",+$P(PXCAPROC,"^",6),""))
... S:PXCATRT="" PXCATRT=$O(^AUTTTRT("B","OTHER",""))
... I 'PXCATRT S PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,6)="Could not get pointer to treatment term^"_$P(PXCAPROC,"^",6)
.. S PXCAITEM=$P(PXCAPROC,U,2)
.. I PXCAITEM="" S PXCAITEM=1,$P(PXCAPROC,U,2)=PXCAITEM
.. I PXCAITEM'>0 S PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,2)="CPT Quantity must be > 0^"_PXCAITEM
.. S PXCAITEM=$P(PXCAPROC,U,3)
.. I '(PXCAITEM=""!(PXCAITEM="P")!(PXCAITEM="S")) S PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,3)="Specification code must be P|S^"_PXCAITEM
.. S PXCAITEM=+$P(PXCAPROC,U,5)
.. I PXCAITEM D
... S D=$G(^ICD9(PXCAITEM,0))
... I D="" S PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,5)="Associated Diagnosis ICD9 Code not in file 80^"_PXCAITEM
... E I $P(D,U,9) S PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,5)="Associated Diagnosis ICD9 Code is INACTIVE^"_PXCAITEM
.. S PXCAITEM=$P(PXCAPROC,U,6),PXCALEN=$L(PXCAITEM)
.. I PXCALEN<2!(PXCALEN>80) S PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,6)="Provider's PROCEDURE term must be 2-80 Characters^"_PXCAITEM
.. E D
... S PXCAPNAR=+$$PROVNARR^PXAPI(PXCAITEM,$S($P(PXCAPROC,"^",1)="":9000010.15,1:9000010.18))
... I PXCAPNAR'>0 S PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,6)="Could not get pointer to Provider's PROCEDURE term^"_$P(PXCAPROC,"^",6) Q:'PXCAERRS
... S $P(PXCAPROC,"^",6)=PXCAPNAR
.. S PXCAITEM=$P(PXCAPROC,U,7),PXCALEN=$L(PXCAITEM)
.. I PXCALEN>0 D
... I PXCALEN<2!(PXCALEN>80) S PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,7)="Provider's PROCEDURE grouper must be 2-80 Characters^"_PXCAITEM
... E D
.... S PXCANARC=+$$PROVNARR^PXAPI(PXCAITEM,$S($P(PXCAPROC,"^",1)="":9000010.15,1:9000010.18))
.... I PXCANARC'>0 S PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,7)="Could not get pointer to Provider's PROCEDURE grouper^"_PXCAITEM
.... E S $P(PXCAPROC,"^",7)=PXCANARC
.. I PXCABULD&'$D(PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX))!PXCAERRS D
... I $P(PXCAPROC,"^",1)]"" D
.... D CPT^PXCACPT1(.PXCA,PXCAPROC,PXCANUMB,PXCAPRV,PXCAINDX,PXCAERRS)
... E D TRT^PXCATRT(PXCAPROC,PXCANUMB,PXCAPRV,PXCAINDX,PXCAERRS,PXCATRT)
Q
;
PXCACPT ;ISL/dee & LEA/Chylton - Validates & Translates data from the PCE Device Interface into PCE's PXK format for CPTs ;3/14/97
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**27,33,73**;Aug 12, 1996
+2 QUIT
+3 ; Variables
+4 ; PXCAPROC Copy of a Procedure node of the PXCA array
+5 ; PXCAPRV Pointer to the provider (200)
+6 ; PXCANUMB Count of the number of CPTs and treatments
+7 ; PXCAINDX Count of the number of procedures for one provider
+8 ; PXCAPNAR Pointer to the provider narrative (9999999.27)
+9 ; PXCATRT Pointer to the Treatment file (9999999.17)
+10 ;
PROC(PXCA,PXCABULD,PXCAERRS,PXCAEVAL) ;
+1 IF '$DATA(PXCA("PROCEDURE"))
IF 'PXCAEVAL
IF $PIECE($GET(^PX(815,1,"DI")),"^",1)
IF '$DATA(^AUPNVCPT("AD",+PXCAVSIT))
SET PXCA("WARNING","PROCEDURE",0,0,0)="PROCEDURE data missing"
QUIT
+2 NEW PXCAPROC,PXCAPRV,PXCANUMB,PXCAINDX,PXCAITEM,PXCALEN
+3 NEW PXCAPNAR,PXCANARC
+4 SET PXCAPRV=""
+5 SET PXCANUMB=1
+6 FOR
SET PXCAPRV=$ORDER(PXCA("PROCEDURE",PXCAPRV))
IF PXCAPRV']""
QUIT
Begin DoDot:1
+7 IF PXCAPRV>0
Begin DoDot:2
+8 IF '$$ACTIVPRV^PXAPI(PXCAPRV,PXCADT)
SET PXCA("ERROR","PROCEDURE",PXCAPRV,0,0)="Provider is not active or valid^"_PXCAPRV
End DoDot:2
+9 IF '$TEST&PXCABULD!PXCAERRS
DO ANOTHPRV^PXCAPRV(PXCAPRV)
+10 SET PXCAINDX=0
+11 FOR
SET PXCAINDX=$ORDER(PXCA("PROCEDURE",PXCAPRV,PXCAINDX))
IF PXCAINDX']""
QUIT
Begin DoDot:2
+12 NEW PXCATRT
+13 SET PXCANUMB=PXCANUMB+1
+14 SET PXCAPROC=$GET(PXCA("PROCEDURE",PXCAPRV,PXCAINDX))
+15 IF PXCAPROC=""
SET PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,0)="PROCEDURE data missing"
QUIT
+16 SET PXCAITEM=$PIECE(PXCAPROC,U,1)
+17 IF PXCAITEM]""
Begin DoDot:3
+18 SET D=$GET(^ICPT(+PXCAITEM,0))
+19 IF D=""
SET PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,1)="CPT code not in File 81^"_PXCAITEM
+20 IF '$TEST
IF '(+$$CPTSCREN^PXBUTL(PXCAITEM,+PXCADT))
SET PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,1)="CPT code is INACTIVE^"_PXCAITEM
End DoDot:3
+21 IF '$TEST
Begin DoDot:3
+22 SET PXCATRT=$ORDER(^AUTTTRT("B",+$PIECE(PXCAPROC,"^",6),""))
+23 IF PXCATRT=""
SET PXCATRT=$ORDER(^AUTTTRT("B","OTHER",""))
+24 IF 'PXCATRT
SET PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,6)="Could not get pointer to treatment term^"_$PIECE(PXCAPROC,"^",6)
End DoDot:3
+25 SET PXCAITEM=$PIECE(PXCAPROC,U,2)
+26 IF PXCAITEM=""
SET PXCAITEM=1
SET $PIECE(PXCAPROC,U,2)=PXCAITEM
+27 IF PXCAITEM'>0
SET PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,2)="CPT Quantity must be > 0^"_PXCAITEM
+28 SET PXCAITEM=$PIECE(PXCAPROC,U,3)
+29 IF '(PXCAITEM=""!(PXCAITEM="P")!(PXCAITEM="S"))
SET PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,3)="Specification code must be P|S^"_PXCAITEM
+30 SET PXCAITEM=+$PIECE(PXCAPROC,U,5)
+31 IF PXCAITEM
Begin DoDot:3
+32 SET D=$GET(^ICD9(PXCAITEM,0))
+33 IF D=""
SET PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,5)="Associated Diagnosis ICD9 Code not in file 80^"_PXCAITEM
+34 IF '$TEST
IF $PIECE(D,U,9)
SET PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,5)="Associated Diagnosis ICD9 Code is INACTIVE^"_PXCAITEM
End DoDot:3
+35 SET PXCAITEM=$PIECE(PXCAPROC,U,6)
SET PXCALEN=$LENGTH(PXCAITEM)
+36 IF PXCALEN<2!(PXCALEN>80)
SET PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,6)="Provider's PROCEDURE term must be 2-80 Characters^"_PXCAITEM
+37 IF '$TEST
Begin DoDot:3
+38 SET PXCAPNAR=+$$PROVNARR^PXAPI(PXCAITEM,$SELECT($PIECE(PXCAPROC,"^",1)="":9000010.15,1:9000010.18))
+39 IF PXCAPNAR'>0
SET PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,6)="Could not get pointer to Provider's PROCEDURE term^"_$PIECE(PXCAPROC,"^",6)
IF 'PXCAERRS
QUIT
+40 SET $PIECE(PXCAPROC,"^",6)=PXCAPNAR
End DoDot:3
+41 SET PXCAITEM=$PIECE(PXCAPROC,U,7)
SET PXCALEN=$LENGTH(PXCAITEM)
+42 IF PXCALEN>0
Begin DoDot:3
+43 IF PXCALEN<2!(PXCALEN>80)
SET PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,7)="Provider's PROCEDURE grouper must be 2-80 Characters^"_PXCAITEM
+44 IF '$TEST
Begin DoDot:4
+45 SET PXCANARC=+$$PROVNARR^PXAPI(PXCAITEM,$SELECT($PIECE(PXCAPROC,"^",1)="":9000010.15,1:9000010.18))
+46 IF PXCANARC'>0
SET PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,7)="Could not get pointer to Provider's PROCEDURE grouper^"_PXCAITEM
+47 IF '$TEST
SET $PIECE(PXCAPROC,"^",7)=PXCANARC
End DoDot:4
End DoDot:3
+48 IF PXCABULD&'$DATA(PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX))!PXCAERRS
Begin DoDot:3
+49 IF $PIECE(PXCAPROC,"^",1)]""
Begin DoDot:4
+50 DO CPT^PXCACPT1(.PXCA,PXCAPROC,PXCANUMB,PXCAPRV,PXCAINDX,PXCAERRS)
End DoDot:4
+51 IF '$TEST
DO TRT^PXCATRT(PXCAPROC,PXCANUMB,PXCAPRV,PXCAINDX,PXCAERRS,PXCATRT)
End DoDot:3
End DoDot:2
End DoDot:1
+52 QUIT
+53 ;
