| [628] | 1 | MCGBL ;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
|
|---|
| 4 | SIGNS 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
|
|---|
| 6 | BLANK S:$E(DJBLO,1)="," DJBLO=$E(DJBLO,2,99)
|
|---|
| 7 | D ^MCARDBL Q
|
|---|
| 8 | ABNO 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
|
|---|
| 10 | STENT Q:'$D(^MCAR(699,MCARGDA,30,D1,2,"B")) S DJBLO="" S:'$D(^("B",MCSTENT)) DJBLO="1,2,3"
|
|---|
| 11 | SPHINC 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
|
|---|
| 12 | HEM 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
|
|---|
| 15 | HEMUB S MCARNP=$P(^MCAR(694,MCARGDA,6),U,3),DJBLO="2,3,4,5,6",DJBLO=$P(DJBLO,",",1,MCARNP) D ^MCARDBL
|
|---|
| 16 | Q
|
|---|
| 17 | HEM1 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
|
|---|
| 20 | RHEUM Q:'$D(MCSEX) S DJBLO=$S(MCSEX="F":"63,64,65",1:"58") D ^MCARDBL Q
|
|---|
| 21 | ;
|
|---|
| 22 | PFTSS1 ; 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 | ;
|
|---|
| 37 | PFTSS2 ; 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
|
|---|
