PXCACPT1.m

PXCACPT1 ;ISL/dee & LEA/Chylton - Validates & Translates data from the PCE Device Interface into PCE's PXK format for CPTs ;8/1/96

 ;;1.0;PCE PATIENT CARE ENCOUNTER;**73**;Aug 12, 1996

 Q

 ; Variables

 ;   PXCA      Copy of PXCA array

 ;   PXCAPROC  Copy of a Procedure node of the PXCA array

 ;   PXCAPRV   Pointer to the provider (200)

 ;   PXCANUMB  Count of the number if CPTs and treatments

 ;   PXCAINDX  Count of the number of procedures for one provider

 ;   PXCAFTER  Temp used to build ^TMP(PXCAGLB,$J,"CPT",PXCANPRV,0,"AFTER")

 ;               or to build ^TMP(PXCAGLB,$J,"TRT",PXCANPRV,0,"AFTER")

 ;

CPT(PXCA,PXCAPROC,PXCANUMB,PXCAPRV,PXCAINDX,PXCAERRS) ;CPT

 N PXCAFTER,PXCACNT,PXCASTR,PXCAWARN,PXMDIEN

 S PXCAFTER=$P(PXCAPROC,"^",1)_"^"

 S PXCAFTER=PXCAFTER_PXCAPAT_"^"_PXCAVSIT_"^"

 S PXCAFTER=PXCAFTER_$P(PXCAPROC,"^",6)

 S PXCAFTER=PXCAFTER_"^"

 S PXCAFTER=PXCAFTER_$P(PXCAPROC,"^",5)_"^^"

 S PXCAFTER=PXCAFTER_$S($P(PXCAPROC,"^",3)="P":"Y",$P(PXCAPROC,"^",3)="S":"N",1:"")_"^^^^^^^^^"

 S PXCAFTER=PXCAFTER_$P(PXCAPROC,"^",2)

 S ^TMP(PXCAGLB,$J,"CPT",PXCANUMB,"IEN")=""

 S ^TMP(PXCAGLB,$J,"CPT",PXCANUMB,0,"BEFORE")=""

 S ^TMP(PXCAGLB,$J,"CPT",PXCANUMB,0,"AFTER")=PXCAFTER

 ;Set modifier nodes

 S (PXCAMOD,PXCAWARN)=""

 F PXCACNT=1:1 S PXCAMOD=$O(PXCA("PROCEDURE",PXCAPRV,PXCAINDX,PXCAMOD)) Q:PXCAMOD=""  D

 . S PXMDIEN=$$MODP^ICPTMOD(+PXCAFTER,PXCAMOD,"E")

 . I +PXMDIEN<1 D  Q

 .. S PXCAWARN=$S(PXCAWARN="":"",1:PXCAWARN_",")_PXCAMOD

 .. S PXCA("PROCEDURE",PXCAPRV,PXCAINDX,PXCAMOD)="Invalid Modifier"

 . S PXCASTR=$$MOD^ICPTMOD(PXMDIEN,"I")

 . S ^TMP(PXCAGLB,$J,"CPT",PXCANUMB,1,PXCACNT,"BEFORE")=""

 . S ^TMP(PXCAGLB,$J,"CPT",PXCANUMB,1,PXCACNT,"AFTER")=+PXCASTR

 . I PXCA("PROCEDURE",PXCAPRV,PXCAINDX,PXCAMOD)="" D

 .. S PXCA("PROCEDURE",PXCAPRV,PXCAINDX,PXCAMOD)=$P(PXCASTR,"^",1,3)

 I PXCAWARN]"" D

 . S PXCA("WARNING","PROCEDURE",PXCAPRV,PXCAINDX,0)="CPT Modifier(s) "_PXCAWARN_" invalid. Code(s) not stored."

 S ^TMP(PXCAGLB,$J,"CPT",PXCANUMB,12,"BEFORE")=""

 S ^TMP(PXCAGLB,$J,"CPT",PXCANUMB,12,"AFTER")=$P(PXCAPROC,"^",4)_"^^^"_$S(PXCAPRV>0:PXCAPRV,1:"")

 S ^TMP(PXCAGLB,$J,"CPT",PXCANUMB,802,"BEFORE")=""

 S ^TMP(PXCAGLB,$J,"CPT",PXCANUMB,802,"AFTER")=$P(PXCAPROC,"^",7)

 S ^TMP(PXCAGLB,$J,"CPT",PXCANUMB,812,"BEFORE")=""

 S ^TMP(PXCAGLB,$J,"CPT",PXCANUMB,812,"AFTER")="^"_PXCAPKG_"^"_PXCASOR

 Q

 ;

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

 +2        QUIT 

 +3       ; Variables

 +4       ;   PXCA      Copy of PXCA array

 +5       ;   PXCAPROC  Copy of a Procedure node of the PXCA array

 +6       ;   PXCAPRV   Pointer to the provider (200)

 +7       ;   PXCANUMB  Count of the number if CPTs and treatments

 +8       ;   PXCAINDX  Count of the number of procedures for one provider

 +9       ;   PXCAFTER  Temp used to build ^TMP(PXCAGLB,$J,"CPT",PXCANPRV,0,"AFTER")

 +10      ;               or to build ^TMP(PXCAGLB,$J,"TRT",PXCANPRV,0,"AFTER")

 +11      ;

