- 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
