| 1 | PXBPCPT2 ;WASH/BDB - PROMPT PROCEDURE DIAGNOSES ;9/5/05
|
|---|
| 2 | ;;1.0;PCE PATIENT CARE ENCOUNTER;**124,170**;Aug 12, 1996
|
|---|
| 3 | ;
|
|---|
| 4 | Q ;not an entry
|
|---|
| 5 | ;
|
|---|
| 6 | CDX(PXN) ;--Diagnosis for Procedure
|
|---|
| 7 | N TIMED,DIC,X,CPTDX,POS,PXDISV,PXD,PXC,CDX,VAL,PXCEAFTR,PXCEVIEN
|
|---|
| 8 | CPT1 K PXBUT,EDATA
|
|---|
| 9 | S POS=PXN+11,CPTDX=$P($P(REQE,U,POS)," "),PXDISV="PXBCPTDX-"_POS
|
|---|
| 10 | S TIMED="I '$T!(DATA[""^"")",PXD=$P(REQI,U,POS),PXC=$P(REQI,U,3)
|
|---|
| 11 | S DIC("S")="I $P($$ICDDX^ICDCODE(Y,IDATE),""^"",10)"
|
|---|
| 12 | PCPT1 ;SECOND ENTRY POINT
|
|---|
| 13 | W !," What is DIAGNOSIS "_PXN_" for this procedure: "_$S($G(CPTDX):CPTDX_"//",1:""),IOELEOL
|
|---|
| 14 | R DATA:DTIME S:DATA="" DATA=CPTDX S EDATA=DATA
|
|---|
| 15 | P1CPT1 ;--
|
|---|
| 16 | X TIMED I S PXBUT=1,LEAVE=1 G CDXX1
|
|---|
| 17 | I DATA="^D" G CDXX1
|
|---|
| 18 | I DATA="^"!(DATA="^^") S PXBEXIT=0 G CDXX1
|
|---|
| 19 | I DATA="@",'$G(PXD) S DATA="?"
|
|---|
| 20 | I DATA="@" K PXBREQ(PXD) S $P(REQI,U,POS)="@" G CDXX1
|
|---|
| 21 | ;I DATA="",PXN=1 W !,"PRIMARY DIAGNOSIS IS REQUIRED!" G CPT1
|
|---|
| 22 | I DATA="?" D EN1^PXBHLP0("PXB","POV",1,"",1) G CPT1
|
|---|
| 23 | ;I DATA="??" S DOUBLEQQ=1 D EN1^PXBHLP0("PXB","POV",1,"",2) S:$L(DATA,"^")>1 (Y,DATA,EDATA)=$P($P(DATA,"^",2),"--",1) G:Y>1 PFINCPT1 G:Y?1A1.NP PFINCPT1
|
|---|
| 24 | I DATA="??" D EN1^PXBHLP0("PXB","POV",1,"",2) G CPT1
|
|---|
| 25 | I $L(DATA)>200 S (DATA,EDATA)=$E(DATA,1,199)
|
|---|
| 26 | ;---SPACE BAR---
|
|---|
| 27 | I DATA=" ",$D(^DISV(DUZ,PXDISV)) S DATA=^DISV(DUZ,PXDISV) W DATA
|
|---|
| 28 | ;-----
|
|---|
| 29 | ;--Do a DIC lookup on data if a "?" is NOT entered
|
|---|
| 30 | K X,DIC
|
|---|
| 31 | S X=EDATA
|
|---|
| 32 | D CONFIG^LEXSET("ICD",,IDATE)
|
|---|
| 33 | S DIC("A")="Select Diagnosis:"
|
|---|
| 34 | S DIC="^LEX(757.01,",DIC(0)=$S('$L($G(X)):"A",1:"")_"EQM"
|
|---|
| 35 | D ^DIC
|
|---|
| 36 | I X="@" Q
|
|---|
| 37 | I Y=-1 S DATA="^P" G P1CPT1
|
|---|
| 38 | S WHAT=$G(Y(1))
|
|---|
| 39 | S X="`"_+$$CODEN^ICDCODE(WHAT,80)
|
|---|
| 40 | S (DATA,EDATA)=WHAT K Y
|
|---|
| 41 | S DIC=80,DIC(0)="MZ",DIC("S")="I $P($$ICDDX^ICDCODE(Y,IDATE),U,10)" D ^DIC
|
|---|
| 42 | ;
|
|---|
| 43 | PFINCPT1 ;--Finish DIAGNOSIS
|
|---|
| 44 | I $L(Y,U)'>1 S X=Y,DIC=80,DIC(0)="IZM" D ^DIC
|
|---|
| 45 | I +Y<0 D HELP1^PXBUTL1("POV") G CPT1
|
|---|
| 46 | I $$DUP(+Y) W !,$P(Y,U,2)," IS ALREADY A DIAGNOSIS!" G PCPT1
|
|---|
| 47 | S CDX=Y(0),^DISV(DUZ,PXDISV)=DATA,$P(REQI,U,POS)=+Y
|
|---|
| 48 | S $P(REQE,U,POS)=$P(CDX,U,1)_" --"_$P(CDX,U,3)
|
|---|
| 49 | I $D(PXBREQ(+Y,"I")) G CDXX1
|
|---|
| 50 | I 'PXBDXPRI D
|
|---|
| 51 | .D PRI^PXBPPOV1 ;PRI/SEC
|
|---|
| 52 | .I '$D(DIRUT),$P(REQI,U,6)="P" S PXBDXPRI=+Y
|
|---|
| 53 | S PXCEVIEN=PXBVST,PXDX=Y
|
|---|
| 54 | D WIN17^PXBCC(PXBCNT),GET800^PXCEC800 ;CI's
|
|---|
| 55 | I $G(PXCEQUIT) S $P(REQE,U,POS)=""
|
|---|
| 56 | I '$G(PXCEQUIT) S PXBREQ(+PXDX,"I")=PXCEAFTR(800)
|
|---|
| 57 | I '$G(PXCEQUIT) D EN0^PXBSTOR(PXBVST,PATIENT,REQI,.PXMREQ),EN1^PXKMAIN
|
|---|
| 58 | CDXX1 ;--EXIT AND CLEAN UP
|
|---|
| 59 | I '$D(REQE) S REQE=""
|
|---|
| 60 | I $P(REQE,U,POS)="" S $P(REQI,U,POS)=""
|
|---|
| 61 | Q
|
|---|
| 62 | ;
|
|---|
| 63 | DUP(CD) ;DUPLICATE?
|
|---|
| 64 | N ANS,CTR
|
|---|
| 65 | S ANS=0
|
|---|
| 66 | F CTR=12:1:19 I CTR'=POS,$P(REQI,U,CTR)=CD S ANS=1 Q
|
|---|
| 67 | Q ANS
|
|---|
| 68 | ;
|
|---|
