DVBCIUT1.m

DVBCIUT1 ;ALB/GTS-AMIE INSUFFICIENT UTILITY RTN 1 ; 11/14/94  3:00 PM

 ;;2.7;AMIE;**13**;Apr 10, 1995

 ;

 ;** Version Changes

 ;   2.7 - New routine (Enhc 15)

 ;

INREAS ;** Select Insufficient Reasons

 N YSAVE

 S YSAVE=Y

 I YSAVE=-1 DO

 .S DIR(0)="YA"

 .S DIR("?",1)=" "

 .S DIR("?",2)="  Enter 'No' to print only those reasons previously"

 .S DIR("?",3)="   selected, 'Yes' to select all reasons existing"

 .S DIR("?")="   on currently entered exams."

 .S DIR("A",1)=" "

 .S DIR("A",2)=" You have selected to report all insufficient reasons."

 .S DIR("A")=" Is this correct? "

 .D ^DIR

 .I Y'=0,('$D(DUOUT)&('$D(DTOUT))) DO

 ..N DVBAXIFN

 ..F DVBAXIFN=0:0 S DVBAXIFN=$O(^DVB(396.94,DVBAXIFN)) Q:+DVBAXIFN=0  DO

 ...S DVBAARY("REASON",DVBAXIFN)=""

 .S Y=-1

 I +YSAVE>0 S DVBAARY("REASON",+YSAVE)=""

 S Y=YSAVE

 K DTOUT,DUOUT,DIR

 Q

 ;

EXMTPE ;** Select the exams to Report

 N YSAVE

 S YSAVE=Y

 I YSAVE=-1 DO

 .S DIR(0)="YA"

 .S DIR("?",1)=" "

 .S DIR("?",2)="  Enter 'No' to print only those exams previously"

 .S DIR("?")="   selected, 'Yes' to select all exams"

 .S DIR("A",1)=" "

 .S DIR("A",2)=" You have selected to report all AMIE exams."

 .S DIR("A")=" Is this correct? "

 .D ^DIR

 .I Y'=0,('$D(DUOUT)&('$D(DTOUT))) DO

 ..N DVBAXIFN

 ..F DVBAXIFN=0:0 S DVBAXIFN=$O(^DVB(396.6,DVBAXIFN)) Q:+DVBAXIFN=0  DO

 ...S ^TMP($J,"XMTYPE",DVBAXIFN)=""

 ...;removed inactive screen

 .S Y=-1

 I +YSAVE>0 S ^TMP($J,"XMTYPE",+YSAVE)=""

 S Y=YSAVE

 K DTOUT,DUOUT,DIR

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DVBCIUT1   1512     printed  Apr 09, 2024@20:53:20                                                                                                                                                                                                    Page 2

DVBCIUT1  ;ALB/GTS-AMIE INSUFFICIENT UTILITY RTN 1 ; 11/14/94  3:00 PM

 +1       ;;2.7;AMIE;**13**;Apr 10, 1995

 +2       ;

 +3       ;** Version Changes

 +4       ;   2.7 - New routine (Enhc 15)

 +5       ;

INREAS    ;** Select Insufficient Reasons

 +1        NEW YSAVE

 +2        SET YSAVE=Y

 +3        IF YSAVE=-1

               Begin DoDot:1

 +4                SET DIR(0)="YA"

 +5                SET DIR("?",1)=" "

 +6                SET DIR("?",2)="  Enter 'No' to print only those reasons previously"

 +7                SET DIR("?",3)="   selected, 'Yes' to select all reasons existing"

 +8                SET DIR("?")="   on currently entered exams."

 +9                SET DIR("A",1)=" "

 +10               SET DIR("A",2)=" You have selected to report all insufficient reasons."

 +11               SET DIR("A")=" Is this correct? "

 +12               DO ^DIR

 +13               IF Y'=0

                       IF ('$DATA(DUOUT)&('$DATA(DTOUT)))

                           Begin DoDot:2

 +14                           NEW DVBAXIFN

 +15                           FOR DVBAXIFN=0:0

                                   SET DVBAXIFN=$ORDER(^DVB(396.94,DVBAXIFN))

                                   if +DVBAXIFN=0

                                       QUIT 

                                   Begin DoDot:3

 +16                                   SET DVBAARY("REASON",DVBAXIFN)=""

                                   End DoDot:3

                           End DoDot:2

 +17               SET Y=-1

               End DoDot:1

 +18       IF +YSAVE>0

               SET DVBAARY("REASON",+YSAVE)=""

 +19       SET Y=YSAVE

 +20       KILL DTOUT,DUOUT,DIR

 +21       QUIT 

 +22      ;

EXMTPE    ;** Select the exams to Report

 +1        NEW YSAVE

 +2        SET YSAVE=Y

 +3        IF YSAVE=-1

               Begin DoDot:1

 +4                SET DIR(0)="YA"

 +5                SET DIR("?",1)=" "

 +6                SET DIR("?",2)="  Enter 'No' to print only those exams previously"

 +7                SET DIR("?")="   selected, 'Yes' to select all exams"

 +8                SET DIR("A",1)=" "

 +9                SET DIR("A",2)=" You have selected to report all AMIE exams."

 +10               SET DIR("A")=" Is this correct? "

 +11               DO ^DIR

 +12               IF Y'=0

                       IF ('$DATA(DUOUT)&('$DATA(DTOUT)))

                           Begin DoDot:2

 +13                           NEW DVBAXIFN

 +14                           FOR DVBAXIFN=0:0

                                   SET DVBAXIFN=$ORDER(^DVB(396.6,DVBAXIFN))

                                   if +DVBAXIFN=0

                                       QUIT 

                                   Begin DoDot:3

 +15                                   SET ^TMP($JOB,"XMTYPE",DVBAXIFN)=""

 +16      ;removed inactive screen

                                   End DoDot:3

                           End DoDot:2

 +17               SET Y=-1

               End DoDot:1

 +18       IF +YSAVE>0

               SET ^TMP($JOB,"XMTYPE",+YSAVE)=""

 +19       SET Y=YSAVE

 +20       KILL DTOUT,DUOUT,DIR

 +21       QUIT