ECTQSCR.m

ECTQSCR ;B'ham ISC/PTD-List QA Screens ;01/29/91 08:00

V ;;1.05;INTERIM MANAGEMENT SUPPORT;;

 I '$D(^QA(741.1)) W *7,!!?29,"OPTION IS UNAVAILABLE!",!,"The 'QA Occurrence Screen Criteria' File - #741.1 is not loaded on your system.",!! S XQUIT="" Q

DIP S L=0,DIC="^QA(741.1,",BY=".01",FLDS=".01;S;L15;""SCREEN NUMBER"",1;""DESCRIPTION OF SCREEN""",(FR,TO)="",DHD="QA OCCURRENCE SCREENS"

 D EN1^DIP

EXIT K BY,DIC,DHD,FLDS,FR,L,P,TO,X

 Q

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---ECTQSCR   446     printed  Apr 09, 2024@21:04:40                                                                                                                                                                                                      Page 2

ECTQSCR   ;B'ham ISC/PTD-List QA Screens ;01/29/91 08:00

V         ;;1.05;INTERIM MANAGEMENT SUPPORT;;

 +1        IF '$DATA(^QA(741.1))

               WRITE *7,!!?29,"OPTION IS UNAVAILABLE!",!,"The 'QA Occurrence Screen Criteria' File - #741.1 is not loaded on your system.",!!

               SET XQUIT=""

               QUIT 

DIP        SET L=0

           SET DIC="^QA(741.1,"

           SET BY=".01"

           SET FLDS=".01;S;L15;""SCREEN NUMBER"",1;""DESCRIPTION OF SCREEN"""

           SET (FR,TO)=""

           SET DHD="QA OCCURRENCE SCREENS"

 +1        DO EN1^DIP

EXIT       KILL BY,DIC,DHD,FLDS,FR,L,P,TO,X

 +1        QUIT 

 +2       ;