PXCECPT ;ISL/dee,ISA/Zoltan,esw - Used to edit and display V CPT ; 1/13/03 4:21pm
;;1.0;PCE PATIENT CARE ENCOUNTER;**14,27,73,89,112**;Aug 12, 1996
;; ;
Q
;
;+Structure of Line with the line label "FORMAT"
;+;;Long name~File Number~Node Subscripts~Allow Duplicate entries (1=yes, 0=no)~File global name
;+ 1 2 3 4 5
;+
;+Structure of Followning lines:
;+;;Node~Piece~,Field Number~Edit Label~Display Label~Display Routine~Edit Routine~Help Text for DIR("?")~Set of PXCEKEYS that can Edit~D if Detail Display Only~
;+ 1 ~ 2 ~ 3 ~ 4 ~ 5 ~ 6 ~ 7 ~ 8 ~ 9 ~ 10
;+The Display & Edit routines are for special cases.
;+ (The .01 fields cannot have a special edit.)
;
FORMAT ;;CPT~9000010.18~0,1,12,802,811,812~1~^AUPNVCPT
;;0~1~.01~CPT Code: ~CPT Code: ~$$DISPLY01^PXCECPT~ECPTCODE^PXCECPT~^D HELP^PXCEHELP~~B
;;1~0~1~CPT Modifier: ~CPT Modifier: ~$$DISPMOD^PXCECPT~ECPTMOD^PXCECPT~Select a Modifier that is valid for the CPT code.~~B
;;0~4~.04~Provider Narrative: ~Provider Narrative: ~$$DNARRAT^PXCECPT~ENARRAT^PXCEPOV1(1,1,1,81,2)~~~B
;;0~16~.16~Quantity: ~Quantity: ~~EQUAN^PXCECPT~~~D
;;0~7~.07~Principal Procedure: ~Principal Procedure: ~~~~~D
;;12~4~1204~Encounter Provider: ~Encounter Provider: ~~EPROV12^PXCEPRV~~~D
;;802~1~80201~Provider Narrative Category: ~Provider Narrative Category: ~$$DNARRAT^PXCECPT~ENARRAT^PXCEPOV1(0,2,0,81,3)~~C~D
;;811~1~81101~Comments: ~Comments: ~~~~~D
;;
;Do not use this one
;;0~5~.05~Diagnosis: ~Diagnosis: ~$$DISPLY01^PXCEPOV~~~~D
;
;The interface for AICS to get list on form for help.
INTRFACE ;;DG SELECT CPT PROCEDURE CODES
;+
;+********************************
;+Special cases for display.
;
DISPMOD(PXCECPT) ;
;+Display the modifiers associated with this V CPT entry.
;+PXCECPT = IEN in V CPT file.
N MODS,SIEN,MODIEN,SCRATCH,MODSTR,MODNAME,OUTSTR
I $G(PXCECPT)="" S PXCECPT=IEN
S OUTSTR=""
I PXCECPT="" Q OUTSTR
S SIEN=0
F MODS=1:1 S SIEN=$O(^AUPNVCPT(PXCECPT,1,SIEN)) Q:'SIEN D
. S MODIEN=$P($G(^AUPNVCPT(PXCECPT,1,SIEN,0)),"^")
. S $P(OUTSTR,U,MODS)=$$MODTEXT(MODIEN)
Q OUTSTR
DNARRAT(PNAR) ;+Display Provider Narrative for procedure in V CPT file.
I PNAR="" Q ""
N PXCEPNAR
S PXCEPNAR=$P(^AUTNPOV(PNAR,0),"^")
I $G(VIEW)="B",$D(ENTRY)>0 D
. N DIC,DR,DA,DIQ,PXCEDIQ1
. S DIC=81
. S DR="2"
. S DA=$P(ENTRY(0),"^",1)
. S DIQ="PXCEDIQ1("
. S DIQ(0)="E"
. D EN^DIQ1
. S:PXCEDIQ1(81,DA,2,"E")=PXCEPNAR PXCEPNAR=""
Q PXCEPNAR
;+
;+********************************
;+Special cases for edit.
;+
ECPTCODE ;+Code to edit CPT Code in V CPT file.
K DIRUT
N DIC,DA,PXCPTDT,PXDFLT
S PXCPTDT=+^TMP("PXK",$J,"VST",1,0,"AFTER")
S (X,PXDFLT)=""
I $P(PXCEAFTR($P(PXCETEXT,"~",1)),"^",$P(PXCETEXT,"~",2))'="" D
. N DIERR,PXCEDILF,PXCEINT,PXCEEXT
. S PXCEINT=$P(PXCEAFTR($P(PXCETEXT,"~",1)),"^",$P(PXCETEXT,"~",2))
. S PXCEEXT=$$EXTERNAL^DILFD(PXCEFILE,$P(PXCETEXT,"~",3),"",PXCEINT,"PXCEDILF")
. S PXDFLT=$S('$D(DIERR):PXCEEXT,1:PXCEINT)
S Y=$$GETCODE^PXCPTAPI(PXDFLT,PXCPTDT)
I Y="@" S X="@" Q
I Y<0 S DIRUT=1 Q
S PXCEMOD=$P(Y,"-",2)
S Y=$P(Y,"-"),X=+Y
I PXCEDIRB="" Q
I $P(PXCEAFTR($P(PXCETEXT,"~",1)),"^",$P(PXCETEXT,"~",2))=X Q
Q:$$CHGCPT()
G ECPTCODE
;
ECPTMOD ;+Prompt for CPT Modifier in V CPT file.
;
;--If there are no modifiers for CPT code do not prompt
Q:PXMDCNT'>0
N DTOUT,DUOUT,DIROUT,DIR,PXSUB,PXSEQ,PXSTR,PXARR
N DA,DIC,PXLINE,SUBIEN,PXFILE,PXMOD,PXI
S PXSUB=1,PXSTR=""
S DA=^TMP("PXK",$J,PXCECATS,1,"IEN")
S DR=1
S DIE="^AUPNVCPT("
S DIC(0)="AELMQ"
L +@(DIE_"DA)"):10
I $G(PXCEMOD)]"" D
. I $L(PXCEMOD,",")=1 S DR="1//"_PXCEMOD Q
. S PXMOD=""
. F PXI=1:1 S PXMOD=$P(PXCEMOD,",",PXI) Q:PXMOD="" D
.. K PXERR
.. D VAL^DIE(9000010.181,DA,.01,"",PXMOD,.PXERR)
.. Q:PXERR="^"
.. S DR="1///^S X=PXMOD"
.. D ^DIE
. S DR=1
D ^DIE
L -@(DIE_"DA)")
; SET NEWLY FILED CPT MODIFIERS INTO LOCAL ARRAY
K PXCEAFTR(1)
D GETS^DIQ(9000010.18,^TMP("PXK",$J,PXCECATS,1,"IEN"),"1*","I","PXARR")
S PXFILE=9000010.181
S PXSUB=""
F S PXSUB=$O(PXARR(PXFILE,PXSUB)) Q:PXSUB="" D
. S PXCEAFTR(1,$P(PXSUB,","))=PXARR(PXFILE,PXSUB,.01,"I")
I $D(DTOUT)!$D(Y) S (PXCEEND,PXCEQUIT)=1 Q
Q
;
EQUAN ;+Code to edit Quantity in V CPT file.
I $P(PXCEAFTR($P(PXCETEXT,"~",1)),"^",$P(PXCETEXT,"~",2))'="" D
. N DIERR,PXCEDILF,PXCEINT,PXCEEXT
. S PXCEINT=$P(PXCEAFTR($P(PXCETEXT,"~",1)),"^",$P(PXCETEXT,"~",2))
. S PXCEEXT=$$EXTERNAL^DILFD(PXCEFILE,$P(PXCETEXT,"~",3),"",PXCEINT,"PXCEDILF")
. S DIR("B")=$S('$D(DIERR):PXCEEXT,1:PXCEINT)
E S DIR("B")=1
S DIR(0)=PXCEFILE_","_$P(PXCETEXT,"~",3)_"A"
S DIR("A")=$P(PXCETEXT,"~",4)
S:$P(PXCETEXT,"~",8)]"" DIR("?")=$P(PXCETEXT,"~",8)
D ^DIR
K DIR,DA
I $D(DTOUT)!$D(DUOUT) S (PXCEEND,PXCEQUIT)=1 Q
I +Y<1 W !,$C(7),"Quanitity is required.",! G EQUAN
I +Y>1,$D(^IBE(357.69,$G(PXCEIN01))) W !,"Only one E&M allowed, quantity changed to 1.",! S Y=1 ;PX112
S:$P(Y,"^")="" Y=1
S $P(PXCEAFTR($P(PXCETEXT,"~",1)),"^",$P(PXCETEXT,"~",2))=$P(Y,"^")
Q
;+
;+********************************
;+Special Reusable Functionality
DISPLY01(PXCECPT) ;
;Display text for the .01 field which is a pointer to ^ICPT.
;Also called with the Evaluation and Management Code from the visit
; in the parameter.
;(Must have is called by ASK^PXCEVFI2 and DEL^PXCEVFI2.)
N DIC,DR,DA,DIQ,PXCEFNUM,PXCEDIQ1
S (DIC,PXCEFNUM)=81
S DR=".01;2"
S DA=+$P(PXCECPT,"^",1)
S DIQ="PXCEDIQ1("
S DIQ(0)="E"
D EN^DIQ1
Q PXCEDIQ1(PXCEFNUM,DA,.01,"E")_" "_PXCEDIQ1(PXCEFNUM,DA,2,"E")
EDMOD(MODS,CPT) ;+Edit the Modifiers for a CPT code entry.
N MNUM S MNUM=0 ; Modifier number.
N MIEN,MTEXT
Q
MODNAME(MODIEN) ;+Return #.02 NAME for this CPT MODIFIER (#81.3)
Q
MODTEXT(MODIEN) ;+Return string of text describing modifier.
;+MODIEN = IEN in CPT MODIFIER file (#81.3).
;+Returns: MODIFIER (#.01) followed by NAME(#.02).
N MOD,DESC,TEXT,RVAL
S RVAL=$$MOD^ICPTMOD(MODIEN,"I")
S MOD=$P(RVAL,"^",2)
S DESC=$P(RVAL,"^",3)
S TEXT=MOD_" "_DESC
Q TEXT
CHGCPT() ;Verify CPT code should be modified
;If response is yes remove modifiers on file for CPT code
N DIR,DA,X,Y,PXIEN
W !!,$C(7),"WARNING! THIS WILL ALSO DELETE ANY MODIFIERS ASSOCIATED WITH CPT CODE "_PXCEDIRB
S DIR(0)="Y"
S DIR("A")="SURE YOU WANT TO CHANGE THE CPT CODE?"
S DIR("B")="YES"
D ^DIR
;Delete CPT Modifiers from V CPT file for current IEN
I 'Y Q +Y
S DA(1)=PXCEFIEN
S DIK="^AUPNVCPT("_DA(1)_","_1_","
S PXIEN=""
F S PXIEN=$O(PXCEAFTR(1,PXIEN)) Q:PXIEN="" D
. S DA=PXIEN
. D ^DIK
Q 1
;
NEWCODE ;
K DD,DO
N DIC,X,Y
S DIC="^AUPNVCPT("
S DIC(0)=""
S DIC("DR")=".02////^S X=$P(PXCEAFTR(0),""^"",2);"
S DIC("DR")=DIC("DR")_".03////^S X=$P(PXCEAFTR(0),""^"",3);"
S X=PXCEIN01
D FILE^DICN
S PXCEFIEN=+Y
Q
PXCECPT ;ISL/dee,ISA/Zoltan,esw - Used to edit and display V CPT ; 1/13/03 4:21pm
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**14,27,73,89,112**;Aug 12, 1996
+2 ;; ;
+3 QUIT
+4 ;
+5 ;+Structure of Line with the line label "FORMAT"
+6 ;+;;Long name~File Number~Node Subscripts~Allow Duplicate entries (1=yes, 0=no)~File global name
+7 ;+ 1 2 3 4 5
+8 ;+
+9 ;+Structure of Followning lines:
+10 ;+;;Node~Piece~,Field Number~Edit Label~Display Label~Display Routine~Edit Routine~Help Text for DIR("?")~Set of PXCEKEYS that can Edit~D if Detail Display Only~
+11 ;+ 1 ~ 2 ~ 3 ~ 4 ~ 5 ~ 6 ~ 7 ~ 8 ~ 9 ~ 10
+12 ;+The Display & Edit routines are for special cases.
+13 ;+ (The .01 fields cannot have a special edit.)
+14 ;
FORMAT ;;CPT~9000010.18~0,1,12,802,811,812~1~^AUPNVCPT
+1 ;;0~1~.01~CPT Code: ~CPT Code: ~$$DISPLY01^PXCECPT~ECPTCODE^PXCECPT~^D HELP^PXCEHELP~~B
+2 ;;1~0~1~CPT Modifier: ~CPT Modifier: ~$$DISPMOD^PXCECPT~ECPTMOD^PXCECPT~Select a Modifier that is valid for the CPT code.~~B
+3 ;;0~4~.04~Provider Narrative: ~Provider Narrative: ~$$DNARRAT^PXCECPT~ENARRAT^PXCEPOV1(1,1,1,81,2)~~~B
+4 ;;0~16~.16~Quantity: ~Quantity: ~~EQUAN^PXCECPT~~~D
+5 ;;0~7~.07~Principal Procedure: ~Principal Procedure: ~~~~~D
+6 ;;12~4~1204~Encounter Provider: ~Encounter Provider: ~~EPROV12^PXCEPRV~~~D
+7 ;;802~1~80201~Provider Narrative Category: ~Provider Narrative Category: ~$$DNARRAT^PXCECPT~ENARRAT^PXCEPOV1(0,2,0,81,3)~~C~D
+8 ;;811~1~81101~Comments: ~Comments: ~~~~~D
+9 ;;
+10 ;Do not use this one
+11 ;;0~5~.05~Diagnosis: ~Diagnosis: ~$$DISPLY01^PXCEPOV~~~~D
+12 ;
+13 ;The interface for AICS to get list on form for help.
INTRFACE ;;DG SELECT CPT PROCEDURE CODES
+1 ;+
+2 ;+********************************
+3 ;+Special cases for display.
+4 ;
DISPMOD(PXCECPT) ;
+1 ;+Display the modifiers associated with this V CPT entry.
+2 ;+PXCECPT = IEN in V CPT file.
+3 NEW MODS,SIEN,MODIEN,SCRATCH,MODSTR,MODNAME,OUTSTR
+4 IF $GET(PXCECPT)=""
SET PXCECPT=IEN
+5 SET OUTSTR=""
+6 IF PXCECPT=""
QUIT OUTSTR
+7 SET SIEN=0
+8 FOR MODS=1:1
SET SIEN=$ORDER(^AUPNVCPT(PXCECPT,1,SIEN))
IF 'SIEN
QUIT
Begin DoDot:1
+9 SET MODIEN=$PIECE($GET(^AUPNVCPT(PXCECPT,1,SIEN,0)),"^")
+10 SET $PIECE(OUTSTR,U,MODS)=$$MODTEXT(MODIEN)
End DoDot:1
+11 QUIT OUTSTR
DNARRAT(PNAR) ;+Display Provider Narrative for procedure in V CPT file.
+1 IF PNAR=""
QUIT ""
+2 NEW PXCEPNAR
+3 SET PXCEPNAR=$PIECE(^AUTNPOV(PNAR,0),"^")
+4 IF $GET(VIEW)="B"
IF $DATA(ENTRY)>0
Begin DoDot:1
+5 NEW DIC,DR,DA,DIQ,PXCEDIQ1
+6 SET DIC=81
+7 SET DR="2"
+8 SET DA=$PIECE(ENTRY(0),"^",1)
+9 SET DIQ="PXCEDIQ1("
+10 SET DIQ(0)="E"
+11 DO EN^DIQ1
+12 IF PXCEDIQ1(81,DA,2,"E")=PXCEPNAR
SET PXCEPNAR=""
End DoDot:1
+13 QUIT PXCEPNAR
+14 ;+
+15 ;+********************************
+16 ;+Special cases for edit.
+17 ;+
ECPTCODE ;+Code to edit CPT Code in V CPT file.
+1 KILL DIRUT
+2 NEW DIC,DA,PXCPTDT,PXDFLT
+3 SET PXCPTDT=+^TMP("PXK",$JOB,"VST",1,0,"AFTER")
+4 SET (X,PXDFLT)=""
+5 IF $PIECE(PXCEAFTR($PIECE(PXCETEXT,"~",1)),"^",$PIECE(PXCETEXT,"~",2))'=""
Begin DoDot:1
+6 NEW DIERR,PXCEDILF,PXCEINT,PXCEEXT
+7 SET PXCEINT=$PIECE(PXCEAFTR($PIECE(PXCETEXT,"~",1)),"^",$PIECE(PXCETEXT,"~",2))
+8 SET PXCEEXT=$$EXTERNAL^DILFD(PXCEFILE,$PIECE(PXCETEXT,"~",3),"",PXCEINT,"PXCEDILF")
+9 SET PXDFLT=$SELECT('$DATA(DIERR):PXCEEXT,1:PXCEINT)
End DoDot:1
+10 SET Y=$$GETCODE^PXCPTAPI(PXDFLT,PXCPTDT)
+11 IF Y="@"
SET X="@"
QUIT
+12 IF Y<0
SET DIRUT=1
QUIT
+13 SET PXCEMOD=$PIECE(Y,"-",2)
+14 SET Y=$PIECE(Y,"-")
SET X=+Y
+15 IF PXCEDIRB=""
QUIT
+16 IF $PIECE(PXCEAFTR($PIECE(PXCETEXT,"~",1)),"^",$PIECE(PXCETEXT,"~",2))=X
QUIT
+17 IF $$CHGCPT()
QUIT
+18 GOTO ECPTCODE
+19 ;
ECPTMOD ;+Prompt for CPT Modifier in V CPT file.
+1 ;
+2 ;--If there are no modifiers for CPT code do not prompt
+3 IF PXMDCNT'>0
QUIT
+4 NEW DTOUT,DUOUT,DIROUT,DIR,PXSUB,PXSEQ,PXSTR,PXARR
+5 NEW DA,DIC,PXLINE,SUBIEN,PXFILE,PXMOD,PXI
+6 SET PXSUB=1
SET PXSTR=""
+7 SET DA=^TMP("PXK",$JOB,PXCECATS,1,"IEN")
+8 SET DR=1
+9 SET DIE="^AUPNVCPT("
+10 SET DIC(0)="AELMQ"
+11 LOCK +@(DIE_"DA)"):10
+12 IF $GET(PXCEMOD)]""
Begin DoDot:1
+13 IF $LENGTH(PXCEMOD,",")=1
SET DR="1//"_PXCEMOD
QUIT
+14 SET PXMOD=""
+15 FOR PXI=1:1
SET PXMOD=$PIECE(PXCEMOD,",",PXI)
IF PXMOD=""
QUIT
Begin DoDot:2
+16 KILL PXERR
+17 DO VAL^DIE(9000010.181,DA,.01,"",PXMOD,.PXERR)
+18 IF PXERR="^"
QUIT
+19 SET DR="1///^S X=PXMOD"
+20 DO ^DIE
End DoDot:2
+21 SET DR=1
End DoDot:1
+22 DO ^DIE
+23 LOCK -@(DIE_"DA)")
+24 ; SET NEWLY FILED CPT MODIFIERS INTO LOCAL ARRAY
+25 KILL PXCEAFTR(1)
+26 DO GETS^DIQ(9000010.18,^TMP("PXK",$JOB,PXCECATS,1,"IEN"),"1*","I","PXARR")
+27 SET PXFILE=9000010.181
+28 SET PXSUB=""
+29 FOR
SET PXSUB=$ORDER(PXARR(PXFILE,PXSUB))
IF PXSUB=""
QUIT
Begin DoDot:1
+30 SET PXCEAFTR(1,$PIECE(PXSUB,","))=PXARR(PXFILE,PXSUB,.01,"I")
End DoDot:1
+31 IF $DATA(DTOUT)!$DATA(Y)
SET (PXCEEND,PXCEQUIT)=1
QUIT
+32 QUIT
+33 ;
EQUAN ;+Code to edit Quantity in V CPT file.
+1 IF $PIECE(PXCEAFTR($PIECE(PXCETEXT,"~",1)),"^",$PIECE(PXCETEXT,"~",2))'=""
Begin DoDot:1
+2 NEW DIERR,PXCEDILF,PXCEINT,PXCEEXT
+3 SET PXCEINT=$PIECE(PXCEAFTR($PIECE(PXCETEXT,"~",1)),"^",$PIECE(PXCETEXT,"~",2))
+4 SET PXCEEXT=$$EXTERNAL^DILFD(PXCEFILE,$PIECE(PXCETEXT,"~",3),"",PXCEINT,"PXCEDILF")
+5 SET DIR("B")=$SELECT('$DATA(DIERR):PXCEEXT,1:PXCEINT)
End DoDot:1
+6 IF '$TEST
SET DIR("B")=1
+7 SET DIR(0)=PXCEFILE_","_$PIECE(PXCETEXT,"~",3)_"A"
+8 SET DIR("A")=$PIECE(PXCETEXT,"~",4)
+9 IF $PIECE(PXCETEXT,"~",8)]""
SET DIR("?")=$PIECE(PXCETEXT,"~",8)
+10 DO ^DIR
+11 KILL DIR,DA
+12 IF $DATA(DTOUT)!$DATA(DUOUT)
SET (PXCEEND,PXCEQUIT)=1
QUIT
+13 IF +Y<1
WRITE !,$CHAR(7),"Quanitity is required.",!
GOTO EQUAN
+14 ;PX112
IF +Y>1
IF $DATA(^IBE(357.69,$GET(PXCEIN01)))
WRITE !,"Only one E&M allowed, quantity changed to 1.",!
SET Y=1
+15 IF $PIECE(Y,"^")=""
SET Y=1
+16 SET $PIECE(PXCEAFTR($PIECE(PXCETEXT,"~",1)),"^",$PIECE(PXCETEXT,"~",2))=$PIECE(Y,"^")
+17 QUIT
+18 ;+
+19 ;+********************************
+20 ;+Special Reusable Functionality
DISPLY01(PXCECPT) ;
+1 ;Display text for the .01 field which is a pointer to ^ICPT.
+2 ;Also called with the Evaluation and Management Code from the visit
+3 ; in the parameter.
+4 ;(Must have is called by ASK^PXCEVFI2 and DEL^PXCEVFI2.)
+5 NEW DIC,DR,DA,DIQ,PXCEFNUM,PXCEDIQ1
+6 SET (DIC,PXCEFNUM)=81
+7 SET DR=".01;2"
+8 SET DA=+$PIECE(PXCECPT,"^",1)
+9 SET DIQ="PXCEDIQ1("
+10 SET DIQ(0)="E"
+11 DO EN^DIQ1
+12 QUIT PXCEDIQ1(PXCEFNUM,DA,.01,"E")_" "_PXCEDIQ1(PXCEFNUM,DA,2,"E")
EDMOD(MODS,CPT) ;+Edit the Modifiers for a CPT code entry.
+1 ; Modifier number.
NEW MNUM
SET MNUM=0
+2 NEW MIEN,MTEXT
+3 QUIT
MODNAME(MODIEN) ;+Return #.02 NAME for this CPT MODIFIER (#81.3)
+1 QUIT
MODTEXT(MODIEN) ;+Return string of text describing modifier.
+1 ;+MODIEN = IEN in CPT MODIFIER file (#81.3).
+2 ;+Returns: MODIFIER (#.01) followed by NAME(#.02).
+3 NEW MOD,DESC,TEXT,RVAL
+4 SET RVAL=$$MOD^ICPTMOD(MODIEN,"I")
+5 SET MOD=$PIECE(RVAL,"^",2)
+6 SET DESC=$PIECE(RVAL,"^",3)
+7 SET TEXT=MOD_" "_DESC
+8 QUIT TEXT
CHGCPT() ;Verify CPT code should be modified
+1 ;If response is yes remove modifiers on file for CPT code
+2 NEW DIR,DA,X,Y,PXIEN
+3 WRITE !!,$CHAR(7),"WARNING! THIS WILL ALSO DELETE ANY MODIFIERS ASSOCIATED WITH CPT CODE "_PXCEDIRB
+4 SET DIR(0)="Y"
+5 SET DIR("A")="SURE YOU WANT TO CHANGE THE CPT CODE?"
+6 SET DIR("B")="YES"
+7 DO ^DIR
+8 ;Delete CPT Modifiers from V CPT file for current IEN
+9 IF 'Y
QUIT +Y
+10 SET DA(1)=PXCEFIEN
+11 SET DIK="^AUPNVCPT("_DA(1)_","_1_","
+12 SET PXIEN=""
+13 FOR
SET PXIEN=$ORDER(PXCEAFTR(1,PXIEN))
IF PXIEN=""
QUIT
Begin DoDot:1
+14 SET DA=PXIEN
+15 DO ^DIK
End DoDot:1
+16 QUIT 1
+17 ;
NEWCODE ;
+1 KILL DD,DO
+2 NEW DIC,X,Y
+3 SET DIC="^AUPNVCPT("
+4 SET DIC(0)=""
+5 SET DIC("DR")=".02////^S X=$P(PXCEAFTR(0),""^"",2);"
+6 SET DIC("DR")=DIC("DR")_".03////^S X=$P(PXCEAFTR(0),""^"",3);"
+7 SET X=PXCEIN01
+8 DO FILE^DICN
+9 SET PXCEFIEN=+Y
+10 QUIT
