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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCGBL 2473 printed Dec 13, 2024@02:15:12 Page 2
MCGBL ;WISC/TJK-PROGRAM TO DETERMINE BLANK FIELDS FOR GI ;7/18/96 14:09
+1 ;;2.3;Medicine;;09/13/1996
+2 NEW I,J
SET DJBLO=""
IF '$DATA(^MCAR(699,MCARGDA,1))
SET DJBLO="4,5,6,7,8,9"
GOTO BLANK
SIGNS IF '$DATA(^MCAR(699,MCARGDA,1,"B",MCSIGN))
SET DJBLO="4"
+1 FOR I="MCSURV","MCDISF","MCTHER","MCFDT","MCPROTO"
SET J=$SELECT(I="MCSURV":5,I="MCDISF":6,I="MCTHER":7,I="MCFDT":8,1:9)
if '$DATA(^MCAR(699,MCARGDA,1,"B",@I))
SET DJBLO=DJBLO_","_J
BLANK if $EXTRACT(DJBLO,1)=","
SET DJBLO=$EXTRACT(DJBLO,2,99)
+1 DO ^MCARDBL
QUIT
ABNO SET DJBLO=""
if '$DATA(^MCAR(699,MCARGDA,3,"B",MCABNO))
SET DJBLO="1,2,3"
+1 if '$DATA(^MCAR(699,MCARGDA,3,"B",MCPAIN))
SET DJBLO=DJBLO_",4"
GOTO BLANK
STENT if '$DATA(^MCAR(699,MCARGDA,30,D1,2,"B"))
QUIT
SET DJBLO=""
if '$DATA(^("B",MCSTENT))
SET DJBLO="1,2,3"
SPHINC if '$DATA(^MCAR(699,MCARGDA,30,D1,2,"B",MCSPHIN))
SET DJBLO=DJBLO_",4,5"
if '$DATA(^(MCBOUGIE))
SET DJBLO=DJBLO_",6"
if '$DATA(^(MCHEATP))
SET DJBLO=DJBLO_",7,8"
if '$DATA(^(MCGTUBE))
SET DJBLO=DJBLO_",9"
if '$DATA(^(MCJTUBE))
SET DJBLO=DJBLO_",10"
GOTO BLANK
HEM SET DJBLO="1,2,3,4,5,6,7"
IF '$DATA(^MCAR(694,MCARGDA,6))
DO ^MCARDBL
QUIT
+1 SET MCARNP=$PIECE(^MCAR(694,MCARGDA,6),U,3)
IF MCARNP=""
DO ^MCARDBL
QUIT
+2 if MCARNP=5
QUIT
SET DJBLO="2,3,4,5,6"
SET DJBLO=$PIECE(DJBLO,",",MCARNP+1,5)
DO ^MCARDBL
QUIT
HEMUB SET MCARNP=$PIECE(^MCAR(694,MCARGDA,6),U,3)
SET DJBLO="2,3,4,5,6"
SET DJBLO=$PIECE(DJBLO,",",1,MCARNP)
DO ^MCARDBL
+1 QUIT
HEM1 IF $DATA(^MCAR(694,MCARGDA,6))
IF $PIECE(^(6),U,1)="Y"
QUIT
+1 SET DJBLO="1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20"
DO ^MCARDBL
+2 QUIT
RHEUM if '$DATA(MCSEX)
QUIT
SET DJBLO=$SELECT(MCSEX="F":"63,64,65",1:"58")
DO ^MCARDBL
QUIT
+1 ;
PFTSS1 ; Pulmonary Function Tests-Special Studies-Screen 1
+1 ;
+2 ; Set up fields to be blanked out, based on study type.
+3 ; (See field 2 on screen MCPFT060.)
+4 SET DJBLO=""
+5 IF MCPFTSS'="MECHANICS"
SET DJBLO=DJBLO_"2,3,4,"
+6 IF MCPFTSS'="SMALL AIRWAY"
SET DJBLO=DJBLO_"5,6,7,8,9,"
+7 DO ^MCARDBL
+8 ;
+9 ; Change the starting field number, if necessary.
+10 ; no need to change
IF MCPFTSS="MECHANICS"
+11 IF '$TEST
IF MCPFTSS="SMALL AIRWAY"
SET DJNX=5
+12 ; dummy field at end of screen
IF '$TEST
SET DJNX=25.1
+13 QUIT
+14 ;
PFTSS2 ; Pulmonary Function Tests-Special Studies-Screen 2
+1 ;
+2 ; Set up fields to be blanked out, as in PFTSS1.
+3 SET DJBLO=""
+4 IF MCPFTSS'="EXERCISE"
SET 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,"
+5 IF MCPFTSS'="MAXIMUM PRESSURES"
SET DJBLO=DJBLO_"56,"
+6 DO ^MCARDBL
+7 ;
+8 ; Change the starting field number, if necessary.
+9 ; no need to change
IF MCPFTSS="EXERCISE"
+10 IF '$TEST
IF MCPFTSS="MAXIMUM PRESSURES"
SET DJNX=56
+11 ; notes field applies to all types
IF '$TEST
SET DJNX=57
+12 QUIT
