- 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