PXCEVFIL ;ISL/dee - Main routine to edit a visit or v-file entry ;3/28/97
;;1.0;PCE PATIENT CARE ENCOUNTER;**9,30,22,73,88,89,104**;Aug 12, 1996
;
Q
EN(PXCECAT) ; -- main entry point for PXCE pxcecat EDIT
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
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=0
I '$D(PXCAAFTR),PXCECAT'="SIT",PXCECAT'="APPM",PXCECAT'="HIST",PXCEFIEN'>0 D ASK^PXCEVFI2(PXCEVIEN,.PXCEFIEN,PXCEAUPN,PXCECATT,PXCECODE)
Q:PXCEQUIT
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 PXCEUP,PXELAP
N PXCEAFTR
D INIT
Q:PXCEQUIT
DOONE2 ;
K PXKERROR
S PXCENOER=0
D EDIT^PXCEVFI1
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
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
. I PXCEVIEN>0 L +@(PXCEAUPN_"(PXCEVIEN)"):5 E W !!,$C(7),"Cannot edit at this time, try again later." D PAUSE^PXCEHELP S PXCEQUIT=1 Q
. 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
. I PXCEFIEN>0 L +@(PXCEAUPN_"(PXCEFIEN)"):5 E W !!,$C(7),"Cannot edit at this time, try again later." D PAUSE^PXCEHELP S PXCEQUIT=1 Q
. 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("
D ^DIK
Q
PXCEVFIL ;ISL/dee - Main routine to edit a visit or v-file entry ;3/28/97
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**9,30,22,73,88,89,104**;Aug 12, 1996
+2 ;
+3 QUIT
EN(PXCECAT) ; -- main entry point for PXCE pxcecat EDIT
+1 IF PXCECAT'="SIT"
IF PXCECAT'="APPM"
IF PXCECAT'="HIST"
IF '$DATA(PXCEFIEN)!'$DATA(PXCEVIEN)!'$DATA(PXCEPAT)
QUIT
+2 IF '$TEST
IF (PXCEVIEW["P"&'$DATA(PXCEPAT))!(PXCEVIEW["H"&'$DATA(PXCEHLOC))!("~H~P~"'[("~"_$PIECE(PXCEVIEW,"^")_"~"))
QUIT
+3 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
+4 NEW PXCEQUIT
+5 IF "~CPT~CSTP~"[PXCECAT
Begin DoDot:1
+6 SET PXCEQUIT=0
+7 IF $PIECE($GET(^AUPNVSIT(PXCEVIEN,0)),"^",7)="E"
Begin DoDot:2
+8 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
+9 KILL PXCEQUIT
+10 DO FULL^VALM1
+11 ;
+12 NEW PXCEVFIL,PXCELOOP,PXCENOER
+13 NEW PXCECODE,PXCEAUPN,PXCECATS,PXCECATT,PXCEFILE
+14 NEW PXCEPSCC
+15 SET PXCECATS=$SELECT(PXCECAT="SIT":"VST",PXCECAT="APPM":"VST",PXCECAT="HIST":"VST",PXCECAT="CSTP":"VST",1:PXCECAT)
+16 SET PXCECODE="PXCE"_$SELECT(PXCECAT="IMM":"VIMM",1:PXCECAT)
+17 SET PXCEAUPN=$PIECE($TEXT(FORMAT^@PXCECODE),"~",5)
+18 SET PXCECATT=$PIECE($PIECE($TEXT(FORMAT^@PXCECODE),";;",2),"~",1)
+19 SET PXCEFILE=$PIECE($TEXT(FORMAT^@PXCECODE),"~",2)
+20 SET PXCEQUIT=0
+21 IF '$DATA(PXCAAFTR)
IF PXCECAT'="SIT"
IF PXCECAT'="APPM"
IF PXCECAT'="HIST"
IF PXCEFIEN'>0
DO ASK^PXCEVFI2(PXCEVIEN,.PXCEFIEN,PXCEAUPN,PXCECATT,PXCECODE)
+22 IF PXCEQUIT
QUIT
+23 IF PXCECAT'="SIT"
IF PXCECAT'="APPM"
IF PXCECAT'="HIST"
SET PXCELOOP=+PXCEFIEN
+24 IF '$TEST
SET PXCELOOP=1
SET PXCEFIEN=PXCEVIEN
+25 IF PXCECAT="CSTP"
Begin DoDot:1
+26 IF $$VSTAPPT^PXUTL1(PXCEPAT,+^AUPNVSIT(PXCEVIEN,0),PXCEHLOC,PXCEVIEN)
SET PXCELOOP=0
+27 IF '$TEST
SET PXCELOOP=1
End DoDot:1
+28 IF $DATA(PXCAAFTR)
SET PXCELOOP=1
+29 FOR
DO DOONE
IF PXCELOOP
QUIT
+30 KILL PXCEFIEN
+31 QUIT
+32 ;
DOONE ;
+1 NEW PXCEUP,PXELAP
+2 NEW PXCEAFTR
+3 DO INIT
+4 IF PXCEQUIT
QUIT
DOONE2 ;
+1 KILL PXKERROR
+2 SET PXCENOER=0
+3 DO EDIT^PXCEVFI1
+4 IF ($PIECE(PXCEAFTR(0),"^")]"")
Begin DoDot:1
+5 IF PXCEQUIT
Begin DoDot:2
+6 IF 'PXCEFIEN
IF PXCECAT="CPT"
Begin DoDot:3
+7 DO REMOVE(^TMP("PXK",$JOB,PXCECAT,1,"IEN"))
End DoDot:3
+8 IF 'PXCENOER
Begin DoDot:3
+9 IF PXCEFIEN>0
Begin DoDot:4
+10 IF PXCECAT="CPT"
DO MODUPD
+11 WRITE !,$CHAR(7),"The last entry did not have all of the required data and NOTHING was CHANGED."
End DoDot:4
+12 IF '$TEST
WRITE !,$CHAR(7),"The last entry did not have all of the required data and NOTHING was STORED."
+13 DO WAIT^PXCEHELP
End DoDot:3
End DoDot:2
+14 IF '$TEST
DO SAVE^PXCEVFI2
End DoDot:1
+15 DO EXIT
+16 QUIT
+17 ;
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 IF PXCEVIEN>0
LOCK +@(PXCEAUPN_"(PXCEVIEN)"):5
IF '$TEST
WRITE !!,$CHAR(7),"Cannot edit at this time, try again later."
DO PAUSE^PXCEHELP
SET PXCEQUIT=1
QUIT
+7 FOR PXCENODE=0,21,150,800,811,812
Begin DoDot:2
+8 SET PXCEAFTR(PXCENODE)=$SELECT(PXCEVIEN>0:$GET(^AUPNVSIT(PXCEVIEN,PXCENODE)),1:"")
+9 SET ^TMP("PXK",$JOB,"VST",1,PXCENODE,"BEFORE")=PXCEAFTR(PXCENODE)
End DoDot:2
End DoDot:1
+10 IF '$TEST
Begin DoDot:1
+11 IF PXCEFIEN>0
LOCK +@(PXCEAUPN_"(PXCEFIEN)"):5
IF '$TEST
WRITE !!,$CHAR(7),"Cannot edit at this time, try again later."
DO PAUSE^PXCEHELP
SET PXCEQUIT=1
QUIT
+12 FOR PXCENODE=0,21,150,800,811,812
Begin DoDot:2
+13 SET ^TMP("PXK",$JOB,"VST",1,PXCENODE,"BEFORE")=$GET(^AUPNVSIT(+PXCEVIEN,PXCENODE))
+14 SET ^TMP("PXK",$JOB,"VST",1,PXCENODE,"AFTER")=^TMP("PXK",$JOB,"VST",1,PXCENODE,"BEFORE")
End DoDot:2
+15 ;
+16 SET ^TMP("PXK",$JOB,PXCECATS,1,"IEN")=PXCEFIEN
+17 SET PXCENODS=$PIECE($TEXT(FORMAT^@PXCECODE),"~",3)
+18 FOR PXCEFOR=1:1
SET PXCENODE=$PIECE(PXCENODS,",",PXCEFOR)
IF PXCENODE']""
QUIT
Begin DoDot:2
+19 IF PXCEFIEN>0
Begin DoDot:3
+20 IF PXCECAT="CPT"
IF PXCENODE=1
Begin DoDot:4
+21 ;Retrieve CPT Modifiers from multiple field
+22 SET PXCESEQ=0
+23 FOR
SET PXCESEQ=$ORDER(@(PXCEAUPN_"(PXCEFIEN,PXCENODE,PXCESEQ)"))
IF 'PXCESEQ
QUIT
Begin DoDot:5
+24 SET ^TMP("PXK",$JOB,PXCECATS,1,PXCENODE,PXCESEQ,"BEFORE")=$GET(@(PXCEAUPN_"(PXCEFIEN,PXCENODE,PXCESEQ,0)"))
+25 SET PXCEAFTR(PXCENODE,PXCESEQ)=^TMP("PXK",$JOB,PXCECATS,1,PXCENODE,PXCESEQ,"BEFORE")
End DoDot:5
End DoDot:4
+26 IF '$TEST
Begin DoDot:4
+27 SET ^TMP("PXK",$JOB,PXCECATS,1,PXCENODE,"BEFORE")=$GET(@(PXCEAUPN_"(PXCEFIEN,PXCENODE)"))
+28 SET PXCEAFTR(PXCENODE)=^TMP("PXK",$JOB,PXCECATS,1,PXCENODE,"BEFORE")
End DoDot:4
End DoDot:3
+29 IF '$TEST
Begin DoDot:3
+30 IF PXCECAT="CPT"
IF PXCENODE=1
Begin DoDot:4
+31 SET ^TMP("PXK",$JOB,PXCECATS,1,PXCENODE,1,"BEFORE")=""
End DoDot:4
QUIT
+32 SET ^TMP("PXK",$JOB,PXCECATS,1,PXCENODE,"BEFORE")=""
+33 SET PXCEAFTR(PXCENODE)=^TMP("PXK",$JOB,PXCECATS,1,PXCENODE,"BEFORE")
End DoDot:3
End DoDot:2
End DoDot:1
+34 IF PXCEQUIT
QUIT
+35 ;
+36 IF PXCEAUPN'="^AUPNVSIT"
Begin DoDot:1
+37 ;Set the Patient and Visit pointers in the V-File.
+38 IF '$PIECE(PXCEAFTR(0),"^",2)
SET $PIECE(PXCEAFTR(0),"^",2)=PXCEPAT
+39 IF '$PIECE(PXCEAFTR(0),"^",3)
SET $PIECE(PXCEAFTR(0),"^",3)=PXCEVIEN
+40 IF $PIECE(PXCEAFTR(0),"^",1)=""
Begin DoDot:2
+41 IF '$PIECE(PXCEAFTR(812),"^",2)
SET $PIECE(PXCEAFTR(812),"^",2)=PXCEPKG
+42 IF '$PIECE(PXCEAFTR(812),"^",3)
SET $PIECE(PXCEAFTR(812),"^",3)=PXCESOR
End DoDot:2
End DoDot:1
+43 IF '$TEST
Begin DoDot:1
+44 ;If new visit set package and source.
+45 IF $PIECE(PXCEAFTR(0),"^",1)=""
Begin DoDot:2
+46 IF '$PIECE(PXCEAFTR(812),"^",2)
SET $PIECE(PXCEAFTR(812),"^",2)=PXCEPKG
+47 IF '$PIECE(PXCEAFTR(812),"^",3)
SET $PIECE(PXCEAFTR(812),"^",3)=PXCESOR
End DoDot:2
+48 ;Set the Patient in the Visit for new visit.
+49 IF $GET(PXCEAPDT)>0
Begin DoDot:2
+50 IF '$PIECE(PXCEAFTR(0),"^",1)
SET $PIECE(PXCEAFTR(0),"^",1)=PXCEAPDT
+51 IF '$PIECE(PXCEAFTR(0),"^",21)
Begin DoDot:3
+52 ;Get the ELIGIBILITY for the appointment
+53 NEW PXCEELIG
+54 SET PXCEELIG=$$ELIGIBIL^PXCEVSIT(PXCEPAT,PXCEHLOC,PXCEAPDT)
+55 IF PXCEELIG>0
SET $PIECE(PXCEAFTR(0),"^",21)=PXCEELIG
End DoDot:3
End DoDot:2
+56 IF '$PIECE(PXCEAFTR(0),"^",5)&($GET(PXCEPAT)>0)
SET $PIECE(PXCEAFTR(0),"^",5)=PXCEPAT
+57 IF '$PIECE(PXCEAFTR(0),"^",22)&($GET(PXCEHLOC)>0)
SET $PIECE(PXCEAFTR(0),"^",22)=PXCEHLOC
End DoDot:1
+58 QUIT
+59 ;
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 DO ^DIK
+4 QUIT
