PXAICPT ;ISL/JVS,PKR,ISA/KWP,ESW,SCK - SET THE PROCEDURE(CPT) NODES ;01/26/2021
;;1.0;PCE PATIENT CARE ENCOUNTER;**19,73,108,112,149,124,164,194,211**;Aug 12, 1996;Build 454
;
Q
CPT ;
SET ;--SET AND NEW VARIABLES
N AFTER0,AFTER1,AFTER12,AFTER801,AFTER802,AFTER811,AFTER812
N BEFOR0,BEFOR1,BEFOR12,BEFOR801,BEFOR802,BEFOR811,BEFOR812
N EVENTDT,PXAA,PXAB,SUB,PIECE,IENB,STOP
K PXAERR
S PXAERR(8)=PXAK
S PXAERR(7)="PROCEDURE"
;
S SUB="" F S SUB=$O(@PXADATA@("PROCEDURE",PXAK,SUB)) Q:SUB="" D
.S PXAA(SUB)=$G(@PXADATA@("PROCEDURE",PXAK,SUB))
;Setup PXAA array for Modifiers
S SUB=""
F S SUB=$O(@PXADATA@("PROCEDURE",PXAK,"MODIFIERS",SUB)) Q:SUB="" D
.S PXAA("MODIFIERS",SUB)=""
;
VAL ;--VALIDATE ENOUGH DATA
D VAL^PXAICPTV Q:$G(STOP)
;
SETVARA ;--SET V CPT VARIABLES
S $P(AFTER0,U,1)=$G(PXAA("PROCEDURE"))
I $G(PXAA("DELETE")) S $P(AFTER0,U,1)="@"
S $P(AFTER0,U,2)=$G(PATIENT)
S $P(AFTER0,U,3)=$G(PXAVISIT)
;If Provider Narrative is not passed or is too long use the
;CPT short description.
I ($G(PXAA("NARRATIVE"))="")!($L($G(PXAA("NARRATIVE")))>245) D
.S EVENTDT=$G(PXAA("EVENT D/T"))
.I EVENTDT="" S EVENTDT=$P(^AUPNVSIT(PXAVISIT,0),U,1)
.S PXAA("NARRATIVE")=$P($$CPT^ICPTCOD($G(PXAA("PROCEDURE")),EVENTDT),U,3)
;Get the Provider Narrative pointer.
S $P(AFTER0,U,4)=+$$PROVNARR^PXAPI($G(PXAA("NARRATIVE")),9000010.18)
I $P(AFTER0,U,4)'>0 D VAL04^PXAICPTV,ERR^PXAI("NARRATIVE",1) Q:$D(STOP)
S $P(AFTER0,U,5)=$G(PXAA("DIAGNOSIS"))
;PX*1*124 - add dx
S $P(AFTER0,U,9)=$G(PXAA("DIAGNOSIS 2"))
S $P(AFTER0,U,10)=$G(PXAA("DIAGNOSIS 3"))
S $P(AFTER0,U,11)=$G(PXAA("DIAGNOSIS 4"))
S $P(AFTER0,U,12)=$G(PXAA("DIAGNOSIS 5"))
S $P(AFTER0,U,13)=$G(PXAA("DIAGNOSIS 6"))
S $P(AFTER0,U,14)=$G(PXAA("DIAGNOSIS 7"))
S $P(AFTER0,U,15)=$G(PXAA("DIAGNOSIS 8"))
I $G(PXAA("QTY"))="" S PXAA("QTY")=1
S $P(AFTER0,U,16)=$G(PXAA("QTY")) I $G(PXAA("QTY"))<1 S PXAA("DELETE")=1
S $P(AFTER0,U,17)=$G(PXAA("ORD REFERENCE"))
I $$SWSTAT^IBBAPI() D ;PX*1.0*164
. S $P(AFTER0,U,19)=$G(PXAA("DEPARTMENT"))
. I $P(AFTER0,U,19)="",$G(^AUPNVSIT(PXAVISIT,0)),$P(^AUPNVSIT(PXAVISIT,0),U,8) S $P(AFTER0,U,19)=$P($G(^DIC(40.7,$P(^AUPNVSIT(PXAVISIT,0),U,8),0)),U,2)
;
S $P(AFTER12,U,1)=$G(PXAA("EVENT D/T"))
;PX*1*124 - add ord prv
S $P(AFTER12,U,2)=$G(PXAA("ORD PROVIDER"))
S $P(AFTER12,U,4)=$G(PXAA("ENC PROVIDER"))
;PX*1*108 - do not try to file a provider from a "DELETED" cpt
I $G(PXAA("ENC PROVIDER"))]"",'$G(PXAA("DELETE")) D
.S ^TMP("PXAIADDPRV",$J,$G(PXAA("ENC PROVIDER")))="ENC"
;PX*1*124 - do not try to file a provider from a "DELETED" cpt
I $G(PXAA("ORD PROVIDER"))]"",'$G(PXAA("DELETE")) D
.S ^TMP("PXAIADDPRV",$J,$G(PXAA("ORD PROVIDER")))="ORD"
;
I $G(PXAA("CATEGORY"))="" S $P(AFTER802,U,1)=""
E D
. S $P(AFTER802,U,1)=+$$PROVNARR^PXAPI(PXAA("CATEGORY"),9000010.18)
. I $P(AFTER802,U,1)'>0 D
.. D VAL802^PXAICPTV,ERR^PXAI("CATEGORY",1)
.. S $P(AFTER802,U,1)=""
;
S $P(AFTER811,U,1)=$G(PXAA("COMMENT"))
;
;--PACKAGE AND SOURCE
S $P(AFTER812,U,2)=$S($G(PXAA("PKG"))'="":PXAA("PKG"),1:$G(PXAPKG))
S $P(AFTER812,U,3)=$S($G(PXAA("SOURCE"))'="":PXAA("SOURCE"),1:$G(PXASOURC))
;
N PXBKY,PXBSAM,PXBSKY,PXBCNT,PXI,PRV,ITEM
D CPT^PXBGCPT(PXAVISIT)
S ITEM=""
I PXBCNT>0,$G(PXAA("PROCEDURE"))]"" S ITEM=$O(PXBKY(PXAA("PROCEDURE"),0))
S IENB=+$S(ITEM'="":$O(PXBSKY(ITEM,"")),1:0)
;
SETPXKA ;--SET PXK ARRAY AFTER
S ^TMP("PXK",$J,"CPT",PXAK,0,"AFTER")=AFTER0
D SETPXKA^PXAIMOD(IENB,PXAK,.PXAA)
S ^TMP("PXK",$J,"CPT",PXAK,12,"AFTER")=AFTER12
S ^TMP("PXK",$J,"CPT",PXAK,802,"AFTER")=AFTER802
S ^TMP("PXK",$J,"CPT",PXAK,811,"AFTER")=AFTER811
S ^TMP("PXK",$J,"CPT",PXAK,812,"AFTER")=AFTER812
;
SETVARB ;--SET VARIABLES BEFORE
I IENB>0 D
.S ^TMP("PXK",$J,"CPT",PXAK,"IEN")=IENB
.F PIECE=0,12,802,811,812 S ^TMP("PXK",$J,"CPT",PXAK,PIECE,"BEFORE")=$G(^AUPNVCPT(IENB,PIECE))
E D
.S (BEFOR0,BEFOR12,BEFOR802,BEFOR811,BEFOR812)=""
.;
SETPXKB .;--SET PXK ARRAY BEFORE
.S ^TMP("PXK",$J,"CPT",PXAK,0,"BEFORE")=BEFOR0
.S ^TMP("PXK",$J,"CPT",PXAK,12,"BEFORE")=BEFOR12
.S ^TMP("PXK",$J,"CPT",PXAK,802,"BEFORE")=BEFOR802
.S ^TMP("PXK",$J,"CPT",PXAK,811,"BEFORE")=BEFOR811
.S ^TMP("PXK",$J,"CPT",PXAK,812,"BEFORE")=BEFOR812
.S ^TMP("PXK",$J,"CPT",PXAK,"IEN")=$S(IENB>0:IENB,1:"")
D SETPXKB^PXAIMOD(IENB,PXAK,.PXAA)
;
;Package and Data Source cannot be edited.
S BEFOR812=^TMP("PXK",$J,"CPT",PXAK,812,"BEFORE")
I BEFOR812'="" D
. I AFTER812=BEFOR812 Q
. I $P(BEFOR812,U,2)'="" S $P(AFTER812,U,2)=$P(BEFOR812,U,2)
. I $P(BEFOR812,U,3)'="" S $P(AFTER812,U,3)=$P(BEFOR812,U,3)
. S ^TMP("PXK",$J,"CPT",PXAK,812,"AFTER")=AFTER812
;
MISC ;--MISCELLANEOUS NODE
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXAICPT 4733 printed Apr 09, 2024@21:33:56 Page 2
PXAICPT ;ISL/JVS,PKR,ISA/KWP,ESW,SCK - SET THE PROCEDURE(CPT) NODES ;01/26/2021
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**19,73,108,112,149,124,164,194,211**;Aug 12, 1996;Build 454
+2 ;
+3 QUIT
CPT ;
SET ;--SET AND NEW VARIABLES
+1 NEW AFTER0,AFTER1,AFTER12,AFTER801,AFTER802,AFTER811,AFTER812
+2 NEW BEFOR0,BEFOR1,BEFOR12,BEFOR801,BEFOR802,BEFOR811,BEFOR812
+3 NEW EVENTDT,PXAA,PXAB,SUB,PIECE,IENB,STOP
+4 KILL PXAERR
+5 SET PXAERR(8)=PXAK
+6 SET PXAERR(7)="PROCEDURE"
+7 ;
+8 SET SUB=""
FOR
SET SUB=$ORDER(@PXADATA@("PROCEDURE",PXAK,SUB))
if SUB=""
QUIT
Begin DoDot:1
+9 SET PXAA(SUB)=$GET(@PXADATA@("PROCEDURE",PXAK,SUB))
End DoDot:1
+10 ;Setup PXAA array for Modifiers
+11 SET SUB=""
+12 FOR
SET SUB=$ORDER(@PXADATA@("PROCEDURE",PXAK,"MODIFIERS",SUB))
if SUB=""
QUIT
Begin DoDot:1
+13 SET PXAA("MODIFIERS",SUB)=""
End DoDot:1
+14 ;
VAL ;--VALIDATE ENOUGH DATA
+1 DO VAL^PXAICPTV
if $GET(STOP)
QUIT
+2 ;
SETVARA ;--SET V CPT VARIABLES
+1 SET $PIECE(AFTER0,U,1)=$GET(PXAA("PROCEDURE"))
+2 IF $GET(PXAA("DELETE"))
SET $PIECE(AFTER0,U,1)="@"
+3 SET $PIECE(AFTER0,U,2)=$GET(PATIENT)
+4 SET $PIECE(AFTER0,U,3)=$GET(PXAVISIT)
+5 ;If Provider Narrative is not passed or is too long use the
+6 ;CPT short description.
+7 IF ($GET(PXAA("NARRATIVE"))="")!($LENGTH($GET(PXAA("NARRATIVE")))>245)
Begin DoDot:1
+8 SET EVENTDT=$GET(PXAA("EVENT D/T"))
+9 IF EVENTDT=""
SET EVENTDT=$PIECE(^AUPNVSIT(PXAVISIT,0),U,1)
+10 SET PXAA("NARRATIVE")=$PIECE($$CPT^ICPTCOD($GET(PXAA("PROCEDURE")),EVENTDT),U,3)
End DoDot:1
+11 ;Get the Provider Narrative pointer.
+12 SET $PIECE(AFTER0,U,4)=+$$PROVNARR^PXAPI($GET(PXAA("NARRATIVE")),9000010.18)
+13 IF $PIECE(AFTER0,U,4)'>0
DO VAL04^PXAICPTV
DO ERR^PXAI("NARRATIVE",1)
if $DATA(STOP)
QUIT
+14 SET $PIECE(AFTER0,U,5)=$GET(PXAA("DIAGNOSIS"))
+15 ;PX*1*124 - add dx
+16 SET $PIECE(AFTER0,U,9)=$GET(PXAA("DIAGNOSIS 2"))
+17 SET $PIECE(AFTER0,U,10)=$GET(PXAA("DIAGNOSIS 3"))
+18 SET $PIECE(AFTER0,U,11)=$GET(PXAA("DIAGNOSIS 4"))
+19 SET $PIECE(AFTER0,U,12)=$GET(PXAA("DIAGNOSIS 5"))
+20 SET $PIECE(AFTER0,U,13)=$GET(PXAA("DIAGNOSIS 6"))
+21 SET $PIECE(AFTER0,U,14)=$GET(PXAA("DIAGNOSIS 7"))
+22 SET $PIECE(AFTER0,U,15)=$GET(PXAA("DIAGNOSIS 8"))
+23 IF $GET(PXAA("QTY"))=""
SET PXAA("QTY")=1
+24 SET $PIECE(AFTER0,U,16)=$GET(PXAA("QTY"))
IF $GET(PXAA("QTY"))<1
SET PXAA("DELETE")=1
+25 SET $PIECE(AFTER0,U,17)=$GET(PXAA("ORD REFERENCE"))
+26 ;PX*1.0*164
IF $$SWSTAT^IBBAPI()
Begin DoDot:1
+27 SET $PIECE(AFTER0,U,19)=$GET(PXAA("DEPARTMENT"))
+28 IF $PIECE(AFTER0,U,19)=""
IF $GET(^AUPNVSIT(PXAVISIT,0))
IF $PIECE(^AUPNVSIT(PXAVISIT,0),U,8)
SET $PIECE(AFTER0,U,19)=$PIECE($GET(^DIC(40.7,$PIECE(^AUPNVSIT(PXAVISIT,0),U,8),0)),U,2)
End DoDot:1
+29 ;
+30 SET $PIECE(AFTER12,U,1)=$GET(PXAA("EVENT D/T"))
+31 ;PX*1*124 - add ord prv
+32 SET $PIECE(AFTER12,U,2)=$GET(PXAA("ORD PROVIDER"))
+33 SET $PIECE(AFTER12,U,4)=$GET(PXAA("ENC PROVIDER"))
+34 ;PX*1*108 - do not try to file a provider from a "DELETED" cpt
+35 IF $GET(PXAA("ENC PROVIDER"))]""
IF '$GET(PXAA("DELETE"))
Begin DoDot:1
+36 SET ^TMP("PXAIADDPRV",$JOB,$GET(PXAA("ENC PROVIDER")))="ENC"
End DoDot:1
+37 ;PX*1*124 - do not try to file a provider from a "DELETED" cpt
+38 IF $GET(PXAA("ORD PROVIDER"))]""
IF '$GET(PXAA("DELETE"))
Begin DoDot:1
+39 SET ^TMP("PXAIADDPRV",$JOB,$GET(PXAA("ORD PROVIDER")))="ORD"
End DoDot:1
+40 ;
+41 IF $GET(PXAA("CATEGORY"))=""
SET $PIECE(AFTER802,U,1)=""
+42 IF '$TEST
Begin DoDot:1
+43 SET $PIECE(AFTER802,U,1)=+$$PROVNARR^PXAPI(PXAA("CATEGORY"),9000010.18)
+44 IF $PIECE(AFTER802,U,1)'>0
Begin DoDot:2
+45 DO VAL802^PXAICPTV
DO ERR^PXAI("CATEGORY",1)
+46 SET $PIECE(AFTER802,U,1)=""
End DoDot:2
End DoDot:1
+47 ;
+48 SET $PIECE(AFTER811,U,1)=$GET(PXAA("COMMENT"))
+49 ;
+50 ;--PACKAGE AND SOURCE
+51 SET $PIECE(AFTER812,U,2)=$SELECT($GET(PXAA("PKG"))'="":PXAA("PKG"),1:$GET(PXAPKG))
+52 SET $PIECE(AFTER812,U,3)=$SELECT($GET(PXAA("SOURCE"))'="":PXAA("SOURCE"),1:$GET(PXASOURC))
+53 ;
+54 NEW PXBKY,PXBSAM,PXBSKY,PXBCNT,PXI,PRV,ITEM
+55 DO CPT^PXBGCPT(PXAVISIT)
+56 SET ITEM=""
+57 IF PXBCNT>0
IF $GET(PXAA("PROCEDURE"))]""
SET ITEM=$ORDER(PXBKY(PXAA("PROCEDURE"),0))
+58 SET IENB=+$SELECT(ITEM'="":$ORDER(PXBSKY(ITEM,"")),1:0)
+59 ;
SETPXKA ;--SET PXK ARRAY AFTER
+1 SET ^TMP("PXK",$JOB,"CPT",PXAK,0,"AFTER")=AFTER0
+2 DO SETPXKA^PXAIMOD(IENB,PXAK,.PXAA)
+3 SET ^TMP("PXK",$JOB,"CPT",PXAK,12,"AFTER")=AFTER12
+4 SET ^TMP("PXK",$JOB,"CPT",PXAK,802,"AFTER")=AFTER802
+5 SET ^TMP("PXK",$JOB,"CPT",PXAK,811,"AFTER")=AFTER811
+6 SET ^TMP("PXK",$JOB,"CPT",PXAK,812,"AFTER")=AFTER812
+7 ;
SETVARB ;--SET VARIABLES BEFORE
+1 IF IENB>0
Begin DoDot:1
+2 SET ^TMP("PXK",$JOB,"CPT",PXAK,"IEN")=IENB
+3 FOR PIECE=0,12,802,811,812
SET ^TMP("PXK",$JOB,"CPT",PXAK,PIECE,"BEFORE")=$GET(^AUPNVCPT(IENB,PIECE))
End DoDot:1
+4 IF '$TEST
Begin DoDot:1
+5 SET (BEFOR0,BEFOR12,BEFOR802,BEFOR811,BEFOR812)=""
+6 ;
SETPXKB ;--SET PXK ARRAY BEFORE
+1 SET ^TMP("PXK",$JOB,"CPT",PXAK,0,"BEFORE")=BEFOR0
+2 SET ^TMP("PXK",$JOB,"CPT",PXAK,12,"BEFORE")=BEFOR12
+3 SET ^TMP("PXK",$JOB,"CPT",PXAK,802,"BEFORE")=BEFOR802
+4 SET ^TMP("PXK",$JOB,"CPT",PXAK,811,"BEFORE")=BEFOR811
+5 SET ^TMP("PXK",$JOB,"CPT",PXAK,812,"BEFORE")=BEFOR812
+6 SET ^TMP("PXK",$JOB,"CPT",PXAK,"IEN")=$SELECT(IENB>0:IENB,1:"")
End DoDot:1
+7 DO SETPXKB^PXAIMOD(IENB,PXAK,.PXAA)
+8 ;
+9 ;Package and Data Source cannot be edited.
+10 SET BEFOR812=^TMP("PXK",$JOB,"CPT",PXAK,812,"BEFORE")
+11 IF BEFOR812'=""
Begin DoDot:1
+12 IF AFTER812=BEFOR812
QUIT
+13 IF $PIECE(BEFOR812,U,2)'=""
SET $PIECE(AFTER812,U,2)=$PIECE(BEFOR812,U,2)
+14 IF $PIECE(BEFOR812,U,3)'=""
SET $PIECE(AFTER812,U,3)=$PIECE(BEFOR812,U,3)
+15 SET ^TMP("PXK",$JOB,"CPT",PXAK,812,"AFTER")=AFTER812
End DoDot:1
+16 ;
MISC ;--MISCELLANEOUS NODE
+1 ;
+2 QUIT
