50 lines
2.4 KiB
Mathematica
50 lines
2.4 KiB
Mathematica
MCGBL ;WISC/TJK-PROGRAM TO DETERMINE BLANK FIELDS FOR GI ;7/18/96 14:09
|
|
;;2.3;Medicine;;09/13/1996
|
|
N I,J S DJBLO="" I '$D(^MCAR(699,MCARGDA,1)) S DJBLO="4,5,6,7,8,9" G BLANK
|
|
SIGNS I '$D(^MCAR(699,MCARGDA,1,"B",MCSIGN)) S DJBLO="4"
|
|
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
|
|
BLANK S:$E(DJBLO,1)="," DJBLO=$E(DJBLO,2,99)
|
|
D ^MCARDBL Q
|
|
ABNO S DJBLO="" S:'$D(^MCAR(699,MCARGDA,3,"B",MCABNO)) DJBLO="1,2,3"
|
|
S:'$D(^MCAR(699,MCARGDA,3,"B",MCPAIN)) DJBLO=DJBLO_",4" G BLANK
|
|
STENT Q:'$D(^MCAR(699,MCARGDA,30,D1,2,"B")) S DJBLO="" S:'$D(^("B",MCSTENT)) DJBLO="1,2,3"
|
|
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
|
|
HEM S DJBLO="1,2,3,4,5,6,7" I '$D(^MCAR(694,MCARGDA,6)) D ^MCARDBL Q
|
|
S MCARNP=$P(^MCAR(694,MCARGDA,6),U,3) I MCARNP="" D ^MCARDBL Q
|
|
Q:MCARNP=5 S DJBLO="2,3,4,5,6",DJBLO=$P(DJBLO,",",MCARNP+1,5) D ^MCARDBL Q
|
|
HEMUB S MCARNP=$P(^MCAR(694,MCARGDA,6),U,3),DJBLO="2,3,4,5,6",DJBLO=$P(DJBLO,",",1,MCARNP) D ^MCARDBL
|
|
Q
|
|
HEM1 I $D(^MCAR(694,MCARGDA,6)),$P(^(6),U,1)="Y" Q
|
|
S DJBLO="1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20" D ^MCARDBL
|
|
Q
|
|
RHEUM Q:'$D(MCSEX) S DJBLO=$S(MCSEX="F":"63,64,65",1:"58") D ^MCARDBL Q
|
|
;
|
|
PFTSS1 ; Pulmonary Function Tests-Special Studies-Screen 1
|
|
;
|
|
; Set up fields to be blanked out, based on study type.
|
|
; (See field 2 on screen MCPFT060.)
|
|
S DJBLO=""
|
|
I MCPFTSS'="MECHANICS" S DJBLO=DJBLO_"2,3,4,"
|
|
I MCPFTSS'="SMALL AIRWAY" S DJBLO=DJBLO_"5,6,7,8,9,"
|
|
D ^MCARDBL
|
|
;
|
|
; Change the starting field number, if necessary.
|
|
I MCPFTSS="MECHANICS" ; no need to change
|
|
E I MCPFTSS="SMALL AIRWAY" S DJNX=5
|
|
E S DJNX=25.1 ; dummy field at end of screen
|
|
Q
|
|
;
|
|
PFTSS2 ; Pulmonary Function Tests-Special Studies-Screen 2
|
|
;
|
|
; Set up fields to be blanked out, as in PFTSS1.
|
|
S DJBLO=""
|
|
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,"
|
|
I MCPFTSS'="MAXIMUM PRESSURES" S DJBLO=DJBLO_"56,"
|
|
D ^MCARDBL
|
|
;
|
|
; Change the starting field number, if necessary.
|
|
I MCPFTSS="EXERCISE" ; no need to change
|
|
E I MCPFTSS="MAXIMUM PRESSURES" S DJNX=56
|
|
E S DJNX=57 ; notes field applies to all types
|
|
Q
|