| 1 | PXCEVFI1 ;ISL/dee,esw - Routine to edit a visit or v-file entry ;8/3/04 10:32am
|
|---|
| 2 | ;;1.0;PCE PATIENT CARE ENCOUNTER;**23,73,112,136,143,124,184,185**;Aug 12, 1996;Build 12
|
|---|
| 3 | Q
|
|---|
| 4 | ;
|
|---|
| 5 | EDIT ; -- edit the V-File stored in "AFTER"
|
|---|
| 6 | N DIR,DA,X,Y,C,PXCEINP,PXCEIN01,PXCEEND,PXD
|
|---|
| 7 | N PXCELINE,PXCETEXT,PXCEDIRB,PXCEMOD
|
|---|
| 8 | N PXCEKEY,PXCEIKEY,PXCENKEY,PXMDCNT
|
|---|
| 9 | W !
|
|---|
| 10 | G:PXCECAT="VST"!(PXCECAT="APPM")!(PXCECAT="CSTP") REST
|
|---|
| 11 | ;
|
|---|
| 12 | EDIT01 ;
|
|---|
| 13 | I PXCECAT="CPT"!(PXCECAT="POV")!(PXCECAT="SK")!(PXCECAT="IMM") D SC^PXCEVFI2($P(^AUPNVSIT(PXCEVIEN,0),U,5))
|
|---|
| 14 | S PXCETEXT=$P($T(FORMAT+1^@PXCECODE),";;",2)
|
|---|
| 15 | K DIR,DA,X,Y,C,PXCEDIRB
|
|---|
| 16 | I $P(PXCEAFTR(0),"^",1) D
|
|---|
| 17 | . N DIEER,PXCEDILF,PXCEEXT
|
|---|
| 18 | . S PXCEEXT=$$EXTERNAL^DILFD(PXCEFILE,.01,"",$P(PXCEAFTR(0),"^",1),"PXCEDILF")
|
|---|
| 19 | . S PXCEDIRB=$S('$D(DIERR):PXCEEXT,1:$P(PXCEAFTR(0),"^",1))
|
|---|
| 20 | E S PXCEDIRB=""
|
|---|
| 21 | I $P(PXCETEXT,"~",7)]"" D
|
|---|
| 22 | . D @$P(PXCETEXT,"~",7)
|
|---|
| 23 | E D
|
|---|
| 24 | . I PXCEDIRB'="" S DIR("B")=PXCEDIRB
|
|---|
| 25 | . S DIR(0)=PXCEFILE_",.01OA"
|
|---|
| 26 | . S DIR("A")=$P(PXCETEXT,"~",4)
|
|---|
| 27 | . S:$P(PXCETEXT,"~",8)]"" DIR("?")=$P(PXCETEXT,"~",8)
|
|---|
| 28 | . D ^DIR
|
|---|
| 29 | I X="@" D G ENDEDIT
|
|---|
| 30 | . N DIRUT
|
|---|
| 31 | . I $P(PXCEAFTR(0),"^",1)="" D
|
|---|
| 32 | .. W !,"There is no entry to delete."
|
|---|
| 33 | .. D WAIT^PXCEHELP
|
|---|
| 34 | . E D DEL^PXCEVFI2(PXCECAT)
|
|---|
| 35 | I $D(DIRUT),$P(PXCEAFTR(0),"^",1)="" S PXCELOOP=1
|
|---|
| 36 | I $D(DIRUT) S PXCEQUIT=1 Q
|
|---|
| 37 | S (PXCEINP,PXD)=Y
|
|---|
| 38 | S PXCEIN01=X
|
|---|
| 39 | I $P(Y,"^",2)'=PXCEDIRB,$$DUP(PXCEINP) G EDIT01
|
|---|
| 40 | ;--File new CPT code and retrieve IEN
|
|---|
| 41 | I PXCECAT="CPT" D
|
|---|
| 42 | . S PXMDCNT=$$CODM^ICPTCOD(+Y,"^TMP(""PXMODARR"",$J",PXCESOR,+^TMP("PXK",$J,"VST",1,0,"AFTER"))
|
|---|
| 43 | . K ^TMP("PXMODARR",$J)
|
|---|
| 44 | . I $P(PXCEAFTR(0),"^",1)'=""!(PXMDCNT'>0) Q
|
|---|
| 45 | . N PXCEFIEN
|
|---|
| 46 | . D NEWCODE^PXCECPT
|
|---|
| 47 | . S ^TMP("PXK",$J,PXCECATS,1,"IEN")=PXCEFIEN
|
|---|
| 48 | I PXCECAT="PRV",$P(PXCEAFTR(0),"^",1)>0,PXCEDIRB]"" S $P(PXCEAFTR(0),"^",6)=""
|
|---|
| 49 | S $P(PXCEAFTR(0),"^",1)=$P(PXCEINP,"^")
|
|---|
| 50 | K DIR,DA
|
|---|
| 51 | ;following code added per PX*185
|
|---|
| 52 | I $D(XQORNOD(0)) I $P(XQORNOD(0),U,4)="HF" D
|
|---|
| 53 | .N HFIEN,NODE
|
|---|
| 54 | .S HFIEN=$P(PXCEINP,U),NODE=$G(^AUTTHF(HFIEN,0))
|
|---|
| 55 | .Q:'$D(NODE)
|
|---|
| 56 | .I $P(NODE,U,8)'="Y" W !!,"WARNING: This Health Factor is currently not set to",!?10,"display on a Health Summary report.",!!
|
|---|
| 57 | .K HFIEN,NODE
|
|---|
| 58 | .Q
|
|---|
| 59 | ;
|
|---|
| 60 | ;
|
|---|
| 61 | REST S PXCEEND=0
|
|---|
| 62 | F PXCELINE=2:1 S PXCETEXT=$P($T(FORMAT+PXCELINE^@PXCECODE),";;",2) Q:PXCETEXT']"" D Q:PXCEEND
|
|---|
| 63 | . I $P(PXCETEXT,"~",9)]"",$P(PXCETEXT,"~",3)'=80201 S PXCEKEY="" D Q:PXCEKEY'=1
|
|---|
| 64 | .. S PXCENKEY=$L($P(PXCETEXT,"~",9))
|
|---|
| 65 | .. F PXCEIKEY=1:1:PXCENKEY I PXCEKEYS[$E($P(PXCETEXT,"~",9),PXCEIKEY) S PXCEKEY=1 Q
|
|---|
| 66 | . K DIR,DA,X,Y,C
|
|---|
| 67 | . I $P(PXCETEXT,"~",7)]"" D
|
|---|
| 68 | .. D @$P(PXCETEXT,"~",7)
|
|---|
| 69 | . E D
|
|---|
| 70 | .. I $P(PXCEAFTR($P(PXCETEXT,"~",1)),"^",$P(PXCETEXT,"~",2))'="" D
|
|---|
| 71 | ... N DIERR,PXCEDILF,PXCEINT,PXCEEXT
|
|---|
| 72 | ... S PXCEINT=$P(PXCEAFTR($P(PXCETEXT,"~",1)),"^",$P(PXCETEXT,"~",2))
|
|---|
| 73 | ... S PXCEEXT=$$EXTERNAL^DILFD(PXCEFILE,$P(PXCETEXT,"~",3),"",PXCEINT,"PXCEDILF")
|
|---|
| 74 | ... S DIR("B")=$S('$D(DIERR):PXCEEXT,1:PXCEINT)
|
|---|
| 75 | .. S DIR(0)=PXCEFILE_","_$P(PXCETEXT,"~",3)_"A"
|
|---|
| 76 | .. S DIR("A")=$P(PXCETEXT,"~",4)
|
|---|
| 77 | .. S:$P(PXCETEXT,"~",8)]"" DIR("?")=$P(PXCETEXT,"~",8)
|
|---|
| 78 | .. D ^DIR
|
|---|
| 79 | .. K DIR,DA
|
|---|
| 80 | .. I X="@" S Y="@"
|
|---|
| 81 | .. E I $D(DTOUT)!$D(DUOUT) S PXCEEND=1 S:PXCECAT="SIT"!(PXCECAT="APPM")!(PXCECAT="HIST")!(PXCECAT="CPT") PXCEQUIT=1 Q
|
|---|
| 82 | .. S $P(PXCEAFTR($P(PXCETEXT,"~",1)),"^",$P(PXCETEXT,"~",2))=$P(Y,"^")
|
|---|
| 83 | . I ($P(PXCETEXT,"~",3)=1202!($P(PXCETEXT,"~",3)=1204)) D:+Y>0 PROVIDER^PXCEVFI4(+Y)
|
|---|
| 84 | ;
|
|---|
| 85 | ENDEDIT ;
|
|---|
| 86 | Q
|
|---|
| 87 | ;
|
|---|
| 88 | DUP(PXCEINP) ; -- Check for dup entries.
|
|---|
| 89 | Q:PXCECAT="SIT"!(PXCECAT="APPM")!(PXCECAT="HIST") 0
|
|---|
| 90 | ;
|
|---|
| 91 | N PXCEDUP,PXCEINDX,X,Y
|
|---|
| 92 | S PXCEDUP=0
|
|---|
| 93 | S PXCEINDX=""
|
|---|
| 94 | F S PXCEINDX=$O(@(PXCEAUPN_"(""AD"",PXCEVIEN,PXCEINDX)")) Q:'PXCEINDX!PXCEDUP S:+@(PXCEAUPN_"(PXCEINDX,0)")=+PXCEINP&(PXCEINDX'=PXCEFIEN) PXCEDUP=1
|
|---|
| 95 | I PXCEDUP D
|
|---|
| 96 | . I PXCEDUP
|
|---|
| 97 | . W !,$P(PXCEINP,"^",2)," is already a "_PXCECATT_" for this Encounter."
|
|---|
| 98 | . I PXCECAT="POV" W !!,"Duplicate Diagnosis Not Allowed." Q ;PX/112
|
|---|
| 99 | . I PXCECAT="CPT",$$GET1^DIQ(357.69,$P(PXCEINP,"^",2),.01)>0 D Q
|
|---|
| 100 | . . W !,"No duplicate E&M codes allowed." ;PX/136
|
|---|
| 101 | . I $P($T(FORMAT^@PXCECODE),"~",4) D
|
|---|
| 102 | .. N DIR,DA
|
|---|
| 103 | .. S DIR(0)="Y"
|
|---|
| 104 | .. S DIR("A")="Do you want to add another "_$P(PXCEINP,"^",2)_""
|
|---|
| 105 | .. S DIR("B")="NO"
|
|---|
| 106 | .. D ^DIR
|
|---|
| 107 | .. S PXCEDUP='+Y
|
|---|
| 108 | Q PXCEDUP
|
|---|
| 109 | ;
|
|---|
