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,121,124**;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_$P(PXCAPROC,"^",5)_"^^" ;1ST Dx
S PXCAFTER=PXCAFTER_$S($P(PXCAPROC,"^",3)="P":"Y",$P(PXCAPROC,"^",3)="S":"N",1:"")_"^^"
S PXCAFTER=PXCAFTER_$P(PXCAPROC,"^",8)_"^" ;2nd Dx
S PXCAFTER=PXCAFTER_$P(PXCAPROC,"^",9)_"^" ;3rd Dx
S PXCAFTER=PXCAFTER_$P(PXCAPROC,"^",10)_"^" ;4th Dx
S PXCAFTER=PXCAFTER_$P(PXCAPROC,"^",11)_"^" ;5th Dx
S PXCAFTER=PXCAFTER_$P(PXCAPROC,"^",12)_"^" ;6th Dx
S PXCAFTER=PXCAFTER_$P(PXCAPROC,"^",13)_"^" ;7th Dx
S PXCAFTER=PXCAFTER_$P(PXCAPROC,"^",14)_"^" ;8th Dx
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
IF $P(PXCAFTER,"^",5)]"" D ANOTHPOV^PXCAPOV($P(PXCAFTER,"^",5))
IF $P(PXCAFTER,"^",9)]"" D ANOTHPOV^PXCAPOV($P(PXCAFTER,"^",9))
IF $P(PXCAFTER,"^",10)]"" D ANOTHPOV^PXCAPOV($P(PXCAFTER,"^",10))
IF $P(PXCAFTER,"^",11)]"" D ANOTHPOV^PXCAPOV($P(PXCAFTER,"^",11))
IF $P(PXCAFTER,"^",12)]"" D ANOTHPOV^PXCAPOV($P(PXCAFTER,"^",12))
IF $P(PXCAFTER,"^",13)]"" D ANOTHPOV^PXCAPOV($P(PXCAFTER,"^",13))
IF $P(PXCAFTER,"^",14)]"" D ANOTHPOV^PXCAPOV($P(PXCAFTER,"^",14))
IF $P(PXCAFTER,"^",15)]"" D ANOTHPOV^PXCAPOV($P(PXCAFTER,"^",15))
;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",PXCADT)
. 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",PXCADT)
. 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
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXCACPT1 3291 printed Oct 16, 2024@18:28:09 Page 2
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,121,124**;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 ;1ST Dx
SET PXCAFTER=PXCAFTER_$PIECE(PXCAPROC,"^",5)_"^^"
+6 SET PXCAFTER=PXCAFTER_$SELECT($PIECE(PXCAPROC,"^",3)="P":"Y",$PIECE(PXCAPROC,"^",3)="S":"N",1:"")_"^^"
+7 ;2nd Dx
SET PXCAFTER=PXCAFTER_$PIECE(PXCAPROC,"^",8)_"^"
+8 ;3rd Dx
SET PXCAFTER=PXCAFTER_$PIECE(PXCAPROC,"^",9)_"^"
+9 ;4th Dx
SET PXCAFTER=PXCAFTER_$PIECE(PXCAPROC,"^",10)_"^"
+10 ;5th Dx
SET PXCAFTER=PXCAFTER_$PIECE(PXCAPROC,"^",11)_"^"
+11 ;6th Dx
SET PXCAFTER=PXCAFTER_$PIECE(PXCAPROC,"^",12)_"^"
+12 ;7th Dx
SET PXCAFTER=PXCAFTER_$PIECE(PXCAPROC,"^",13)_"^"
+13 ;8th Dx
SET PXCAFTER=PXCAFTER_$PIECE(PXCAPROC,"^",14)_"^"
+14 SET PXCAFTER=PXCAFTER_$PIECE(PXCAPROC,"^",2)
+15 SET ^TMP(PXCAGLB,$JOB,"CPT",PXCANUMB,"IEN")=""
+16 SET ^TMP(PXCAGLB,$JOB,"CPT",PXCANUMB,0,"BEFORE")=""
+17 SET ^TMP(PXCAGLB,$JOB,"CPT",PXCANUMB,0,"AFTER")=PXCAFTER
+18 IF $PIECE(PXCAFTER,"^",5)]""
DO ANOTHPOV^PXCAPOV($PIECE(PXCAFTER,"^",5))
+19 IF $PIECE(PXCAFTER,"^",9)]""
DO ANOTHPOV^PXCAPOV($PIECE(PXCAFTER,"^",9))
+20 IF $PIECE(PXCAFTER,"^",10)]""
DO ANOTHPOV^PXCAPOV($PIECE(PXCAFTER,"^",10))
+21 IF $PIECE(PXCAFTER,"^",11)]""
DO ANOTHPOV^PXCAPOV($PIECE(PXCAFTER,"^",11))
+22 IF $PIECE(PXCAFTER,"^",12)]""
DO ANOTHPOV^PXCAPOV($PIECE(PXCAFTER,"^",12))
+23 IF $PIECE(PXCAFTER,"^",13)]""
DO ANOTHPOV^PXCAPOV($PIECE(PXCAFTER,"^",13))
+24 IF $PIECE(PXCAFTER,"^",14)]""
DO ANOTHPOV^PXCAPOV($PIECE(PXCAFTER,"^",14))
+25 IF $PIECE(PXCAFTER,"^",15)]""
DO ANOTHPOV^PXCAPOV($PIECE(PXCAFTER,"^",15))
+26 ;Set modifier nodes
+27 SET (PXCAMOD,PXCAWARN)=""
+28 FOR PXCACNT=1:1
SET PXCAMOD=$ORDER(PXCA("PROCEDURE",PXCAPRV,PXCAINDX,PXCAMOD))
if PXCAMOD=""
QUIT
Begin DoDot:1
+29 SET PXMDIEN=$$MODP^ICPTMOD(+PXCAFTER,PXCAMOD,"E",PXCADT)
+30 IF +PXMDIEN<1
Begin DoDot:2
+31 SET PXCAWARN=$SELECT(PXCAWARN="":"",1:PXCAWARN_",")_PXCAMOD
+32 SET PXCA("PROCEDURE",PXCAPRV,PXCAINDX,PXCAMOD)="Invalid Modifier"
End DoDot:2
QUIT
+33 SET PXCASTR=$$MOD^ICPTMOD(PXMDIEN,"I",PXCADT)
+34 SET ^TMP(PXCAGLB,$JOB,"CPT",PXCANUMB,1,PXCACNT,"BEFORE")=""
+35 SET ^TMP(PXCAGLB,$JOB,"CPT",PXCANUMB,1,PXCACNT,"AFTER")=+PXCASTR
+36 IF PXCA("PROCEDURE",PXCAPRV,PXCAINDX,PXCAMOD)=""
Begin DoDot:2
+37 SET PXCA("PROCEDURE",PXCAPRV,PXCAINDX,PXCAMOD)=$PIECE(PXCASTR,"^",1,3)
End DoDot:2
End DoDot:1
+38 IF PXCAWARN]""
Begin DoDot:1
+39 SET PXCA("WARNING","PROCEDURE",PXCAPRV,PXCAINDX,0)="CPT Modifier(s) "_PXCAWARN_" invalid. Code(s) not stored."
End DoDot:1
+40 SET ^TMP(PXCAGLB,$JOB,"CPT",PXCANUMB,12,"BEFORE")=""
+41 SET ^TMP(PXCAGLB,$JOB,"CPT",PXCANUMB,12,"AFTER")=$PIECE(PXCAPROC,"^",4)_"^^^"_$SELECT(PXCAPRV>0:PXCAPRV,1:"")
+42 SET ^TMP(PXCAGLB,$JOB,"CPT",PXCANUMB,802,"BEFORE")=""
+43 SET ^TMP(PXCAGLB,$JOB,"CPT",PXCANUMB,802,"AFTER")=$PIECE(PXCAPROC,"^",7)
+44 SET ^TMP(PXCAGLB,$JOB,"CPT",PXCANUMB,812,"BEFORE")=""
+45 SET ^TMP(PXCAGLB,$JOB,"CPT",PXCANUMB,812,"AFTER")="^"_PXCAPKG_"^"_PXCASOR
+46 QUIT
+47 ;
