source: WorldVistAEHR/trunk/r/SURGERY-SR/SROCD.m@ 1766

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

initial load of WorldVistAEHR

File size: 4.0 KB
Line 
1SROCD ;BIR/ADM - CASE CODING IN SURGERY PROCEDURE/DIAGNOSIS CODES FILE ;07/24/07
2 ;;3.0; Surgery ;**142,152,159**;24 Jun 93;Build 4
3 I '$D(SRSITE) D ^SROVAR I '$D(SRSITE) S XQUIT="" Q
4 I '$G(SRTN) D ^SROPS1 I '$D(SRTN) S XQUIT="" Q
5BEG N S,SR2,SRCMOD,SRDES,SRDX,SREDIT,SRHDR,SRMOD,SRNM,SRPROC,SRS,SRSEL,SRTXT
6 S (SREDIT,SRMOD,SRSOUT,SRS,SR2)=0 I $P($G(^SRF(SRTN,.2)),"^",3) S SRS=1
7 S S(0)=^SRF(SRTN,0),Y=$P(S(0),"^",9),SRDATE=Y D D^DIQ S SRSDATE=Y,DFN=$P(S(0),"^") D DEM^VADPT S SRNM=VADM(1)_" ("_VA("PID")_")"
8 S SRNON=$S($P($G(^SRF(SRTN,"NON")),"^")="Y":1,1:0)
9 I '$D(^SRO(136,SRTN)) D ^SROCD1
10 I $P($G(^SRO(136,SRTN,10)),"^") D SURE I 'SREDIT Q
11EDIT D ^SROCD2 I SRSOUT!SREDIT G END
12 D EDIT
13 Q
14SURE D HDR K DIR
15 S DIR("A",1)="Coding for this case has been completed "_$S($P(^SRF(SRTN,0),"^",15):"and",1:"but not")_" sent to PCE."
16 S DIR("A",2)="",DIR("A")="Are you sure you want to edit this case",DIR(0)="Y",DIR("B")="NO" D ^DIR K DIR
17 I Y S SREDIT=1 M ^TMP("SRED1",$J,SRTN)=^SRO(136,SRTN) Q
18END S SROERR=SRTN D ^SROERR0,^SRSKILL
19 K ADCNT,SRCOMMA,SRDXCNT,SROCNTR,SROCPT2,SROERR,SROFLG,SRTMP,SRICD9,SRDIAGS,SRASDX,SRMSG,SRADX,SRPADX,SRODIR,REC,SRDIRX,SRADIAG,SRDX,SRDX1,SRDX2,SROICD,SUB4
20 W @IOF K ^TMP("SRED1",$J)
21 Q
22HDR W @IOF,!,SRNM_" Case #"_SRTN,!
23 S SRPROC=$P(^SRF(SRTN,"OP"),"^") D BRK W $P(SRSDATE,"@")_" "_SRHDR(1)
24 I $D(SRHDR(2)) W !,?15,SRHDR(2) I $D(SRHDR(3)) W !,?15,SRHDR(3)
25 W ! F I=1:1:80 W "-"
26 Q
27BRK ; break procedure if greater than 65 characters
28 I $L(SRPROC)<66 S SRHDR(1)=SRPROC Q
29 S X=SRPROC,K=1 F D I $L(X)<66 S SRHDR(K)=X Q
30 .F I=0:1:64 S J=65-I,Y=$E(X,J) I Y=" " S SRHDR(K)=$E(X,1,J-1),X=$E(X,J+1,$L(X)) S K=K+1 Q
31 Q
32OSCEI ; update SC/EI info on other diagnosis
33 K DA,DIE,DR,DIR W !!,"Please supply the following required information related to this diagnosis:",!
34 S SRDR="",SRQ=0 S DA=$P(SRSEL(SRDA),U),DA(1)=SRTN D I SRQ Q
35 .I $D(SRCL(3)) D SC I SRQ Q
36 .I $D(SRCL(7)) D CV I SRQ Q
37 .I $D(SRCL(1)) D AO I SRQ Q
38 .I $D(SRCL(2)) D IR I SRQ Q
39 .I $D(SRCL(4)) D EC I SRQ Q
40 .I $D(SRCL(8)) D PRJ I SRQ Q
41 .I $D(SRCL(5)) D MST I SRQ Q
42 .I $D(SRCL(6)) D HNC
43 K DIR S DA=$P(SRSEL(SRDA),U),DA(1)=SRTN,DIE="^SRO(136,SRTN,4,",DR=SRDR D ^DIE K DA,DIE,DR,SRDR
44 Q
45SC S DIR("A")="Treatment related to Service Connected condition (Y/N)",DIR(0)="136.04,.02" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRQ=1 Q
46 I X=""!(X="@") W !,$C(7),?15,"Enter YES or NO." G SC
47 S SRCL(3)=Y,SRDR=$G(SRDR)_".02////"_SRCL(3)_";"
48 Q
49CV N SRCVD S SRCVD=$P($G(^SRO(136,DA(1),4,DA,0)),"^",8),DIR("B")=$S(SRCVD=0:"NO",1:"YES")
50 S DIR("A")="Treatment related to Combat (Y/N)",DIR(0)="136.04,.08" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRQ=1 Q
51 I X=""!(X="@") W !,$C(7),?15,"Enter YES or NO." G CV
52 S SRCL(7)=Y,SRDR=SRDR_".08////"_SRCL(7)_";"
53 Q
54AO S DIR("A")="Treatment related to Agent Orange Exposure (Y/N)",DIR(0)="136.04,.03" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRQ=1 Q
55 I X=""!(X="@") W !,$C(7),?15,"Enter YES or NO." G AO
56 S SRCL(1)=Y,SRDR=SRDR_".03////"_SRCL(1)_";"
57 Q
58IR S DIR("A")="Treatment related to Ionizing Radiation Exposure (Y/N)",DIR(0)="136.04,.04" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRQ=1 Q
59 I X=""!(X="@") W !,$C(7),?15,"Enter YES or NO." G IR
60 S SRCL(2)=Y,SRDR=SRDR_".04////"_SRCL(2)_";"
61 Q
62EC S DIR("A")="Treatment related to SW Asia (Y/N)",DIR(0)="136.04,.07" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRQ=1 Q
63 I X=""!(X="@") W !,$C(7),?15,"Enter YES or NO." G EC
64 S SRCL(4)=Y,SRDR=SRDR_".07////"_SRCL(4)_";"
65 Q
66PRJ S DIR("A")="Treatment related to PROJ 112/SHAD (Y/N)",DIR(0)="136.04,.09" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRQ=1 Q
67 I X=""!(X="@") W !,$C(7),?15,"Enter YES or NO." G PRJ
68 S SRCL(8)=Y,SRDR=SRDR_".09////"_SRCL(8)_";"
69 Q
70MST S DIR("A")="Treatment related to Military Sexual Trauma (Y/N)",DIR(0)="136.04,.05" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRQ=1 Q
71 I X=""!(X="@") W !,$C(7),?15,"Enter YES or NO." G MST
72 S SRCL(5)=Y,SRDR=SRDR_".05////"_SRCL(5)_";"
73 Q
74HNC S DIR("A")="Treatment related to Head and/or Neck Cancer (Y/N)",DIR(0)="136.04,.06" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRQ=1 Q
75 I X=""!(X="@") W !,$C(7),?15,"Enter YES or NO." G HNC
76 S SRCL(6)=Y,SRDR=SRDR_".06////"_SRCL(6)_";"
77 Q
Note: See TracBrowser for help on using the repository browser.