source: WorldVistAEHR/trunk/r/SURGERY-SR/SROCD3.m@ 1259

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

initial load of WorldVistAEHR
File size: 4.9 KB
Line 
1SROCD3 ;BIR/ADM - ASK SC/EI QUESTIONS FOR CODING ;07/24/07
2 ;;3.0; Surgery ;**142,152,159**;24 Jun 93;Build 4
3 ;
4 ; Reference to DIS^DGRPDB supported by DBIA #700
5 ; Reference to Field #.322013 in File #2 supported by DBIA #3475
6 ;
7ASK W ! K DIR S DIR("A")="Do you want to update classification information (Y/N)? ",DIR("B")="NO",DIR(0)="YA" D ^DIR K DIR I 'Y!$D(DTOUT)!$D(DUOUT) Q
8SCEI ; output of SC/EI conditions
9 N SRAO,SRCV,SRDR,SREC,SRELIG,SRHNC,SRIR,SRMST,SRPERC,SRQ,SREEQ,SRSC,SRPRJ,VADM,VAEL,VASV,SRY
10 D DEM^VADPT,ELIG^VADPT,SVC^VADPT
11 S SRELIG=$P(VAEL(1),"^",2),SRSC=$P(VAEL(3),"^"),SRSC=$S(SRSC:"YES",SRSC=0:"NO",1:""),SRPERC=$P(VAEL(3),"^",2)
12 S SRAO=$S(VASV(2):"YES",1:"NO"),SRIR=$S(VASV(3):"YES",1:"NO"),SRCV=$S(VASV(10):"YES",1:"NO"),SRPRJ=$S($G(VASV(11)):"YES",1:"NO")
13 S SRMST=$S($D(SRCL(5)):"YES",1:"NO"),SRHNC=$S($D(SRCL(6)):"YES",1:"NO")
14 S DIC=2,DA=DFN,DR=".322013",DIQ="SRY",DIQ(0)="I" D EN^DIQ1 K DA,DIC,DIQ,DR
15 S SREC=SRY(2,DFN,.322013,"I"),SREC=$S(SREC="Y":"YES",1:"NO")
16 W @IOF,!,VADM(1)_" ("_VA("PID")_") ",$P(VAEL(6),"^",2),!!," * * * Eligibility Information and Service Connected Conditions * * *"
17 W !!,?5,"Primary Eligibility: "_SRELIG,!,?5,"Combat Vet: "_SRCV,?22,"A/O Exp.: "_SRAO,?39,"M/S Trauma: "_SRMST
18 W !,?5,"ION Rad.: "_SRIR,?22,"SWAC: "_SREC,?39,"H/N Cancer: "_SRHNC
19 W !,?5,"PROJ 112/SHAD: "_SRPRJ
20 D DIS^DGRPDB
21 W ! F I=1:1:79 W "-"
22SUP S SRY="operation" I $D(SRTN),$P($G(^SRF(SRTN,"NON")),"^")="Y" S SRY="procedure"
23 K DIR W !!,"Please supply the following required information about this "_SRY_":",! S:$D(SRTN) DA=SRTN S SRDR="" S:'$D(SRQ) SRQ=0 D I SRQ G END
24 .I $D(SRCL(3)) D SC I SRQ Q
25 .I $D(SRCL(7)) D CV I SRQ Q
26 .I $D(SRCL(1)) D AO I SRQ Q
27 .I $D(SRCL(2)) D IR I SRQ Q
28 .I $D(SRCL(4)) D EC I SRQ Q
29 .I $D(SRCL(8)) D PRJ I SRQ Q
30 .I $D(SRCL(5)) D MST I SRQ Q
31 .I $D(SRCL(6)) D HNC
32 K DA,DIE,DR S:$D(SRTN) DA=SRTN,DIE=136,DR=SRDR D ^DIE
33UPDX I $O(^SRO(136,SRTN,4,0)) D
34 .W ! K DIR S DIR("A",1)="Update all 'OTHER POSTOP DIAGNOSIS' Eligibility and Service Connected",DIR("A")="Conditions with these values (Y/N)"
35 .S DIR("B")="NO",DIR(0)="Y" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) Q
36 .I Y D UPDSC
37END K DA,DIE,DR,SRZ,X,Y
38 Q
39SC S DIR("A")="Treatment related to Service Connected condition (Y/N)",DIR(0)="136,.04" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRQ=1 Q
40 I X=""!(X="@") W !,$C(7),?15,"Enter YES or NO." G SC
41 S SRCL(3)=Y,SRDR=$G(SRDR)_".04////"_SRCL(3)_";"
42 S SRCL(3,"UPDATE")=1
43 Q
44CV N SRCVD S SRCVD=$P(^SRO(136,DA,0),"^",10),DIR("B")=$S(SRCVD=0:"NO",1:"YES")
45 S DIR("A")="Treatment related to Combat (Y/N)",DIR(0)="136,.1" 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 CV
47 S SRCL(7)=Y,SRDR=SRDR_".1////"_SRCL(7)_";"
48 S SRCL(7,"UPDATE")=1
49 Q
50AO S DIR("A")="Treatment related to Agent Orange Exposure (Y/N)",DIR(0)="136,.05" 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 AO
52 S SRCL(1)=Y,SRDR=SRDR_".05////"_SRCL(1)_";"
53 S SRCL(1,"UPDATE")=1
54 Q
55IR S DIR("A")="Treatment related to Ionizing Radiation Exposure (Y/N)",DIR(0)="136,.06" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRQ=1 Q
56 I X=""!(X="@") W !,$C(7),?15,"Enter YES or NO." G IR
57 S SRCL(2)=Y,SRDR=SRDR_".06////"_SRCL(2)_";"
58 S SRCL(2,"UPDATE")=1
59 Q
60EC S DIR("A")="Treatment related to SW Asia (Y/N)",DIR(0)="136,.07" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRQ=1 Q
61 I X=""!(X="@") W !,$C(7),?15,"Enter YES or NO." G EC
62 S SRCL(4)=Y,SRDR=SRDR_".07////"_SRCL(4)_";"
63 S SRCL(4,"UPDATE")=1
64 Q
65PRJ S DIR("A")="Treatment related to PROJ 112/SHAD (Y/N)",DIR(0)="136,.11" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRQ=1 Q
66 I X=""!(X="@") W !,$C(7),?15,"Enter YES or NO." G PRJ
67 S SRCL(8)=Y,SRDR=SRDR_".11////"_SRCL(8)_";"
68 S SRCL(8,"UPDATE")=1
69 Q
70MST S DIR("A")="Treatment related to Military Sexual Trauma (Y/N)",DIR(0)="136,.08" 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_".08////"_SRCL(5)_";"
73 S SRCL(5,"UPDATE")=1
74 Q
75HNC S DIR("A")="Treatment related to Head and/or Neck Cancer (Y/N)",DIR(0)="136,.09" D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SRQ=1 Q
76 I X=""!(X="@") W !,$C(7),?15,"Enter YES or NO." G HNC
77 S SRCL(6)=Y,SRDR=SRDR_".09////"_SRCL(6)_";"
78 S SRCL(6,"UPDATE")=1
79 Q
80PRESS W ! K DIR S DIR("A")="Press RETURN to continue ",DIR(0)="FOA" D ^DIR K DIR W @IOF
81 Q
82UPDSC ;Update existing DX to Service Connected/Environmental Indicators associations.
83 K DA,DIE,DR
84 S (DA,I)=0,DA(1)=SRTN,DIE="^SRO(136,"_SRTN_",4,"
85 D:$D(SRCL(1,"UPDATE")) BLDDR(.03,SRCL(1))
86 D:$D(SRCL(2,"UPDATE")) BLDDR(.04,SRCL(2))
87 D:$D(SRCL(3,"UPDATE")) BLDDR(.02,SRCL(3))
88 D:$D(SRCL(4,"UPDATE")) BLDDR(.07,SRCL(4))
89 D:$D(SRCL(5,"UPDATE")) BLDDR(.05,SRCL(5))
90 D:$D(SRCL(6,"UPDATE")) BLDDR(.06,SRCL(6))
91 D:$D(SRCL(7,"UPDATE")) BLDDR(.08,SRCL(7))
92 D:$D(SRCL(8,"UPDATE")) BLDDR(.09,SRCL(8))
93 F I=1:1 S DA=$O(^SRO(136,SRTN,4,DA)) Q:DA="" D ^DIE
94 Q
95BLDDR(DXPIECE,NEWSC) ;Build the DR string for updating DX/Service Indicators associations
96 S:$D(DR) DR=DR_";"
97 S:'$D(DR) DR=""
98 S DR=DR_DXPIECE_"///"_NEWSC
99 K DXPIECE,NEWSC
100 Q
Note: See TracBrowser for help on using the repository browser.