Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXCACPT

PXCACPT.m

Go to the documentation of this file.
  1. PXCACPT ;ISL/dee & LEA/Chylton,SCK - Validates & Translates data from the PCE Device Interface into PCE's PXK format for CPTs ;5/24/04 3:51pm
  1. ;;1.0;PCE PATIENT CARE ENCOUNTER;**27,33,73,121,124,194,199**;Aug 12, 1996;Build 51
  1. Q
  1. ; Variables
  1. ; PXCAPROC Copy of a Procedure node of the PXCA array
  1. ; PXCAPRV Pointer to the provider (200)
  1. ; PXCANUMB Count of the number of CPTs and treatments
  1. ; PXCAINDX Count of the number of procedures for one provider
  1. ; PXCAPNAR Pointer to the provider narrative (9999999.27)
  1. ; PXCATRT Pointer to the Treatment file (9999999.17)
  1. ;
  1. PROC(PXCA,PXCABULD,PXCAERRS,PXCAEVAL) ;
  1. 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
  1. N PXCAINDX,PXCAITEM,PXCALEN,PXCANARC,PXCANUMB,PXCAPNAR,PXCAPROC,PXCAPRV,PXDXDATE
  1. S PXDXDATE=$$CSDATE^PXDXUTL(PXCAVSIT) ; Date to use in $$ICDDATA^ICDXCODE calls
  1. S PXCAPRV="",PXCANUMB=1
  1. F S PXCAPRV=$O(PXCA("PROCEDURE",PXCAPRV)) Q:PXCAPRV']"" D
  1. . I PXCAPRV>0 D
  1. .. I '$$ACTIVPRV^PXAPI(PXCAPRV,PXCADT) S PXCA("ERROR","PROCEDURE",PXCAPRV,0,0)="Provider is not active or valid^"_PXCAPRV
  1. . I '$T&PXCABULD!PXCAERRS D ANOTHPRV^PXCAPRV(PXCAPRV)
  1. . S PXCAINDX=0
  1. . F S PXCAINDX=$O(PXCA("PROCEDURE",PXCAPRV,PXCAINDX)) Q:PXCAINDX']"" D
  1. .. N PXCATRT
  1. .. S PXCANUMB=PXCANUMB+1
  1. .. S PXCAPROC=$G(PXCA("PROCEDURE",PXCAPRV,PXCAINDX))
  1. .. I PXCAPROC="" S PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,0)="PROCEDURE data missing" Q
  1. .. S PXCAITEM=$P(PXCAPROC,U,1)
  1. .. I PXCAITEM]"" D
  1. ... S D=$$CPT^ICPTCOD(+PXCAITEM)
  1. ... I D<0 S PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,1)="CPT code not in File 81^"_PXCAITEM
  1. ... E I '(+$$CPTSCREN^PXBUTL(PXCAITEM,+PXCADT)) S PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,1)="CPT code is INACTIVE^"_PXCAITEM
  1. .. E D
  1. ... S PXCATRT=$O(^AUTTTRT("B",+$P(PXCAPROC,"^",6),""))
  1. ... S:PXCATRT="" PXCATRT=$O(^AUTTTRT("B","OTHER",""))
  1. ... I 'PXCATRT S PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,6)="Could not get pointer to treatment term^"_$P(PXCAPROC,"^",6)
  1. .. S PXCAITEM=$P(PXCAPROC,U,2)
  1. .. I PXCAITEM="" S PXCAITEM=1,$P(PXCAPROC,U,2)=PXCAITEM
  1. .. I PXCAITEM'>0 S PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,2)="CPT Quantity must be > 0^"_PXCAITEM
  1. .. S PXCAITEM=$P(PXCAPROC,U,3)
  1. .. I '(PXCAITEM=""!(PXCAITEM="P")!(PXCAITEM="S")) S PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,3)="Specification code must be P|S^"_PXCAITEM
  1. .. S PXCAITEM=+$P(PXCAPROC,U,5)
  1. .. I PXCAITEM D
  1. ... S D=$$ICDDATA^ICDXCODE("DIAG",PXCAITEM,PXDXDATE,"I")
  1. ... I $P(D,U,1)'>0 S PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,5)="Associated Primary Diagnosis ICD Code not in File 80^"_PXCAITEM
  1. ... E I $P(D,U,10)'=1 S PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,1)="Associated Primary Diagnosis ICD code is INACTIVE^"_PXCAITEM
  1. .. S PXCAITEM=+$P(PXCAPROC,U,8)
  1. .. I PXCAITEM D
  1. ... S D=$$ICDDATA^ICDXCODE("DIAG",PXCAITEM,PXDXDATE,"I")
  1. ... I $P(D,U,1)'>0 S PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,8)="Associated Diagnosis 2 ICD Code not in file 80^"_PXCAITEM
  1. ... E I $P(D,U,10)'=1 S PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,8)="Associated Diagnosis 2 ICD Code is INACTIVE^"_PXCAITEM
  1. .. S PXCAITEM=+$P(PXCAPROC,U,9)
  1. .. I PXCAITEM D
  1. ... S D=$$ICDDATA^ICDXCODE("DIAG",PXCAITEM,PXDXDATE,"I")
  1. ... I $P(D,U,1)'>0 S PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,9)="Associated Diagnosis 3 ICD Code not in file 80^"_PXCAITEM
  1. ... E I $P(D,U,10)'=1 S PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,9)="Associated Diagnosis 3 ICD Code is INACTIVE^"_PXCAITEM
  1. .. S PXCAITEM=+$P(PXCAPROC,U,10)
  1. .. I PXCAITEM D
  1. ... S D=$$ICDDATA^ICDXCODE("DIAG",PXCAITEM,PXDXDATE,"I")
  1. ... I $P(D,U,1)'>0 S PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,10)="Associated Diagnosis 4 ICD Code not in file 80^"_PXCAITEM
  1. ... E I $P(D,U,10)'=1 S PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,10)="Associated Diagnosis 4 ICD Code is INACTIVE^"_PXCAITEM
  1. .. S PXCAITEM=+$P(PXCAPROC,U,11)
  1. .. I PXCAITEM D
  1. ... S D=$$ICDDATA^ICDXCODE("DIAG",PXCAITEM,PXDXDATE,"I")
  1. ... I $P(D,U,1)'>0 S PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,11)="Associated Diagnosis 5 ICD Code not in file 80^"_PXCAITEM
  1. ... E I $P(D,U,10)'=1 S PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,11)="Associated Diagnosis 5 ICD Code is INACTIVE^"_PXCAITEM
  1. .. S PXCAITEM=+$P(PXCAPROC,U,12)
  1. .. I PXCAITEM D
  1. ... S D=$$ICDDATA^ICDXCODE("DIAG",PXCAITEM,PXDXDATE,"I")
  1. ... I $P(D,U,1)'>0 S PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,12)="Associated Diagnosis 6 ICD Code not in file 80^"_PXCAITEM
  1. ... E I $P(D,U,10)'=1 S PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,12)="Associated Diagnosis 6 ICD Code is INACTIVE^"_PXCAITEM
  1. .. S PXCAITEM=+$P(PXCAPROC,U,13)
  1. .. I PXCAITEM D
  1. ... S D=$$ICDDATA^ICDXCODE("DIAG",PXCAITEM,PXDXDATE,"I")
  1. ... I $P(D,U,1)'>0 S PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,13)="Associated Diagnosis 7 ICD Code not in file 80^"_PXCAITEM
  1. ... E I $P(D,U,10)'=1 S PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,13)="Associated Diagnosis 7 ICD Code is INACTIVE^"_PXCAITEM
  1. .. S PXCAITEM=+$P(PXCAPROC,U,14)
  1. .. I PXCAITEM D
  1. ... S D=$$ICDDATA^ICDXCODE("DIAG",PXCAITEM,PXDXDATE,"I")
  1. ... I $P(D,U,1)'>0 S PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,14)="Associated Diagnosis 8 ICD Code not in file 80^"_PXCAITEM
  1. ... E I $P(D,U,10)'=1 S PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,14)="Associated Diagnosis 8 ICD Code is INACTIVE^"_PXCAITEM
  1. .. S PXCAITEM=$P(PXCAPROC,U,6),PXCALEN=$L(PXCAITEM)
  1. .. I PXCALEN<2!(PXCALEN>80) S PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,6)="Provider's PROCEDURE term must be 2-80 Characters^"_PXCAITEM
  1. .. E D
  1. ... S PXCAPNAR=+$$PROVNARR^PXAPI(PXCAITEM,$S($P(PXCAPROC,"^",1)="":9000010.15,1:9000010.18))
  1. ... I PXCAPNAR'>0 S PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,6)="Could not get pointer to Provider's PROCEDURE term^"_$P(PXCAPROC,"^",6) Q:'PXCAERRS
  1. ... S $P(PXCAPROC,"^",6)=PXCAPNAR
  1. .. S PXCAITEM=$P(PXCAPROC,U,7),PXCALEN=$L(PXCAITEM)
  1. .. I PXCALEN>0 D
  1. ... I PXCALEN<2!(PXCALEN>80) S PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,7)="Provider's PROCEDURE grouper must be 2-80 Characters^"_PXCAITEM
  1. ... E D
  1. .... S PXCANARC=+$$PROVNARR^PXAPI(PXCAITEM,$S($P(PXCAPROC,"^",1)="":9000010.15,1:9000010.18))
  1. .... I PXCANARC'>0 S PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX,7)="Could not get pointer to Provider's PROCEDURE grouper^"_PXCAITEM
  1. .... E S $P(PXCAPROC,"^",7)=PXCANARC
  1. .. I PXCABULD&'$D(PXCA("ERROR","PROCEDURE",PXCAPRV,PXCAINDX))!PXCAERRS D
  1. ... I $P(PXCAPROC,"^",1)]"" D
  1. .... D CPT^PXCACPT1(.PXCA,PXCAPROC,PXCANUMB,PXCAPRV,PXCAINDX,PXCAERRS)
  1. ... E D TRT^PXCATRT(PXCAPROC,PXCANUMB,PXCAPRV,PXCAINDX,PXCAERRS,PXCATRT)
  1. Q
  1. ;