PXCECPT ;ISL/dee,ISA/Zoltan,esw - Used to edit and display V CPT ;12/23/2020
;;1.0;PCE PATIENT CARE ENCOUNTER;**14,27,73,89,112,121,136,124,170,164,182,199,211**;Aug 12, 1996;Build 454
;; ;
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 Following 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(PXCEFIEN,PXCEVIEN)~^D HELP^PXCEHELP~~B
;;0~19~.19~Department Code: ~Department Code: ~~DEPART^PXCECPT1~~~D
;;0~17~.17~Order Reference: ~Order Reference: ~~SKIP^PXCECPT~~~D
;;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~1~1201~Event Date and Time: ~Event Date and Time: ~~~~~D
;;12~2~1202~Ordering Provider: ~Ordering Provider: ~~EPROV12^PXCEPRV~~~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
;;812~2~81202~Package: ~Package: ~~SKIP^PXCECPT~~~D
;;812~3~81203~Data Source: ~Data Source: ~~SKIP^PXCECPT~~~D
;;0~5~.05~Primary Diagnosis: ~Primary Diagnosis: ~$$DISPLY01^PXCEPOV~EPOV^PXCECPT~~~
;;0~9~.09~1st Secondary Diagnosis: ~1st Secondary Diagnosis: ~$$DISPLY01^PXCEPOV~EPOV^PXCECPT~~~
;;0~10~.1~2nd Secondary Diagnosis: ~2nd Secondary Diagnosis: ~$$DISPLY01^PXCEPOV~EPOV^PXCECPT~~~
;;0~11~.11~3rd Secondary Diagnosis: ~3rd Secondary Diagnosis: ~$$DISPLY01^PXCEPOV~EPOV^PXCECPT~~~
;;0~12~.12~4th Secondary Diagnosis: ~4th Secondary Diagnosis: ~$$DISPLY01^PXCEPOV~EPOV^PXCECPT~~~
;;0~13~.13~5th Secondary Diagnosis: ~5th Secondary Diagnosis: ~$$DISPLY01^PXCEPOV~EPOV^PXCECPT~~~
;;0~14~.14~6th Secondary Diagnosis: ~6th Secondary Diagnosis: ~$$DISPLY01^PXCEPOV~EPOV^PXCECPT~~~
;;0~15~.15~7th Secondary Diagnosis: ~7th Secondary Diagnosis: ~$$DISPLY01^PXCEPOV~EPOV^PXCECPT~~~
;;
;
;The interface for AICS to get list on form for help.
INTRFACE ;;DG SELECT CPT PROCEDURE CODES
;+
;********************************
;+********************************
;+Special cases for edit.
;+
;+********************************
;+Special cases for display.
;
DISPMOD(PXCECPT,PXCEDT) ;
;+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,PXCEDT) ;+Display Provider Narrative for procedure in V CPT file.
Q $P(^AUTNPOV(PNAR,0),U,1)
;+
;+********************************
;+Special cases for edit.
;+
ECPTCODE(VCPTIEN,VISITIEN) ;+Code to edit CPT Code in V CPT file.
K DIRUT
N DIC,DA,HELP,PXCPTDT,PXDFLT
S X=""
S HELP="D EVENTDTHELP^PXCECPT"
S Y=$$GETCODE^PXCPTAPI(HELP)
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"
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
;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),"Quantity is required.",! G EQUAN
N PXTMPCPT S PXTMPCPT=$P(PXCEAFTR($P(PXCETEXT,"~")),"^")
I +Y>1,$$GET1^DIQ(357.69,$G(PXCEIN01),.01)>0,$$GET1^DIQ(357.69,$G(PXCEIN01),.06,"I")'="Y" D
.W !,"E&M code, quantity changed to 1."
.S $P(Y,"^")=1
S:$P(Y,"^")="" Y=1
S $P(PXCEAFTR($P(PXCETEXT,"~",1)),"^",$P(PXCETEXT,"~",2))=$P(Y,"^")
Q
EPOV ;Edit the Associated DX
N PXACS,PXACSREC,PXDATE,PXDEF,PXDXASK,PXXX
S PXDATE=$S($D(PXCEVIEN)=1:$$CSDATE^PXDXUTL(PXCEVIEN),$D(PXCEAPDT)=1:PXCEAPDT,1:DT)
S PXACSREC=$$ACTDT^PXDXUTL(PXDATE),PXACS=$P(PXACSREC,"^",3)
I PXACS["-" S PXACS=$P(PXACS,"-",1,2)
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)
I $P(PXACSREC,U,1)'="ICD" D
. S PXDXASK=$P($P(PXCETEXT,"~",4),"Diagnosis:",1)_PXACS_" Diagnosis: "
. S PXDEF=$G(DIR("B")),PXAGAIN=0 D ^PXDSLK I PXXX=-1 S Y=-1 Q
. I PXXX="@" S Y="@" Q
. S Y=$P($$ICDDATA^ICDXCODE("DIAG",$P($P(PXXX,U,1),";",2),PXDATE,"E"),U,1)
I $P(PXACSREC,U,1)="ICD" D
. S DIR(0)=PXCEFILE_","_$P(PXCETEXT,"~",3)_"A"
. S DIR("A")=$P($P(PXCETEXT,"~",4),"Diagnosis:",1)_PXACS_" Diagnosis: "
. S:$P(PXCETEXT,"~",8)]"" DIR("?")=$P(PXCETEXT,"~",8)
. D ^DIR
K DIR,DA
I X="@" S Y="@" S $P(PXCEAFTR($P(PXCETEXT,"~",1)),"^",$P(PXCETEXT,"~",2))=$P(Y,"^") Q
I $D(DTOUT)!$D(DUOUT) S PXCEEND=1,PXCEQUIT=1 Q
;I '+Y S PXCEEND=1 Q ;S:$P(PXCETEXT,"~",3)=".05" PXCEQUIT=1 Q
I +Y'>0 S PXCEEND=1 Q ;PX*1.0*182 for "^" or null entry from list
;See if this diagnosis is in the PXCEAFTR(0)
I $P(PXCETEXT,"~",2)'=5,(+Y=$P($G(PXCEAFTR(0)),"^",5)) S PXCEEND=1
I $P(PXCETEXT,"~",2)'=9,(+Y=$P($G(PXCEAFTR(0)),"^",9)) S PXCEEND=1
I $P(PXCETEXT,"~",2)'=10,(+Y=$P($G(PXCEAFTR(0)),"^",10)) S PXCEEND=1
I $P(PXCETEXT,"~",2)'=11,(+Y=$P($G(PXCEAFTR(0)),"^",11)) S PXCEEND=1
I $P(PXCETEXT,"~",2)'=12,(+Y=$P($G(PXCEAFTR(0)),"^",12)) S PXCEEND=1
I $P(PXCETEXT,"~",2)'=13,(+Y=$P($G(PXCEAFTR(0)),"^",13)) S PXCEEND=1
I $P(PXCETEXT,"~",2)'=14,(+Y=$P($G(PXCEAFTR(0)),"^",14)) S PXCEEND=1
I $P(PXCETEXT,"~",2)'=15,(+Y=$P($G(PXCEAFTR(0)),"^",15)) S PXCEEND=1
I PXCEEND=1 W !,$C(7),"Duplicate Diagnosis on this CPT code is not allowed." D WAIT^PXCEHELP Q
S $P(PXCEAFTR($P(PXCETEXT,"~",1)),"^",$P(PXCETEXT,"~",2))=$P(Y,"^")
D:+Y>0 DIAGNOS^PXCEVFI4(+Y)
Q
;+
;********************************
EVENTDTHELP ;Event Date and Time help.
N ERR,RESULT,TEXT
S RESULT=$$GET1^DID(9000010.18,1201,"","DESCRIPTION","TEXT","ERR")
D BROWSE^DDBR("TEXT(""DESCRIPTION"")","NR","V CPT Event Date and Time Help")
I $D(DDS) D REFRESH^DDSUTL S DY=IOSL-7,DX=0 X IOXY S $Y=DY,$X=DX
Q
;
;+********************************
;+Special Reusable Functionality
DISPLY01(PXCECPT,PXCEDT) ;
;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 CPTSTR
S CPTSTR=$$CPT^ICPTCOD($P(PXCECPT,U,1),PXCEDT)
Q $P(CPTSTR,U,2)_" "_$P(CPTSTR,U,3)
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",$P(^AUPNVSIT(PXCEVIEN,0),U))
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 DIC("DR")=DIC("DR")_"1201////^S X=$P(PXCEAFTR(12),""^"",1);"
S X=PXCEIN01
D FILE^DICN
S PXCEFIEN=+Y
Q
;
SKIP ;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXCECPT 10300 printed Jan 18, 2025@03:28:55 Page 2
PXCECPT ;ISL/dee,ISA/Zoltan,esw - Used to edit and display V CPT ;12/23/2020
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**14,27,73,89,112,121,136,124,170,164,182,199,211**;Aug 12, 1996;Build 454
+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 Following 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(PXCEFIEN,PXCEVIEN)~^D HELP^PXCEHELP~~B
+2 ;;0~19~.19~Department Code: ~Department Code: ~~DEPART^PXCECPT1~~~D
+3 ;;0~17~.17~Order Reference: ~Order Reference: ~~SKIP^PXCECPT~~~D
+4 ;;1~0~1~CPT Modifier: ~CPT Modifier: ~$$DISPMOD^PXCECPT~ECPTMOD^PXCECPT~Select a Modifier that is valid for the CPT code.~~B
+5 ;;0~4~.04~Provider Narrative: ~Provider Narrative: ~$$DNARRAT^PXCECPT~ENARRAT^PXCEPOV1(1,1,1,81,2)~~~B
+6 ;;0~16~.16~Quantity: ~Quantity: ~~EQUAN^PXCECPT~~~D
+7 ;;0~7~.07~Principal Procedure: ~Principal Procedure: ~~~~~D
+8 ;;12~1~1201~Event Date and Time: ~Event Date and Time: ~~~~~D
+9 ;;12~2~1202~Ordering Provider: ~Ordering Provider: ~~EPROV12^PXCEPRV~~~D
+10 ;;12~4~1204~Encounter Provider: ~Encounter Provider: ~~EPROV12^PXCEPRV~~~D
+11 ;;802~1~80201~Provider Narrative Category: ~Provider Narrative Category: ~$$DNARRAT^PXCECPT~ENARRAT^PXCEPOV1(0,2,0,81,3)~~C~D
+12 ;;811~1~81101~Comments: ~Comments: ~~~~~D
+13 ;;812~2~81202~Package: ~Package: ~~SKIP^PXCECPT~~~D
+14 ;;812~3~81203~Data Source: ~Data Source: ~~SKIP^PXCECPT~~~D
+15 ;;0~5~.05~Primary Diagnosis: ~Primary Diagnosis: ~$$DISPLY01^PXCEPOV~EPOV^PXCECPT~~~
+16 ;;0~9~.09~1st Secondary Diagnosis: ~1st Secondary Diagnosis: ~$$DISPLY01^PXCEPOV~EPOV^PXCECPT~~~
+17 ;;0~10~.1~2nd Secondary Diagnosis: ~2nd Secondary Diagnosis: ~$$DISPLY01^PXCEPOV~EPOV^PXCECPT~~~
+18 ;;0~11~.11~3rd Secondary Diagnosis: ~3rd Secondary Diagnosis: ~$$DISPLY01^PXCEPOV~EPOV^PXCECPT~~~
+19 ;;0~12~.12~4th Secondary Diagnosis: ~4th Secondary Diagnosis: ~$$DISPLY01^PXCEPOV~EPOV^PXCECPT~~~
+20 ;;0~13~.13~5th Secondary Diagnosis: ~5th Secondary Diagnosis: ~$$DISPLY01^PXCEPOV~EPOV^PXCECPT~~~
+21 ;;0~14~.14~6th Secondary Diagnosis: ~6th Secondary Diagnosis: ~$$DISPLY01^PXCEPOV~EPOV^PXCECPT~~~
+22 ;;0~15~.15~7th Secondary Diagnosis: ~7th Secondary Diagnosis: ~$$DISPLY01^PXCEPOV~EPOV^PXCECPT~~~
+23 ;;
+24 ;
+25 ;The interface for AICS to get list on form for help.
INTRFACE ;;DG SELECT CPT PROCEDURE CODES
+1 ;+
+2 ;********************************
+3 ;+********************************
+4 ;+Special cases for edit.
+5 ;+
+6 ;+********************************
+7 ;+Special cases for display.
+8 ;
DISPMOD(PXCECPT,PXCEDT) ;
+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
+12 ;
DNARRAT(PNAR,PXCEDT) ;+Display Provider Narrative for procedure in V CPT file.
+1 QUIT $PIECE(^AUTNPOV(PNAR,0),U,1)
+2 ;+
+3 ;+********************************
+4 ;+Special cases for edit.
+5 ;+
ECPTCODE(VCPTIEN,VISITIEN) ;+Code to edit CPT Code in V CPT file.
+1 KILL DIRUT
+2 NEW DIC,DA,HELP,PXCPTDT,PXDFLT
+3 SET X=""
+4 SET HELP="D EVENTDTHELP^PXCECPT"
+5 SET Y=$$GETCODE^PXCPTAPI(HELP)
+6 IF Y="@"
SET X="@"
QUIT
+7 IF Y<0
SET DIRUT=1
QUIT
+8 SET PXCEMOD=$PIECE(Y,"-",2)
+9 SET Y=$PIECE(Y,"-")
SET X=+Y
+10 IF PXCEDIRB=""
QUIT
+11 IF $PIECE(PXCEAFTR($PIECE(PXCETEXT,"~",1)),"^",$PIECE(PXCETEXT,"~",2))=X
QUIT
+12 if $$CHGCPT()
QUIT
+13 GOTO ECPTCODE
+14 ;
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 IF $GET(PXCEMOD)]""
Begin DoDot:1
+12 IF $LENGTH(PXCEMOD,",")=1
SET DR="1//"_PXCEMOD
QUIT
+13 SET PXMOD=""
+14 FOR PXI=1:1
SET PXMOD=$PIECE(PXCEMOD,",",PXI)
if PXMOD=""
QUIT
Begin DoDot:2
+15 KILL PXERR
+16 DO VAL^DIE(9000010.181,DA,.01,"",PXMOD,.PXERR)
+17 if PXERR="^"
QUIT
+18 SET DR="1///^S X=PXMOD"
+19 DO ^DIE
End DoDot:2
+20 SET DR=1
End DoDot:1
+21 DO ^DIE
+22 ;SET NEWLY FILED CPT MODIFIERS INTO LOCAL ARRAY
+23 KILL PXCEAFTR(1)
+24 DO GETS^DIQ(9000010.18,^TMP("PXK",$JOB,PXCECATS,1,"IEN"),"1*","I","PXARR")
+25 SET PXFILE=9000010.181
+26 SET PXSUB=""
+27 FOR
SET PXSUB=$ORDER(PXARR(PXFILE,PXSUB))
if PXSUB=""
QUIT
Begin DoDot:1
+28 SET PXCEAFTR(1,$PIECE(PXSUB,","))=PXARR(PXFILE,PXSUB,.01,"I")
End DoDot:1
+29 IF $DATA(DTOUT)!$DATA(Y)
SET (PXCEEND,PXCEQUIT)=1
QUIT
+30 QUIT
+31 ;
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),"Quantity is required.",!
GOTO EQUAN
+14 NEW PXTMPCPT
SET PXTMPCPT=$PIECE(PXCEAFTR($PIECE(PXCETEXT,"~")),"^")
+15 IF +Y>1
IF $$GET1^DIQ(357.69,$GET(PXCEIN01),.01)>0
IF $$GET1^DIQ(357.69,$GET(PXCEIN01),.06,"I")'="Y"
Begin DoDot:1
+16 WRITE !,"E&M code, quantity changed to 1."
+17 SET $PIECE(Y,"^")=1
End DoDot:1
+18 if $PIECE(Y,"^")=""
SET Y=1
+19 SET $PIECE(PXCEAFTR($PIECE(PXCETEXT,"~",1)),"^",$PIECE(PXCETEXT,"~",2))=$PIECE(Y,"^")
+20 QUIT
EPOV ;Edit the Associated DX
+1 NEW PXACS,PXACSREC,PXDATE,PXDEF,PXDXASK,PXXX
+2 SET PXDATE=$SELECT($DATA(PXCEVIEN)=1:$$CSDATE^PXDXUTL(PXCEVIEN),$DATA(PXCEAPDT)=1:PXCEAPDT,1:DT)
+3 SET PXACSREC=$$ACTDT^PXDXUTL(PXDATE)
SET PXACS=$PIECE(PXACSREC,"^",3)
+4 IF PXACS["-"
SET PXACS=$PIECE(PXACS,"-",1,2)
+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 DIR("B")=$SELECT('$DATA(DIERR):PXCEEXT,1:PXCEINT)
End DoDot:1
+10 IF $PIECE(PXACSREC,U,1)'="ICD"
Begin DoDot:1
+11 SET PXDXASK=$PIECE($PIECE(PXCETEXT,"~",4),"Diagnosis:",1)_PXACS_" Diagnosis: "
+12 SET PXDEF=$GET(DIR("B"))
SET PXAGAIN=0
DO ^PXDSLK
IF PXXX=-1
SET Y=-1
QUIT
+13 IF PXXX="@"
SET Y="@"
QUIT
+14 SET Y=$PIECE($$ICDDATA^ICDXCODE("DIAG",$PIECE($PIECE(PXXX,U,1),";",2),PXDATE,"E"),U,1)
End DoDot:1
+15 IF $PIECE(PXACSREC,U,1)="ICD"
Begin DoDot:1
+16 SET DIR(0)=PXCEFILE_","_$PIECE(PXCETEXT,"~",3)_"A"
+17 SET DIR("A")=$PIECE($PIECE(PXCETEXT,"~",4),"Diagnosis:",1)_PXACS_" Diagnosis: "
+18 if $PIECE(PXCETEXT,"~",8)]""
SET DIR("?")=$PIECE(PXCETEXT,"~",8)
+19 DO ^DIR
End DoDot:1
+20 KILL DIR,DA
+21 IF X="@"
SET Y="@"
SET $PIECE(PXCEAFTR($PIECE(PXCETEXT,"~",1)),"^",$PIECE(PXCETEXT,"~",2))=$PIECE(Y,"^")
QUIT
+22 IF $DATA(DTOUT)!$DATA(DUOUT)
SET PXCEEND=1
SET PXCEQUIT=1
QUIT
+23 ;I '+Y S PXCEEND=1 Q ;S:$P(PXCETEXT,"~",3)=".05" PXCEQUIT=1 Q
+24 ;PX*1.0*182 for "^" or null entry from list
IF +Y'>0
SET PXCEEND=1
QUIT
+25 ;See if this diagnosis is in the PXCEAFTR(0)
+26 IF $PIECE(PXCETEXT,"~",2)'=5
IF (+Y=$PIECE($GET(PXCEAFTR(0)),"^",5))
SET PXCEEND=1
+27 IF $PIECE(PXCETEXT,"~",2)'=9
IF (+Y=$PIECE($GET(PXCEAFTR(0)),"^",9))
SET PXCEEND=1
+28 IF $PIECE(PXCETEXT,"~",2)'=10
IF (+Y=$PIECE($GET(PXCEAFTR(0)),"^",10))
SET PXCEEND=1
+29 IF $PIECE(PXCETEXT,"~",2)'=11
IF (+Y=$PIECE($GET(PXCEAFTR(0)),"^",11))
SET PXCEEND=1
+30 IF $PIECE(PXCETEXT,"~",2)'=12
IF (+Y=$PIECE($GET(PXCEAFTR(0)),"^",12))
SET PXCEEND=1
+31 IF $PIECE(PXCETEXT,"~",2)'=13
IF (+Y=$PIECE($GET(PXCEAFTR(0)),"^",13))
SET PXCEEND=1
+32 IF $PIECE(PXCETEXT,"~",2)'=14
IF (+Y=$PIECE($GET(PXCEAFTR(0)),"^",14))
SET PXCEEND=1
+33 IF $PIECE(PXCETEXT,"~",2)'=15
IF (+Y=$PIECE($GET(PXCEAFTR(0)),"^",15))
SET PXCEEND=1
+34 IF PXCEEND=1
WRITE !,$CHAR(7),"Duplicate Diagnosis on this CPT code is not allowed."
DO WAIT^PXCEHELP
QUIT
+35 SET $PIECE(PXCEAFTR($PIECE(PXCETEXT,"~",1)),"^",$PIECE(PXCETEXT,"~",2))=$PIECE(Y,"^")
+36 if +Y>0
DO DIAGNOS^PXCEVFI4(+Y)
+37 QUIT
+38 ;+
+39 ;********************************
EVENTDTHELP ;Event Date and Time help.
+1 NEW ERR,RESULT,TEXT
+2 SET RESULT=$$GET1^DID(9000010.18,1201,"","DESCRIPTION","TEXT","ERR")
+3 DO BROWSE^DDBR("TEXT(""DESCRIPTION"")","NR","V CPT Event Date and Time Help")
+4 IF $DATA(DDS)
DO REFRESH^DDSUTL
SET DY=IOSL-7
SET DX=0
XECUTE IOXY
SET $Y=DY
SET $X=DX
+5 QUIT
+6 ;
+7 ;+********************************
+8 ;+Special Reusable Functionality
DISPLY01(PXCECPT,PXCEDT) ;
+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 CPTSTR
+6 SET CPTSTR=$$CPT^ICPTCOD($PIECE(PXCECPT,U,1),PXCEDT)
+7 QUIT $PIECE(CPTSTR,U,2)_" "_$PIECE(CPTSTR,U,3)
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",$PIECE(^AUPNVSIT(PXCEVIEN,0),U))
+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 DIC("DR")=DIC("DR")_"1201////^S X=$P(PXCEAFTR(12),""^"",1);"
+8 SET X=PXCEIN01
+9 DO FILE^DICN
+10 SET PXCEFIEN=+Y
+11 QUIT
+12 ;
SKIP ;
+1 QUIT
