ASDAIU1.m

ASDAIU1 ; IHS/ADC/PDW/ENM - AIU BY CLINIC ;  [ 03/25/1999  11:48 AM ]

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

 ;

CHOICE ; -- ask if printing for one patient or by clinic

 K DIR S DIR(0)="SAO^P:PATIENT;C:CLINIC",DIR("B")="C"

 S DIR("A")="PRINT by (P)ATIENT or by (C)LINIC: "

 S DIR("?",1)="Answer P - To an address update for one patient"

 S DIR("?",2)="Answer C - To print address updates by clinic"

 S DIR("?")=" "

 D ^DIR K DIR G END:$D(DIRUT) I Y="P" G ^ASDAIU

 ;

 W ! S DIV="" D DIV^SDUTL I $T D ROUT^SDDIV G:Y<0 END

 S (SDIQ,SDX,SDREP,SDSTART)="",SDX="ALL"

 ;

SORT ; -- ask user for sort option

 S ORDER=0

 K DIR S DIR(0)="SAO^C:CLINIC;P:PRINCIPLE CLINIC",DIR("B")="P"

 S DIR("A")="PRINT IN (C)LINIC or (P)RINCIPLE CLINIC ORDER: "

 S DIR("?",1)="Answer C - To see Address Updates printed by clinic"

 S DIR("?",2)="Answer P - To sort them by principle clinic"

 S DIR("?")=" "

 D ^DIR K DIR G END:$D(DIRUT) S ORDER=$S(Y="C":2,1:3)

 ;

 S VAUTD=$S(DIV="":1,1:DIV)

 I ORDER=2 S VAUTNI=1 D CLINIC^VAUTOMA G:Y<0 END

 D:'$D(DT) DT^SDUTL

 S %DT="AEXF",%DT("A")="PRINT ADDRESS/INSURANCE UPDATES FOR WHAT DATE: "

 D ^%DT K %DT("A") G:Y<1 END S SDATE=Y

 ;

A5 ;

 S (SDZHS,SDZMP,SDZEF)=1

 S VAR="VAUTD#^VAUTC#^DIV^SDX^ORDER^SDATE^SDIQ^SDREP^SDSTART^SDZHS^SDZMP^SDZEF"

 S DGPGM="START^ASDHS"

 S ADGDEV=$$VAL^XBDIQ1(40.8,$$DIV^ASDUT,9999999.06)

 I ADGDEV="" K ADGDEV

 D ZIS^DGUTQ G:POP END^SDROUT1

 G START^ASDHS:'$D(IO("Q"))

 ;

END ; -- eoj

 K ALL,DIV,ORD,ORDER,RMSEL,SDIQ,SDREP,SDSP,SDSTART

 K SDX,X,Y,C,V,I,SDEF,%I Q

ASDAIU1   ; IHS/ADC/PDW/ENM - AIU BY CLINIC ;  [ 03/25/1999  11:48 AM ]

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

 +2       ;

CHOICE    ; -- ask if printing for one patient or by clinic

 +1        KILL DIR

           SET DIR(0)="SAO^P:PATIENT;C:CLINIC"

           SET DIR("B")="C"

 +2        SET DIR("A")="PRINT by (P)ATIENT or by (C)LINIC: "

 +3        SET DIR("?",1)="Answer P - To an address update for one patient"

 +4        SET DIR("?",2)="Answer C - To print address updates by clinic"

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

 +6        DO ^DIR

           KILL DIR

           IF $DATA(DIRUT)

               GOTO END

           IF Y="P"

               GOTO ^ASDAIU

 +7       ;

 +8        WRITE !

           SET DIV=""

           DO DIV^SDUTL

           IF $TEST

               DO ROUT^SDDIV

               IF Y<0

                   GOTO END

 +9        SET (SDIQ,SDX,SDREP,SDSTART)=""

           SET SDX="ALL"

 +10      ;

SORT      ; -- ask user for sort option

 +1        SET ORDER=0

 +2        KILL DIR

           SET DIR(0)="SAO^C:CLINIC;P:PRINCIPLE CLINIC"

           SET DIR("B")="P"

 +3        SET DIR("A")="PRINT IN (C)LINIC or (P)RINCIPLE CLINIC ORDER: "

 +4        SET DIR("?",1)="Answer C - To see Address Updates printed by clinic"

 +5        SET DIR("?",2)="Answer P - To sort them by principle clinic"

 +6        SET DIR("?")=" "

 +7        DO ^DIR

           KILL DIR

           IF $DATA(DIRUT)

               GOTO END

           SET ORDER=$SELECT(Y="C":2,1:3)

 +8       ;

 +9        SET VAUTD=$SELECT(DIV="":1,1:DIV)

 +10       IF ORDER=2

               SET VAUTNI=1

               DO CLINIC^VAUTOMA

               IF Y<0

                   GOTO END

 +11       IF '$DATA(DT)

               DO DT^SDUTL

 +12       SET %DT="AEXF"

           SET %DT("A")="PRINT ADDRESS/INSURANCE UPDATES FOR WHAT DATE: "

 +13       DO ^%DT

           KILL %DT("A")

           IF Y<1

               GOTO END

           SET SDATE=Y

 +14      ;

A5        ;

 +1        SET (SDZHS,SDZMP,SDZEF)=1

 +2        SET VAR="VAUTD#^VAUTC#^DIV^SDX^ORDER^SDATE^SDIQ^SDREP^SDSTART^SDZHS^SDZMP^SDZEF"

 +3        SET DGPGM="START^ASDHS"

 +4        SET ADGDEV=$$VAL^XBDIQ1(40.8,$$DIV^ASDUT,9999999.06)

 +5        IF ADGDEV=""

               KILL ADGDEV

 +6        DO ZIS^DGUTQ

           IF POP

               GOTO END^SDROUT1

 +7        IF '$DATA(IO("Q"))

               GOTO START^ASDHS

 +8       ;

END       ; -- eoj

 +1        KILL ALL,DIV,ORD,ORDER,RMSEL,SDIQ,SDREP,SDSP,SDSTART

 +2        KILL SDX,X,Y,C,V,I,SDEF,%I

           QUIT