Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXCECPT

PXCECPT.m

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