source: FOIAVistA/trunk/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXBPCPT2.m@ 1119

Last change on this file since 1119 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.4 KB
Line 
1PXBPCPT2 ;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 ;
6CDX(PXN) ;--Diagnosis for Procedure
7 N TIMED,DIC,X,CPTDX,POS,PXDISV,PXD,PXC,CDX,VAL,PXCEAFTR,PXCEVIEN
8CPT1 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)"
12PCPT1 ;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
15P1CPT1 ;--
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 ;
43PFINCPT1 ;--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
58CDXX1 ;--EXIT AND CLEAN UP
59 I '$D(REQE) S REQE=""
60 I $P(REQE,U,POS)="" S $P(REQI,U,POS)=""
61 Q
62 ;
63DUP(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 ;
Note: See TracBrowser for help on using the repository browser.