PXCEVFIL ;ISL/dee - Main routine to edit a visit or v-file entry ;10/06/2017
;;1.0;PCE PATIENT CARE ENCOUNTER;**9,30,22,73,88,89,104,147,124,169,210,215,211**;Aug 12, 1996;Build 454
;
Q
EN(PXCECAT) ; -- main entry point for PXCE pxcecat EDIT
I PXCECAT="SIT"!(PXCECAT="HIST") D PATINFO^PXCEPAT(.PXCEPAT) Q:$D(DIRUT)
I PXCECAT'="SIT",PXCECAT'="APPM",PXCECAT'="HIST" Q:'$D(PXCEFIEN)!'$D(PXCEVIEN)!'$D(PXCEPAT)
E Q:(PXCEVIEW["P"&'$D(PXCEPAT))!(PXCEVIEW["H"&'$D(PXCEHLOC))!("~H~P~"'[("~"_$P(PXCEVIEW,"^")_"~"))
I PXCECAT="CSTP",$L($T(DATE^SCDXUTL)),$$DATE^SCDXUTL(+$G(^AUPNVSIT(PXCEVIEN,0))) W !!,$C(7),"Stop Codes can not be added to encounters after "_$$FMDATE^SCDXUTL Q
N PXCEQUIT
I "~CPT~CSTP~"[PXCECAT D Q:PXCEQUIT
. S PXCEQUIT=0
. I $P($G(^AUPNVSIT(PXCEVIEN,0)),"^",7)="E" D Q:$G(PXCEQUIT)
.. I PXCECAT="CSTP" W !!,$C(7),"Historical Encounters cannot have Stop Codes." D WAIT^PXCEHELP S PXCEQUIT=1 Q
K PXCEQUIT
D FULL^VALM1
;
N PXCEVFIL,PXCELOOP,PXCENOER
N PXCECODE,PXCEAUPN,PXCECATS,PXCECATT,PXCEFILE,PXVICR ; PX*1*215
N PXCEPSCC
S PXCECATS=$S(PXCECAT="SIT":"VST",PXCECAT="APPM":"VST",PXCECAT="HIST":"VST",PXCECAT="CSTP":"VST",1:PXCECAT)
S PXCECODE="PXCE"_$S(PXCECAT="IMM":"VIMM",1:PXCECAT)
S PXCEAUPN=$P($T(FORMAT^@PXCECODE),"~",5)
S PXCECATT=$P($P($T(FORMAT^@PXCECODE),";;",2),"~",1)
S PXCEFILE=$P($T(FORMAT^@PXCECODE),"~",2)
S (PXCEQUIT,PXVICR)=0
I '$D(PXCAAFTR),PXCECAT'="SIT",PXCECAT'="APPM",PXCECAT'="HIST",PXCEFIEN'>0 D ASK^PXCEVFI2(PXCEVIEN,.PXCEFIEN,PXCEAUPN,PXCECATT,PXCECODE)
Q:PXCEQUIT
I PXVICR S PXCEFIEN="" D EN("ICR") Q ; PX*1*215
I PXCECAT'="SIT",PXCECAT'="APPM",PXCECAT'="HIST" S PXCELOOP=+PXCEFIEN
E S PXCELOOP=1,PXCEFIEN=PXCEVIEN
I PXCECAT="CSTP" D
. I $$VSTAPPT^PXUTL1(PXCEPAT,+^AUPNVSIT(PXCEVIEN,0),PXCEHLOC,PXCEVIEN) S PXCELOOP=0
. E S PXCELOOP=1
I $D(PXCAAFTR) S PXCELOOP=1
F D DOONE Q:PXCELOOP
K PXCEFIEN
Q
;
DOONE ;
N PXCEAFTR,PXCEUP,PXCEVFIN,PXELAP
D INIT
;Save the initial V-file contents.
M PXCEVFIN=PXCEAFTR
Q:PXCEQUIT
DOONE2 ;
K PXKERROR
S PXCENOER=0
I PXCECAT="IMM" S PXVNEWDA="" ; PX*1*210
D EDIT^PXCEVFI1
I 'PXCEQUIT,PXCECAT="SIT",$P($G(PXCEAFTR(0)),"^")]"",$P($G(PXCEAFTR(0)),"^",22)]"" D
. I $D(^DPT(DFN,"S",$P(PXCEAFTR(0),"^"),0)),$P($G(^DPT(DFN,"S",$P(PXCEAFTR(0),"^"),0)),"^")=$P(PXCEAFTR(0),"^",22),$P(^DPT(DFN,"S",$P(PXCEAFTR(0),"^"),0),"^",2)["C" D
.. S PXCEQUIT=1,$P(PXCEAFTR(0),"^")=""
.. W !,$C(7),"Cannot create encounter for appointment date/time and clinic that was previously cancelled, NOTHING was STORED"
.. D WAIT^PXCEHELP
I ($P(PXCEAFTR(0),"^")]"") D
. I PXCEQUIT D
.. I 'PXCEFIEN,PXCECAT="CPT" D
... D REMOVE(^TMP("PXK",$J,PXCECAT,1,"IEN"))
.. I 'PXCENOER D
... I PXCEFIEN>0 D
.... D:PXCECAT="CPT" MODUPD
.... W !,$C(7),"The last entry did not have all of the required data and NOTHING was CHANGED."
... E W !,$C(7),"The last entry did not have all of the required data and NOTHING was STORED."
... D WAIT^PXCEHELP
. E D SAVE^PXCEVFI2
I PXCECAT="IMM",$G(PXVNEWDA) D EVIS^PXCEVIS K PXVNEWDA ; PX*1*210
D EXIT
Q
;
INIT ; -- init variables and list array
N PXCENODS,PXCEFOR,PXCENODE
K ^TMP("PXK",$J),PXCEAFTR
S ^TMP("PXK",$J,"SOR")=PXCESOR
S ^TMP("PXK",$J,"VST",1,"IEN")=PXCEVIEN
I PXCECAT="SIT"!(PXCECAT="APPM")!(PXCECAT="HIST") D
. F PXCENODE=0,21,150,800,811,812 D
.. S PXCEAFTR(PXCENODE)=$S(PXCEVIEN>0:$G(^AUPNVSIT(PXCEVIEN,PXCENODE)),1:"")
.. S ^TMP("PXK",$J,"VST",1,PXCENODE,"BEFORE")=PXCEAFTR(PXCENODE)
E D
. F PXCENODE=0,21,150,800,811,812 D
.. S ^TMP("PXK",$J,"VST",1,PXCENODE,"BEFORE")=$G(^AUPNVSIT(+PXCEVIEN,PXCENODE))
.. S ^TMP("PXK",$J,"VST",1,PXCENODE,"AFTER")=^TMP("PXK",$J,"VST",1,PXCENODE,"BEFORE")
. ;
. S ^TMP("PXK",$J,PXCECATS,1,"IEN")=PXCEFIEN
. S PXCENODS=$P($T(FORMAT^@PXCECODE),"~",3)
. F PXCEFOR=1:1 S PXCENODE=$P(PXCENODS,",",PXCEFOR) Q:PXCENODE']"" D
.. I PXCEFIEN>0 D
... I PXCECAT="CPT",PXCENODE=1 D
.... ;Retrieve CPT Modifiers from multiple field
.... S PXCESEQ=0
.... F S PXCESEQ=$O(@(PXCEAUPN_"(PXCEFIEN,PXCENODE,PXCESEQ)")) Q:'PXCESEQ D
..... S ^TMP("PXK",$J,PXCECATS,1,PXCENODE,PXCESEQ,"BEFORE")=$G(@(PXCEAUPN_"(PXCEFIEN,PXCENODE,PXCESEQ,0)"))
..... S PXCEAFTR(PXCENODE,PXCESEQ)=^TMP("PXK",$J,PXCECATS,1,PXCENODE,PXCESEQ,"BEFORE")
... E D
.... S ^TMP("PXK",$J,PXCECATS,1,PXCENODE,"BEFORE")=$G(@(PXCEAUPN_"(PXCEFIEN,PXCENODE)"))
.... S PXCEAFTR(PXCENODE)=^TMP("PXK",$J,PXCECATS,1,PXCENODE,"BEFORE")
.. E D
... I PXCECAT="CPT",PXCENODE=1 D Q
.... S ^TMP("PXK",$J,PXCECATS,1,PXCENODE,1,"BEFORE")=""
... S ^TMP("PXK",$J,PXCECATS,1,PXCENODE,"BEFORE")=""
... S PXCEAFTR(PXCENODE)=^TMP("PXK",$J,PXCECATS,1,PXCENODE,"BEFORE")
Q:PXCEQUIT
;
I PXCEAUPN'="^AUPNVSIT" D
. ;Set the Patient and Visit pointers in the V-File.
. S:'$P(PXCEAFTR(0),"^",2) $P(PXCEAFTR(0),"^",2)=PXCEPAT
. S:'$P(PXCEAFTR(0),"^",3) $P(PXCEAFTR(0),"^",3)=PXCEVIEN
. I $P(PXCEAFTR(0),"^",1)="" D
.. S:'$P(PXCEAFTR(812),"^",2) $P(PXCEAFTR(812),"^",2)=PXCEPKG
.. S:'$P(PXCEAFTR(812),"^",3) $P(PXCEAFTR(812),"^",3)=PXCESOR
E D
. ;If new visit set package and source.
. I $P(PXCEAFTR(0),"^",1)="" D
.. S:'$P(PXCEAFTR(812),"^",2) $P(PXCEAFTR(812),"^",2)=PXCEPKG
.. S:'$P(PXCEAFTR(812),"^",3) $P(PXCEAFTR(812),"^",3)=PXCESOR
. ;Set the Patient in the Visit for new visit.
. I $G(PXCEAPDT)>0 D
.. S:'$P(PXCEAFTR(0),"^",1) $P(PXCEAFTR(0),"^",1)=PXCEAPDT
.. I '$P(PXCEAFTR(0),"^",21) D
... ;Get the ELIGIBILITY for the appointment
... N PXCEELIG
... S PXCEELIG=$$ELIGIBIL^PXCEVSIT(PXCEPAT,PXCEHLOC,PXCEAPDT)
... S:PXCEELIG>0 $P(PXCEAFTR(0),"^",21)=PXCEELIG
. S:'$P(PXCEAFTR(0),"^",5)&($G(PXCEPAT)>0) $P(PXCEAFTR(0),"^",5)=PXCEPAT
. S:'$P(PXCEAFTR(0),"^",22)&($G(PXCEHLOC)>0) $P(PXCEAFTR(0),"^",22)=PXCEHLOC
Q
;
EXIT ; -- exit code
I PXCECAT="SIT"!(PXCECAT="APPM")!(PXCECAT="HIST") L:PXCEVIEN>0 -@(PXCEAUPN_"(PXCEVIEN)"):30
E L:PXCEFIEN>0 -@(PXCEAUPN_"(PXCEFIEN)"):30
S PXCEFIEN=""
K ^TMP("PXK",$J)
K PXCEAFTR
S PXCEQUIT=0
Q
;
MODUPD ;Update the MODIFIER list for the currently edited CPT code when all
;the reqired data is not entered.
;
N SQ,DA,DIC,DIK,X
S SQ=""
F S SQ=$O(PXCEAFTR(1,SQ)) Q:'SQ D
.S DA(1)=PXCEFIEN,DA=SQ
.S DIK="^AUPNVCPT("_DA(1)_","_1_","
.D ^DIK
F S SQ=$O(^TMP("PXK",$J,"CPT",1,1,SQ)) Q:'SQ D
.S X=^TMP("PXK",$J,"CPT",1,1,SQ,"BEFORE")
.Q:X']""
.K DD,DO
.S DA(1)=PXCEFIEN
.S DIC="^AUPNVCPT("_DA(1)_","_1_","
.S DIC(0)="L",DIC("P")=$P(^DD(9000010.18,1,0),"^",2)
.D FILE^DICN
Q
;
REMOVE(DA) ;REMOVE INCOMPLETE CPT ENTRY
N DIK
S DIK="^AUPNVCPT("
I $G(DA) D ^DIK ;PX*1*124
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXCEVFIL 6664 printed Dec 13, 2024@02:28:23 Page 2
PXCEVFIL ;ISL/dee - Main routine to edit a visit or v-file entry ;10/06/2017
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**9,30,22,73,88,89,104,147,124,169,210,215,211**;Aug 12, 1996;Build 454
+2 ;
+3 QUIT
EN(PXCECAT) ; -- main entry point for PXCE pxcecat EDIT
+1 IF PXCECAT="SIT"!(PXCECAT="HIST")
DO PATINFO^PXCEPAT(.PXCEPAT)
if $DATA(DIRUT)
QUIT
+2 IF PXCECAT'="SIT"
IF PXCECAT'="APPM"
IF PXCECAT'="HIST"
if '$DATA(PXCEFIEN)!'$DATA(PXCEVIEN)!'$DATA(PXCEPAT)
QUIT
+3 IF '$TEST
if (PXCEVIEW["P"&'$DATA(PXCEPAT))!(PXCEVIEW["H"&'$DATA(PXCEHLOC))!("~H~P~"'[("~"_$PIECE(PXCEVIEW,"^")_"~"))
QUIT
+4 IF PXCECAT="CSTP"
IF $LENGTH($TEXT(DATE^SCDXUTL))
IF $$DATE^SCDXUTL(+$GET(^AUPNVSIT(PXCEVIEN,0)))
WRITE !!,$CHAR(7),"Stop Codes can not be added to encounters after "_$$FMDATE^SCDXUTL
QUIT
+5 NEW PXCEQUIT
+6 IF "~CPT~CSTP~"[PXCECAT
Begin DoDot:1
+7 SET PXCEQUIT=0
+8 IF $PIECE($GET(^AUPNVSIT(PXCEVIEN,0)),"^",7)="E"
Begin DoDot:2
+9 IF PXCECAT="CSTP"
WRITE !!,$CHAR(7),"Historical Encounters cannot have Stop Codes."
DO WAIT^PXCEHELP
SET PXCEQUIT=1
QUIT
End DoDot:2
if $GET(PXCEQUIT)
QUIT
End DoDot:1
if PXCEQUIT
QUIT
+10 KILL PXCEQUIT
+11 DO FULL^VALM1
+12 ;
+13 NEW PXCEVFIL,PXCELOOP,PXCENOER
+14 ; PX*1*215
NEW PXCECODE,PXCEAUPN,PXCECATS,PXCECATT,PXCEFILE,PXVICR
+15 NEW PXCEPSCC
+16 SET PXCECATS=$SELECT(PXCECAT="SIT":"VST",PXCECAT="APPM":"VST",PXCECAT="HIST":"VST",PXCECAT="CSTP":"VST",1:PXCECAT)
+17 SET PXCECODE="PXCE"_$SELECT(PXCECAT="IMM":"VIMM",1:PXCECAT)
+18 SET PXCEAUPN=$PIECE($TEXT(FORMAT^@PXCECODE),"~",5)
+19 SET PXCECATT=$PIECE($PIECE($TEXT(FORMAT^@PXCECODE),";;",2),"~",1)
+20 SET PXCEFILE=$PIECE($TEXT(FORMAT^@PXCECODE),"~",2)
+21 SET (PXCEQUIT,PXVICR)=0
+22 IF '$DATA(PXCAAFTR)
IF PXCECAT'="SIT"
IF PXCECAT'="APPM"
IF PXCECAT'="HIST"
IF PXCEFIEN'>0
DO ASK^PXCEVFI2(PXCEVIEN,.PXCEFIEN,PXCEAUPN,PXCECATT,PXCECODE)
+23 if PXCEQUIT
QUIT
+24 ; PX*1*215
IF PXVICR
SET PXCEFIEN=""
DO EN("ICR")
QUIT
+25 IF PXCECAT'="SIT"
IF PXCECAT'="APPM"
IF PXCECAT'="HIST"
SET PXCELOOP=+PXCEFIEN
+26 IF '$TEST
SET PXCELOOP=1
SET PXCEFIEN=PXCEVIEN
+27 IF PXCECAT="CSTP"
Begin DoDot:1
+28 IF $$VSTAPPT^PXUTL1(PXCEPAT,+^AUPNVSIT(PXCEVIEN,0),PXCEHLOC,PXCEVIEN)
SET PXCELOOP=0
+29 IF '$TEST
SET PXCELOOP=1
End DoDot:1
+30 IF $DATA(PXCAAFTR)
SET PXCELOOP=1
+31 FOR
DO DOONE
if PXCELOOP
QUIT
+32 KILL PXCEFIEN
+33 QUIT
+34 ;
DOONE ;
+1 NEW PXCEAFTR,PXCEUP,PXCEVFIN,PXELAP
+2 DO INIT
+3 ;Save the initial V-file contents.
+4 MERGE PXCEVFIN=PXCEAFTR
+5 if PXCEQUIT
QUIT
DOONE2 ;
+1 KILL PXKERROR
+2 SET PXCENOER=0
+3 ; PX*1*210
IF PXCECAT="IMM"
SET PXVNEWDA=""
+4 DO EDIT^PXCEVFI1
+5 IF 'PXCEQUIT
IF PXCECAT="SIT"
IF $PIECE($GET(PXCEAFTR(0)),"^")]""
IF $PIECE($GET(PXCEAFTR(0)),"^",22)]""
Begin DoDot:1
+6 IF $DATA(^DPT(DFN,"S",$PIECE(PXCEAFTR(0),"^"),0))
IF $PIECE($GET(^DPT(DFN,"S",$PIECE(PXCEAFTR(0),"^"),0)),"^")=$PIECE(PXCEAFTR(0),"^",22)
IF $PIECE(^DPT(DFN,"S",$PIECE(PXCEAFTR(0),"^"),0),"^",2)["C"
Begin DoDot:2
+7 SET PXCEQUIT=1
SET $PIECE(PXCEAFTR(0),"^")=""
+8 WRITE !,$CHAR(7),"Cannot create encounter for appointment date/time and clinic that was previously cancelled, NOTHING was STORED"
+9 DO WAIT^PXCEHELP
End DoDot:2
End DoDot:1
+10 IF ($PIECE(PXCEAFTR(0),"^")]"")
Begin DoDot:1
+11 IF PXCEQUIT
Begin DoDot:2
+12 IF 'PXCEFIEN
IF PXCECAT="CPT"
Begin DoDot:3
+13 DO REMOVE(^TMP("PXK",$JOB,PXCECAT,1,"IEN"))
End DoDot:3
+14 IF 'PXCENOER
Begin DoDot:3
+15 IF PXCEFIEN>0
Begin DoDot:4
+16 if PXCECAT="CPT"
DO MODUPD
+17 WRITE !,$CHAR(7),"The last entry did not have all of the required data and NOTHING was CHANGED."
End DoDot:4
+18 IF '$TEST
WRITE !,$CHAR(7),"The last entry did not have all of the required data and NOTHING was STORED."
+19 DO WAIT^PXCEHELP
End DoDot:3
End DoDot:2
+20 IF '$TEST
DO SAVE^PXCEVFI2
End DoDot:1
+21 ; PX*1*210
IF PXCECAT="IMM"
IF $GET(PXVNEWDA)
DO EVIS^PXCEVIS
KILL PXVNEWDA
+22 DO EXIT
+23 QUIT
+24 ;
INIT ; -- init variables and list array
+1 NEW PXCENODS,PXCEFOR,PXCENODE
+2 KILL ^TMP("PXK",$JOB),PXCEAFTR
+3 SET ^TMP("PXK",$JOB,"SOR")=PXCESOR
+4 SET ^TMP("PXK",$JOB,"VST",1,"IEN")=PXCEVIEN
+5 IF PXCECAT="SIT"!(PXCECAT="APPM")!(PXCECAT="HIST")
Begin DoDot:1
+6 FOR PXCENODE=0,21,150,800,811,812
Begin DoDot:2
+7 SET PXCEAFTR(PXCENODE)=$SELECT(PXCEVIEN>0:$GET(^AUPNVSIT(PXCEVIEN,PXCENODE)),1:"")
+8 SET ^TMP("PXK",$JOB,"VST",1,PXCENODE,"BEFORE")=PXCEAFTR(PXCENODE)
End DoDot:2
End DoDot:1
+9 IF '$TEST
Begin DoDot:1
+10 FOR PXCENODE=0,21,150,800,811,812
Begin DoDot:2
+11 SET ^TMP("PXK",$JOB,"VST",1,PXCENODE,"BEFORE")=$GET(^AUPNVSIT(+PXCEVIEN,PXCENODE))
+12 SET ^TMP("PXK",$JOB,"VST",1,PXCENODE,"AFTER")=^TMP("PXK",$JOB,"VST",1,PXCENODE,"BEFORE")
End DoDot:2
+13 ;
+14 SET ^TMP("PXK",$JOB,PXCECATS,1,"IEN")=PXCEFIEN
+15 SET PXCENODS=$PIECE($TEXT(FORMAT^@PXCECODE),"~",3)
+16 FOR PXCEFOR=1:1
SET PXCENODE=$PIECE(PXCENODS,",",PXCEFOR)
if PXCENODE']""
QUIT
Begin DoDot:2
+17 IF PXCEFIEN>0
Begin DoDot:3
+18 IF PXCECAT="CPT"
IF PXCENODE=1
Begin DoDot:4
+19 ;Retrieve CPT Modifiers from multiple field
+20 SET PXCESEQ=0
+21 FOR
SET PXCESEQ=$ORDER(@(PXCEAUPN_"(PXCEFIEN,PXCENODE,PXCESEQ)"))
if 'PXCESEQ
QUIT
Begin DoDot:5
+22 SET ^TMP("PXK",$JOB,PXCECATS,1,PXCENODE,PXCESEQ,"BEFORE")=$GET(@(PXCEAUPN_"(PXCEFIEN,PXCENODE,PXCESEQ,0)"))
+23 SET PXCEAFTR(PXCENODE,PXCESEQ)=^TMP("PXK",$JOB,PXCECATS,1,PXCENODE,PXCESEQ,"BEFORE")
End DoDot:5
End DoDot:4
+24 IF '$TEST
Begin DoDot:4
+25 SET ^TMP("PXK",$JOB,PXCECATS,1,PXCENODE,"BEFORE")=$GET(@(PXCEAUPN_"(PXCEFIEN,PXCENODE)"))
+26 SET PXCEAFTR(PXCENODE)=^TMP("PXK",$JOB,PXCECATS,1,PXCENODE,"BEFORE")
End DoDot:4
End DoDot:3
+27 IF '$TEST
Begin DoDot:3
+28 IF PXCECAT="CPT"
IF PXCENODE=1
Begin DoDot:4
+29 SET ^TMP("PXK",$JOB,PXCECATS,1,PXCENODE,1,"BEFORE")=""
End DoDot:4
QUIT
+30 SET ^TMP("PXK",$JOB,PXCECATS,1,PXCENODE,"BEFORE")=""
+31 SET PXCEAFTR(PXCENODE)=^TMP("PXK",$JOB,PXCECATS,1,PXCENODE,"BEFORE")
End DoDot:3
End DoDot:2
End DoDot:1
+32 if PXCEQUIT
QUIT
+33 ;
+34 IF PXCEAUPN'="^AUPNVSIT"
Begin DoDot:1
+35 ;Set the Patient and Visit pointers in the V-File.
+36 if '$PIECE(PXCEAFTR(0),"^",2)
SET $PIECE(PXCEAFTR(0),"^",2)=PXCEPAT
+37 if '$PIECE(PXCEAFTR(0),"^",3)
SET $PIECE(PXCEAFTR(0),"^",3)=PXCEVIEN
+38 IF $PIECE(PXCEAFTR(0),"^",1)=""
Begin DoDot:2
+39 if '$PIECE(PXCEAFTR(812),"^",2)
SET $PIECE(PXCEAFTR(812),"^",2)=PXCEPKG
+40 if '$PIECE(PXCEAFTR(812),"^",3)
SET $PIECE(PXCEAFTR(812),"^",3)=PXCESOR
End DoDot:2
End DoDot:1
+41 IF '$TEST
Begin DoDot:1
+42 ;If new visit set package and source.
+43 IF $PIECE(PXCEAFTR(0),"^",1)=""
Begin DoDot:2
+44 if '$PIECE(PXCEAFTR(812),"^",2)
SET $PIECE(PXCEAFTR(812),"^",2)=PXCEPKG
+45 if '$PIECE(PXCEAFTR(812),"^",3)
SET $PIECE(PXCEAFTR(812),"^",3)=PXCESOR
End DoDot:2
+46 ;Set the Patient in the Visit for new visit.
+47 IF $GET(PXCEAPDT)>0
Begin DoDot:2
+48 if '$PIECE(PXCEAFTR(0),"^",1)
SET $PIECE(PXCEAFTR(0),"^",1)=PXCEAPDT
+49 IF '$PIECE(PXCEAFTR(0),"^",21)
Begin DoDot:3
+50 ;Get the ELIGIBILITY for the appointment
+51 NEW PXCEELIG
+52 SET PXCEELIG=$$ELIGIBIL^PXCEVSIT(PXCEPAT,PXCEHLOC,PXCEAPDT)
+53 if PXCEELIG>0
SET $PIECE(PXCEAFTR(0),"^",21)=PXCEELIG
End DoDot:3
End DoDot:2
+54 if '$PIECE(PXCEAFTR(0),"^",5)&($GET(PXCEPAT)>0)
SET $PIECE(PXCEAFTR(0),"^",5)=PXCEPAT
+55 if '$PIECE(PXCEAFTR(0),"^",22)&($GET(PXCEHLOC)>0)
SET $PIECE(PXCEAFTR(0),"^",22)=PXCEHLOC
End DoDot:1
+56 QUIT
+57 ;
EXIT ; -- exit code
+1 IF PXCECAT="SIT"!(PXCECAT="APPM")!(PXCECAT="HIST")
if PXCEVIEN>0
LOCK -@(PXCEAUPN_"(PXCEVIEN)"):30
+2 IF '$TEST
if PXCEFIEN>0
LOCK -@(PXCEAUPN_"(PXCEFIEN)"):30
+3 SET PXCEFIEN=""
+4 KILL ^TMP("PXK",$JOB)
+5 KILL PXCEAFTR
+6 SET PXCEQUIT=0
+7 QUIT
+8 ;
MODUPD ;Update the MODIFIER list for the currently edited CPT code when all
+1 ;the reqired data is not entered.
+2 ;
+3 NEW SQ,DA,DIC,DIK,X
+4 SET SQ=""
+5 FOR
SET SQ=$ORDER(PXCEAFTR(1,SQ))
if 'SQ
QUIT
Begin DoDot:1
+6 SET DA(1)=PXCEFIEN
SET DA=SQ
+7 SET DIK="^AUPNVCPT("_DA(1)_","_1_","
+8 DO ^DIK
End DoDot:1
+9 FOR
SET SQ=$ORDER(^TMP("PXK",$JOB,"CPT",1,1,SQ))
if 'SQ
QUIT
Begin DoDot:1
+10 SET X=^TMP("PXK",$JOB,"CPT",1,1,SQ,"BEFORE")
+11 if X']""
QUIT
+12 KILL DD,DO
+13 SET DA(1)=PXCEFIEN
+14 SET DIC="^AUPNVCPT("_DA(1)_","_1_","
+15 SET DIC(0)="L"
SET DIC("P")=$PIECE(^DD(9000010.18,1,0),"^",2)
+16 DO FILE^DICN
End DoDot:1
+17 QUIT
+18 ;
REMOVE(DA) ;REMOVE INCOMPLETE CPT ENTRY
+1 NEW DIK
+2 SET DIK="^AUPNVCPT("
+3 ;PX*1*124
IF $GET(DA)
DO ^DIK
+4 QUIT
