source: FOIAVistA/trunk/r/MEDICINE-MC/MCGBL.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 2.4 KB
Line 
1MCGBL ;WISC/TJK-PROGRAM TO DETERMINE BLANK FIELDS FOR GI ;7/18/96 14:09
2 ;;2.3;Medicine;;09/13/1996
3 N I,J S DJBLO="" I '$D(^MCAR(699,MCARGDA,1)) S DJBLO="4,5,6,7,8,9" G BLANK
4SIGNS I '$D(^MCAR(699,MCARGDA,1,"B",MCSIGN)) S DJBLO="4"
5 F I="MCSURV","MCDISF","MCTHER","MCFDT","MCPROTO" S J=$S(I="MCSURV":5,I="MCDISF":6,I="MCTHER":7,I="MCFDT":8,1:9) S:'$D(^MCAR(699,MCARGDA,1,"B",@I)) DJBLO=DJBLO_","_J
6BLANK S:$E(DJBLO,1)="," DJBLO=$E(DJBLO,2,99)
7 D ^MCARDBL Q
8ABNO S DJBLO="" S:'$D(^MCAR(699,MCARGDA,3,"B",MCABNO)) DJBLO="1,2,3"
9 S:'$D(^MCAR(699,MCARGDA,3,"B",MCPAIN)) DJBLO=DJBLO_",4" G BLANK
10STENT Q:'$D(^MCAR(699,MCARGDA,30,D1,2,"B")) S DJBLO="" S:'$D(^("B",MCSTENT)) DJBLO="1,2,3"
11SPHINC S:'$D(^MCAR(699,MCARGDA,30,D1,2,"B",MCSPHIN)) DJBLO=DJBLO_",4,5" S:'$D(^(MCBOUGIE)) DJBLO=DJBLO_",6" S:'$D(^(MCHEATP)) DJBLO=DJBLO_",7,8" S:'$D(^(MCGTUBE)) DJBLO=DJBLO_",9" S:'$D(^(MCJTUBE)) DJBLO=DJBLO_",10" G BLANK
12HEM S DJBLO="1,2,3,4,5,6,7" I '$D(^MCAR(694,MCARGDA,6)) D ^MCARDBL Q
13 S MCARNP=$P(^MCAR(694,MCARGDA,6),U,3) I MCARNP="" D ^MCARDBL Q
14 Q:MCARNP=5 S DJBLO="2,3,4,5,6",DJBLO=$P(DJBLO,",",MCARNP+1,5) D ^MCARDBL Q
15HEMUB S MCARNP=$P(^MCAR(694,MCARGDA,6),U,3),DJBLO="2,3,4,5,6",DJBLO=$P(DJBLO,",",1,MCARNP) D ^MCARDBL
16 Q
17HEM1 I $D(^MCAR(694,MCARGDA,6)),$P(^(6),U,1)="Y" Q
18 S DJBLO="1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20" D ^MCARDBL
19 Q
20RHEUM Q:'$D(MCSEX) S DJBLO=$S(MCSEX="F":"63,64,65",1:"58") D ^MCARDBL Q
21 ;
22PFTSS1 ; Pulmonary Function Tests-Special Studies-Screen 1
23 ;
24 ; Set up fields to be blanked out, based on study type.
25 ; (See field 2 on screen MCPFT060.)
26 S DJBLO=""
27 I MCPFTSS'="MECHANICS" S DJBLO=DJBLO_"2,3,4,"
28 I MCPFTSS'="SMALL AIRWAY" S DJBLO=DJBLO_"5,6,7,8,9,"
29 D ^MCARDBL
30 ;
31 ; Change the starting field number, if necessary.
32 I MCPFTSS="MECHANICS" ; no need to change
33 E I MCPFTSS="SMALL AIRWAY" S DJNX=5
34 E S DJNX=25.1 ; dummy field at end of screen
35 Q
36 ;
37PFTSS2 ; Pulmonary Function Tests-Special Studies-Screen 2
38 ;
39 ; Set up fields to be blanked out, as in PFTSS1.
40 S DJBLO=""
41 I MCPFTSS'="EXERCISE" S DJBLO=DJBLO_"31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,"
42 I MCPFTSS'="MAXIMUM PRESSURES" S DJBLO=DJBLO_"56,"
43 D ^MCARDBL
44 ;
45 ; Change the starting field number, if necessary.
46 I MCPFTSS="EXERCISE" ; no need to change
47 E I MCPFTSS="MAXIMUM PRESSURES" S DJNX=56
48 E S DJNX=57 ; notes field applies to all types
49 Q
Note: See TracBrowser for help on using the repository browser.