PXCAVST1 ;ISL/dee & LEA/Chylton - Translates data from the PCE Device Interface into PCE's PXK format for the Visit and Providers ;6/6/05
;;1.0;PCE PATIENT CARE ENCOUNTER;**73,74,111,121,130,168**;Aug 12, 1996;Build 14
Q
;
VST(PXCAENC) ;Visit
N PXCAFTER
NODE0 ;
1 S PXCAFTER=$P(PXCAENC,"^",1)_"^^^^"
5 S PXCAFTER=PXCAFTER_PXCAPAT_"^^^"
8 S PXCAFTER=PXCAFTER_PXCACSTP_"^^^^^^^^^"
17 ;Store the Evaluation and Management Code in V-CPT and NOT in the Visit
D EVALCODE($P(PXCAENC,"^",5),$P(PXCAENC,"^",4))
S PXCAFTER=PXCAFTER_"^"
18 S PXCAFTER=PXCAFTER_$P(PXCAENC,"^",14)_"^^^"
21 I $P(PXCAENC,"^",13)]"" S PXCAFTER=PXCAFTER_$P(PXCAENC,"^",13)_"^"
E D
. N PXCAELIG
. S PXCAELIG=$$ELIGIBIL^PXCEVSIT(PXCAPAT,PXCAHLOC,+PXCAENC)
. S PXCAELIG=$S(PXCAELIG>0:PXCAELIG,1:"")
. S PXCAFTER=PXCAFTER_PXCAELIG_"^"
22 S PXCAFTER=PXCAFTER_PXCAHLOC
S ^TMP(PXCAGLB,$J,"VST",1,0,"AFTER")=PXCAFTER
;
NODE150 I $P($G(^SC(+PXCAHLOC,0)),"^",7)=PXCACSTP D
. S ^TMP(PXCAGLB,$J,"VST",1,150,"AFTER")="^^P"
;
NODE800 ;
S ^TMP(PXCAGLB,$J,"VST",1,800,"AFTER")=$P(PXCAENC,"^",6,10)_"^"_$P(PXCAENC,"^",17,19)
;
I PXCAVSIT'>0 D
. S ^TMP(PXCAGLB,$J,"VST",1,"IEN")=""
. S ^TMP(PXCAGLB,$J,"VST",1,0,"BEFORE")=""
. S ^TMP(PXCAGLB,$J,"VST",1,150,"BEFORE")=""
. S ^TMP(PXCAGLB,$J,"VST",1,800,"BEFORE")=""
. S ^TMP(PXCAGLB,$J,"VST",1,812,"BEFORE")=""
. S ^TMP(PXCAGLB,$J,"VST",1,812,"AFTER")="^"_PXCAPKG_"^"_PXCASOR
E D
. S ^TMP(PXCAGLB,$J,"VST",1,"IEN")=PXCAVSIT
. S ^TMP(PXCAGLB,$J,"VST",1,0,"BEFORE")=$G(^AUPNVSIT(PXCAVSIT,0))
. S $P(^TMP("PXK",$J,"VST",1,0,"AFTER"),"^",3)=$P(^AUPNVSIT(PXCAVSIT,0),"^",3)
. S $P(^TMP("PXK",$J,"VST",1,0,"AFTER"),"^",7)=$P(^AUPNVSIT(PXCAVSIT,0),"^",7)
. S ^TMP(PXCAGLB,$J,"VST",1,150,"BEFORE")=$G(^AUPNVSIT(PXCAVSIT,150))
. S ^TMP(PXCAGLB,$J,"VST",1,800,"BEFORE")=$G(^AUPNVSIT(PXCAVSIT,800))
. S ^TMP(PXCAGLB,$J,"VST",1,21,"BEFORE")=$G(^AUPNVSIT(PXCAVSIT,21))
. S ^TMP(PXCAGLB,$J,"VST",1,21,"AFTER")=$G(^AUPNVSIT(PXCAVSIT,21))
. S ^TMP(PXCAGLB,$J,"VST",1,811,"BEFORE")=$G(^AUPNVSIT(PXCAVSIT,811))
. S ^TMP(PXCAGLB,$J,"VST",1,811,"AFTER")=$G(^AUPNVSIT(PXCAVSIT,811))
. S ^TMP(PXCAGLB,$J,"VST",1,812,"BEFORE")=$G(^AUPNVSIT(PXCAVSIT,812))
. S ^TMP(PXCAGLB,$J,"VST",1,812,"AFTER")=$G(^AUPNVSIT(PXCAVSIT,812))
Q
;
EVALCODE(CODE,PROV) ;Store the Evaluation and Management Code in a CPT node.
;Evaluation and Management Code always has a sequence number of 1
; and there is only one of them.
Q:'CODE
N PXCAFTER,PXCAITEM,PXCAPNAR,PXCACNAR,PXCACNT,PXCAMOD,PXCASTR
N DIC,DR,DA,DIQ,PXCADIQ1
S DIC=357.69
S DR=".015;.02;.03"
S DA=+CODE
S DIQ="PXCADIQ1("
S DIQ(0)="E"
D EN^DIQ1
S PXCAITEM=$S($G(PXCADIQ1(357.69,DA,.03,"E"))]"":PXCADIQ1(357.69,DA,.03,"E"),$G(PXCADIQ1(357.69,DA,.015,"E"))]"":PXCADIQ1(357.69,DA,.015,"E"),1:"UNKNOWN")
S PXCAPNAR=+$$PROVNARR^PXAPI(PXCAITEM,9000010.18)
I PXCAPNAR'>0 S PXCAPNAR=""
S ^TMP(PXCAGLB,$J,"CPT",1,0,"BEFORE")=""
S PXCAFTER=CODE_"^"_PXCAPAT_"^"_PXCAVSIT_"^"
S PXCAFTER=PXCAFTER_PXCAPNAR
S PXCAFTER=PXCAFTER_"^^^^^^^^^^^^1"
S ^TMP(PXCAGLB,$J,"CPT",1,0,"AFTER")=PXCAFTER
; File modifiers in ^TMP global
S ^TMP(PXCAGLB,$J,"CPT",1,1,1,"BEFORE")=""
S (PXCACNT,PXCAMOD)=""
F PXCACNT=1:1 S PXCAMOD=$O(PXCA("ENCOUNTER","MODIFIER",PXCAMOD)) Q:PXCAMOD="" D
. S PXCASTR=$$MODP^ICPTMOD(CODE,PXCAMOD,"E",PXCADT)
. Q:+PXCASTR<1
. S ^TMP(PXCAGLB,$J,"CPT",1,1,PXCACNT,"AFTER")=+PXCASTR
S ^TMP(PXCAGLB,$J,"CPT",1,12,"BEFORE")=""
I PROV S ^TMP(PXCAGLB,$J,"CPT",1,12,"AFTER")="^^^"_PROV
E S ^TMP(PXCAGLB,$J,"CPT",1,12,"AFTER")=""
S ^TMP(PXCAGLB,$J,"CPT",1,802,"BEFORE")=""
S ^TMP(PXCAGLB,$J,"CPT",1,812,"BEFORE")=""
S ^TMP(PXCAGLB,$J,"CPT",1,812,"AFTER")="^"_PXCAPKG_"^"_PXCASOR
S PXCACNAR=""
I $G(PXCADIQ1(357.69,DA,.02,"E"))]"" D
. S PXCACNAR=+$$PROVNARR^PXAPI(PXCADIQ1(357.69,DA,.02,"E"),9000010.18)
. I PXCACNAR'>0 S PXCACNAR=""
S ^TMP(PXCAGLB,$J,"CPT",1,802,"AFTER")=PXCACNAR
S ^TMP(PXCAGLB,$J,"CPT",1,"IEN")=""
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXCAVST1 3999 printed Apr 09, 2024@21:29:29 Page 2
PXCAVST1 ;ISL/dee & LEA/Chylton - Translates data from the PCE Device Interface into PCE's PXK format for the Visit and Providers ;6/6/05
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**73,74,111,121,130,168**;Aug 12, 1996;Build 14
+2 QUIT
+3 ;
VST(PXCAENC) ;Visit
+1 NEW PXCAFTER
NODE0 ;
1 SET PXCAFTER=$PIECE(PXCAENC,"^",1)_"^^^^"
5 SET PXCAFTER=PXCAFTER_PXCAPAT_"^^^"
8 SET PXCAFTER=PXCAFTER_PXCACSTP_"^^^^^^^^^"
17 ;Store the Evaluation and Management Code in V-CPT and NOT in the Visit
+1 DO EVALCODE($PIECE(PXCAENC,"^",5),$PIECE(PXCAENC,"^",4))
+2 SET PXCAFTER=PXCAFTER_"^"
18 SET PXCAFTER=PXCAFTER_$PIECE(PXCAENC,"^",14)_"^^^"
21 IF $PIECE(PXCAENC,"^",13)]""
SET PXCAFTER=PXCAFTER_$PIECE(PXCAENC,"^",13)_"^"
+1 IF '$TEST
Begin DoDot:1
+2 NEW PXCAELIG
+3 SET PXCAELIG=$$ELIGIBIL^PXCEVSIT(PXCAPAT,PXCAHLOC,+PXCAENC)
+4 SET PXCAELIG=$SELECT(PXCAELIG>0:PXCAELIG,1:"")
+5 SET PXCAFTER=PXCAFTER_PXCAELIG_"^"
End DoDot:1
22 SET PXCAFTER=PXCAFTER_PXCAHLOC
+1 SET ^TMP(PXCAGLB,$JOB,"VST",1,0,"AFTER")=PXCAFTER
+2 ;
NODE150 IF $PIECE($GET(^SC(+PXCAHLOC,0)),"^",7)=PXCACSTP
Begin DoDot:1
+1 SET ^TMP(PXCAGLB,$JOB,"VST",1,150,"AFTER")="^^P"
End DoDot:1
+2 ;
NODE800 ;
+1 SET ^TMP(PXCAGLB,$JOB,"VST",1,800,"AFTER")=$PIECE(PXCAENC,"^",6,10)_"^"_$PIECE(PXCAENC,"^",17,19)
+2 ;
+3 IF PXCAVSIT'>0
Begin DoDot:1
+4 SET ^TMP(PXCAGLB,$JOB,"VST",1,"IEN")=""
+5 SET ^TMP(PXCAGLB,$JOB,"VST",1,0,"BEFORE")=""
+6 SET ^TMP(PXCAGLB,$JOB,"VST",1,150,"BEFORE")=""
+7 SET ^TMP(PXCAGLB,$JOB,"VST",1,800,"BEFORE")=""
+8 SET ^TMP(PXCAGLB,$JOB,"VST",1,812,"BEFORE")=""
+9 SET ^TMP(PXCAGLB,$JOB,"VST",1,812,"AFTER")="^"_PXCAPKG_"^"_PXCASOR
End DoDot:1
+10 IF '$TEST
Begin DoDot:1
+11 SET ^TMP(PXCAGLB,$JOB,"VST",1,"IEN")=PXCAVSIT
+12 SET ^TMP(PXCAGLB,$JOB,"VST",1,0,"BEFORE")=$GET(^AUPNVSIT(PXCAVSIT,0))
+13 SET $PIECE(^TMP("PXK",$JOB,"VST",1,0,"AFTER"),"^",3)=$PIECE(^AUPNVSIT(PXCAVSIT,0),"^",3)
+14 SET $PIECE(^TMP("PXK",$JOB,"VST",1,0,"AFTER"),"^",7)=$PIECE(^AUPNVSIT(PXCAVSIT,0),"^",7)
+15 SET ^TMP(PXCAGLB,$JOB,"VST",1,150,"BEFORE")=$GET(^AUPNVSIT(PXCAVSIT,150))
+16 SET ^TMP(PXCAGLB,$JOB,"VST",1,800,"BEFORE")=$GET(^AUPNVSIT(PXCAVSIT,800))
+17 SET ^TMP(PXCAGLB,$JOB,"VST",1,21,"BEFORE")=$GET(^AUPNVSIT(PXCAVSIT,21))
+18 SET ^TMP(PXCAGLB,$JOB,"VST",1,21,"AFTER")=$GET(^AUPNVSIT(PXCAVSIT,21))
+19 SET ^TMP(PXCAGLB,$JOB,"VST",1,811,"BEFORE")=$GET(^AUPNVSIT(PXCAVSIT,811))
+20 SET ^TMP(PXCAGLB,$JOB,"VST",1,811,"AFTER")=$GET(^AUPNVSIT(PXCAVSIT,811))
+21 SET ^TMP(PXCAGLB,$JOB,"VST",1,812,"BEFORE")=$GET(^AUPNVSIT(PXCAVSIT,812))
+22 SET ^TMP(PXCAGLB,$JOB,"VST",1,812,"AFTER")=$GET(^AUPNVSIT(PXCAVSIT,812))
End DoDot:1
+23 QUIT
+24 ;
EVALCODE(CODE,PROV) ;Store the Evaluation and Management Code in a CPT node.
+1 ;Evaluation and Management Code always has a sequence number of 1
+2 ; and there is only one of them.
+3 if 'CODE
QUIT
+4 NEW PXCAFTER,PXCAITEM,PXCAPNAR,PXCACNAR,PXCACNT,PXCAMOD,PXCASTR
+5 NEW DIC,DR,DA,DIQ,PXCADIQ1
+6 SET DIC=357.69
+7 SET DR=".015;.02;.03"
+8 SET DA=+CODE
+9 SET DIQ="PXCADIQ1("
+10 SET DIQ(0)="E"
+11 DO EN^DIQ1
+12 SET PXCAITEM=$SELECT($GET(PXCADIQ1(357.69,DA,.03,"E"))]"":PXCADIQ1(357.69,DA,.03,"E"),$GET(PXCADIQ1(357.69,DA,.015,"E"))]"":PXCADIQ1(357.69,DA,.015,"E"),1:"UNKNOWN")
+13 SET PXCAPNAR=+$$PROVNARR^PXAPI(PXCAITEM,9000010.18)
+14 IF PXCAPNAR'>0
SET PXCAPNAR=""
+15 SET ^TMP(PXCAGLB,$JOB,"CPT",1,0,"BEFORE")=""
+16 SET PXCAFTER=CODE_"^"_PXCAPAT_"^"_PXCAVSIT_"^"
+17 SET PXCAFTER=PXCAFTER_PXCAPNAR
+18 SET PXCAFTER=PXCAFTER_"^^^^^^^^^^^^1"
+19 SET ^TMP(PXCAGLB,$JOB,"CPT",1,0,"AFTER")=PXCAFTER
+20 ; File modifiers in ^TMP global
+21 SET ^TMP(PXCAGLB,$JOB,"CPT",1,1,1,"BEFORE")=""
+22 SET (PXCACNT,PXCAMOD)=""
+23 FOR PXCACNT=1:1
SET PXCAMOD=$ORDER(PXCA("ENCOUNTER","MODIFIER",PXCAMOD))
if PXCAMOD=""
QUIT
Begin DoDot:1
+24 SET PXCASTR=$$MODP^ICPTMOD(CODE,PXCAMOD,"E",PXCADT)
+25 if +PXCASTR<1
QUIT
+26 SET ^TMP(PXCAGLB,$JOB,"CPT",1,1,PXCACNT,"AFTER")=+PXCASTR
End DoDot:1
+27 SET ^TMP(PXCAGLB,$JOB,"CPT",1,12,"BEFORE")=""
+28 IF PROV
SET ^TMP(PXCAGLB,$JOB,"CPT",1,12,"AFTER")="^^^"_PROV
+29 IF '$TEST
SET ^TMP(PXCAGLB,$JOB,"CPT",1,12,"AFTER")=""
+30 SET ^TMP(PXCAGLB,$JOB,"CPT",1,802,"BEFORE")=""
+31 SET ^TMP(PXCAGLB,$JOB,"CPT",1,812,"BEFORE")=""
+32 SET ^TMP(PXCAGLB,$JOB,"CPT",1,812,"AFTER")="^"_PXCAPKG_"^"_PXCASOR
+33 SET PXCACNAR=""
+34 IF $GET(PXCADIQ1(357.69,DA,.02,"E"))]""
Begin DoDot:1
+35 SET PXCACNAR=+$$PROVNARR^PXAPI(PXCADIQ1(357.69,DA,.02,"E"),9000010.18)
+36 IF PXCACNAR'>0
SET PXCACNAR=""
End DoDot:1
+37 SET ^TMP(PXCAGLB,$JOB,"CPT",1,802,"AFTER")=PXCACNAR
+38 SET ^TMP(PXCAGLB,$JOB,"CPT",1,"IEN")=""
+39 QUIT
+40 ;
