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

PXCACPT1.m

Go to the documentation of this file.
  1. PXCACPT1 ;ISL/dee & LEA/Chylton - Validates & Translates data from the PCE Device Interface into PCE's PXK format for CPTs ;8/1/96
  1. ;;1.0;PCE PATIENT CARE ENCOUNTER;**73**;Aug 12, 1996
  1. Q
  1. ; Variables
  1. ; PXCA Copy of PXCA array
  1. ; PXCAPROC Copy of a Procedure node of the PXCA array
  1. ; PXCAPRV Pointer to the provider (200)
  1. ; PXCANUMB Count of the number if CPTs and treatments
  1. ; PXCAINDX Count of the number of procedures for one provider
  1. ; PXCAFTER Temp used to build ^TMP(PXCAGLB,$J,"CPT",PXCANPRV,0,"AFTER")
  1. ; or to build ^TMP(PXCAGLB,$J,"TRT",PXCANPRV,0,"AFTER")
  1. ;
  1. CPT(PXCA,PXCAPROC,PXCANUMB,PXCAPRV,PXCAINDX,PXCAERRS) ;CPT
  1. N PXCAFTER,PXCACNT,PXCASTR,PXCAWARN,PXMDIEN
  1. S PXCAFTER=$P(PXCAPROC,"^",1)_"^"
  1. S PXCAFTER=PXCAFTER_PXCAPAT_"^"_PXCAVSIT_"^"
  1. S PXCAFTER=PXCAFTER_$P(PXCAPROC,"^",6)
  1. S PXCAFTER=PXCAFTER_"^"
  1. S PXCAFTER=PXCAFTER_$P(PXCAPROC,"^",5)_"^^"
  1. S PXCAFTER=PXCAFTER_$S($P(PXCAPROC,"^",3)="P":"Y",$P(PXCAPROC,"^",3)="S":"N",1:"")_"^^^^^^^^^"
  1. S PXCAFTER=PXCAFTER_$P(PXCAPROC,"^",2)
  1. S ^TMP(PXCAGLB,$J,"CPT",PXCANUMB,"IEN")=""
  1. S ^TMP(PXCAGLB,$J,"CPT",PXCANUMB,0,"BEFORE")=""
  1. S ^TMP(PXCAGLB,$J,"CPT",PXCANUMB,0,"AFTER")=PXCAFTER
  1. ;Set modifier nodes
  1. S (PXCAMOD,PXCAWARN)=""
  1. F PXCACNT=1:1 S PXCAMOD=$O(PXCA("PROCEDURE",PXCAPRV,PXCAINDX,PXCAMOD)) Q:PXCAMOD="" D
  1. . S PXMDIEN=$$MODP^ICPTMOD(+PXCAFTER,PXCAMOD,"E")
  1. . I +PXMDIEN<1 D Q
  1. .. S PXCAWARN=$S(PXCAWARN="":"",1:PXCAWARN_",")_PXCAMOD
  1. .. S PXCA("PROCEDURE",PXCAPRV,PXCAINDX,PXCAMOD)="Invalid Modifier"
  1. . S PXCASTR=$$MOD^ICPTMOD(PXMDIEN,"I")
  1. . S ^TMP(PXCAGLB,$J,"CPT",PXCANUMB,1,PXCACNT,"BEFORE")=""
  1. . S ^TMP(PXCAGLB,$J,"CPT",PXCANUMB,1,PXCACNT,"AFTER")=+PXCASTR
  1. . I PXCA("PROCEDURE",PXCAPRV,PXCAINDX,PXCAMOD)="" D
  1. .. S PXCA("PROCEDURE",PXCAPRV,PXCAINDX,PXCAMOD)=$P(PXCASTR,"^",1,3)
  1. I PXCAWARN]"" D
  1. . S PXCA("WARNING","PROCEDURE",PXCAPRV,PXCAINDX,0)="CPT Modifier(s) "_PXCAWARN_" invalid. Code(s) not stored."
  1. S ^TMP(PXCAGLB,$J,"CPT",PXCANUMB,12,"BEFORE")=""
  1. S ^TMP(PXCAGLB,$J,"CPT",PXCANUMB,12,"AFTER")=$P(PXCAPROC,"^",4)_"^^^"_$S(PXCAPRV>0:PXCAPRV,1:"")
  1. S ^TMP(PXCAGLB,$J,"CPT",PXCANUMB,802,"BEFORE")=""
  1. S ^TMP(PXCAGLB,$J,"CPT",PXCANUMB,802,"AFTER")=$P(PXCAPROC,"^",7)
  1. S ^TMP(PXCAGLB,$J,"CPT",PXCANUMB,812,"BEFORE")=""
  1. S ^TMP(PXCAGLB,$J,"CPT",PXCANUMB,812,"AFTER")="^"_PXCAPKG_"^"_PXCASOR
  1. Q
  1. ;