MCGBL.m

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

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