CPT(PXCA,PXCAPROC,PXCANUMB,PXCAPRV,PXCAINDX,PXCAERRS) ;CPT

 +1        NEW PXCAFTER,PXCACNT,PXCASTR,PXCAWARN,PXMDIEN

 +2        SET PXCAFTER=$PIECE(PXCAPROC,"^",1)_"^"

 +3        SET PXCAFTER=PXCAFTER_PXCAPAT_"^"_PXCAVSIT_"^"

 +4        SET PXCAFTER=PXCAFTER_$PIECE(PXCAPROC,"^",6)

 +5        SET PXCAFTER=PXCAFTER_"^"

 +6        SET PXCAFTER=PXCAFTER_$PIECE(PXCAPROC,"^",5)_"^^"

 +7        SET PXCAFTER=PXCAFTER_$SELECT($PIECE(PXCAPROC,"^",3)="P":"Y",$PIECE(PXCAPROC,"^",3)="S":"N",1:"")_"^^^^^^^^^"

 +8        SET PXCAFTER=PXCAFTER_$PIECE(PXCAPROC,"^",2)

 +9        SET ^TMP(PXCAGLB,$JOB,"CPT",PXCANUMB,"IEN")=""

 +10       SET ^TMP(PXCAGLB,$JOB,"CPT",PXCANUMB,0,"BEFORE")=""

 +11       SET ^TMP(PXCAGLB,$JOB,"CPT",PXCANUMB,0,"AFTER")=PXCAFTER

 +12      ;Set modifier nodes

 +13       SET (PXCAMOD,PXCAWARN)=""

 +14       FOR PXCACNT=1:1

               SET PXCAMOD=$ORDER(PXCA("PROCEDURE",PXCAPRV,PXCAINDX,PXCAMOD))

               IF PXCAMOD=""

                   QUIT 

               Begin DoDot:1

 +15               SET PXMDIEN=$$MODP^ICPTMOD(+PXCAFTER,PXCAMOD,"E")

 +16               IF +PXMDIEN<1

                       Begin DoDot:2

 +17                       SET PXCAWARN=$SELECT(PXCAWARN="":"",1:PXCAWARN_",")_PXCAMOD

 +18                       SET PXCA("PROCEDURE",PXCAPRV,PXCAINDX,PXCAMOD)="Invalid Modifier"

                       End DoDot:2

                       QUIT 

 +19               SET PXCASTR=$$MOD^ICPTMOD(PXMDIEN,"I")

 +20               SET ^TMP(PXCAGLB,$JOB,"CPT",PXCANUMB,1,PXCACNT,"BEFORE")=""

 +21               SET ^TMP(PXCAGLB,$JOB,"CPT",PXCANUMB,1,PXCACNT,"AFTER")=+PXCASTR

 +22               IF PXCA("PROCEDURE",PXCAPRV,PXCAINDX,PXCAMOD)=""

                       Begin DoDot:2

 +23                       SET PXCA("PROCEDURE",PXCAPRV,PXCAINDX,PXCAMOD)=$PIECE(PXCASTR,"^",1,3)

                       End DoDot:2

               End DoDot:1

 +24       IF PXCAWARN]""

               Begin DoDot:1

 +25               SET PXCA("WARNING","PROCEDURE",PXCAPRV,PXCAINDX,0)="CPT Modifier(s) "_PXCAWARN_" invalid. Code(s) not stored."

               End DoDot:1

 +26       SET ^TMP(PXCAGLB,$JOB,"CPT",PXCANUMB,12,"BEFORE")=""

 +27       SET ^TMP(PXCAGLB,$JOB,"CPT",PXCANUMB,12,"AFTER")=$PIECE(PXCAPROC,"^",4)_"^^^"_$SELECT(PXCAPRV>0:PXCAPRV,1:"")

 +28       SET ^TMP(PXCAGLB,$JOB,"CPT",PXCANUMB,802,"BEFORE")=""

 +29       SET ^TMP(PXCAGLB,$JOB,"CPT",PXCANUMB,802,"AFTER")=$PIECE(PXCAPROC,"^",7)

 +30       SET ^TMP(PXCAGLB,$JOB,"CPT",PXCANUMB,812,"BEFORE")=""

 +31       SET ^TMP(PXCAGLB,$JOB,"CPT",PXCANUMB,812,"AFTER")="^"_PXCAPKG_"^"_PXCASOR

 +32       QUIT 

 +33      ;