ASDCLDOW.m

ASDCLDOW ; IHS/ADC/PDW/ENM - IHS CALLS FOR SDCLDOW ; [ 03/25/1999  11:48 AM ]

 ;;5.0;IHS SCHEDULING;;MAR 25, 1999

 ; -- called by SDCLDOW - Clinic List; Day of the Week

 ;

ASK ;EP; get clinic choices

 K ASDQ

 D ASK2^SDDIV I Y<0 S ASDQ="" Q

 S VAUTNI=1 D CLINIC^VAUTOMA I Y<0 S ASDQ="" Q

 NEW X

 S X=0 F  S X=$O(VAUTC(X)) Q:X=""  D

 . S Y=VAUTC(X),Z=0 F  S Z=$O(^SC("AIHSPC",Y,Z)) Q:Z=""  D

 .. S VAUTC($P(^SC(Z,0),U))=Z ;get indiv under prin clinic

 Q

ASDCLDOW  ; IHS/ADC/PDW/ENM - IHS CALLS FOR SDCLDOW ; [ 03/25/1999  11:48 AM ]

 +1       ;;5.0;IHS SCHEDULING;;MAR 25, 1999

 +2       ; -- called by SDCLDOW - Clinic List; Day of the Week

 +3       ;

ASK       ;EP; get clinic choices

 +1        KILL ASDQ

 +2        DO ASK2^SDDIV

           IF Y<0

               SET ASDQ=""

               QUIT 

 +3        SET VAUTNI=1

           DO CLINIC^VAUTOMA

           IF Y<0

               SET ASDQ=""

               QUIT 

 +4        NEW X

 +5        SET X=0

           FOR 

               SET X=$ORDER(VAUTC(X))

               IF X=""

                   QUIT 

               Begin DoDot:1

 +6                SET Y=VAUTC(X)

                   SET Z=0

                   FOR 

                       SET Z=$ORDER(^SC("AIHSPC",Y,Z))

                       IF Z=""

                           QUIT 

                       Begin DoDot:2

 +7       ;get indiv under prin clinic

                           SET VAUTC($PIECE(^SC(Z,0),U))=Z

                       End DoDot:2

               End DoDot:1

 +8        QUIT