- ASDMON ; IHS/ADC/PDW/ENM - MONTH AT A GLANCE ; [ 03/25/1999 11:48 AM ]
- ;;5.0;IHS SCHEDULING;;MAR 25, 1999
- ;
- S:'$D(SDMM) SDMM=0
- EN1 ; ask clinic and set variables for call to SDM0
- W !! D I^SDUTL
- S DIC="^SC(",DIC(0)="AEMZQ",DIC("A")="Select CLINIC: "
- S DIC("S")="I $P(^(0),U,3)=""C""" D ^DIC K DIC G:Y<0!'$D(^("SL")) END
- K SDAPTYP,SDIN,SDRE,SDXXX
- I $D(^SC(+Y,"I")) S SDIN=+^("I"),SDRE=+$P(^("I"),U,2)
- K SDINA I $D(SDIN),SDIN S SDINA=SDIN K SDIN
- I $D(SD),$D(SC),+Y'=+SC K SD
- S SL=^SC(+Y,"SL"),X=$P(SL,U,3),STARTDAY=$S(X:X,1:8),SC=Y
- S SB=STARTDAY-1/100,X=$P(SL,U,6),HSI=$S(X=1:X,X:X,1:4)
- S SI=$S(X="":4,X<3:4,X:X,1:4)
- S STR="#@!$* XXWVUTSRQPONMLKJIHGFEDCBA0123456789jklmnopqrstuvwxyz"
- S SDDIF=$S(HSI<3:8/HSI,1:2) K Y
- D CS^SDM1A S SDW="",WY="Y" ;checks clinic code
- ;
- I $D(^SC("AIHSPC",+SC)) D G ASDMON
- . W !!,*7," This is a Principal Clinic!",!
- . K DIR S DIR(0)="NO^1:2",DIR("B")=2
- . S DIR("A",1)=" 1 Display availability of just this clinic"
- . S DIR("A",2)=" 2 Display first available for clinics under this grouping"
- . S DIR("A")="Select 1 or 2" D ^DIR W !
- . I Y=1 D DEV Q
- . I Y=2 S SDPC=+SC D EN^ASDPC K SDPC
- ;
- DEV ; ask for device then call SDM0, return to EN1
- S %ZIS="N" D ^%ZIS
- S DFN=-1 D ^SDM0,^%ZISC G EN1
- ;
- ;
- END D KVAR^VADPT K SDAPTYP,SDSC,%,%DT,ASKC,COV,DA,DIC,DIE,DP,DR
- K HEY,HSI,HY,J,SB,SC,SDDIF,SDJ,SDLN,SD17,SDMAX,SDU,SDYC,SI,SL
- K SSC,STARTDAY,STR,SDZPR,WY,X,XX,Y,S,SD,SDAP16,SDEDT,SDTY,SM
- K SS,ST,ARG,CCX,CCXN,HX,I,PXR,SDINA,SDW,COLLAT,SDDIS,SDMM,SDMLT1
- K SDAV,SDHX,SDSOH,SDT
- Q
- ASDMON ; IHS/ADC/PDW/ENM - MONTH AT A GLANCE ; [ 03/25/1999 11:48 AM ]
- +1 ;;5.0;IHS SCHEDULING;;MAR 25, 1999
- +2 ;
- +3 IF '$DATA(SDMM)
- SET SDMM=0
- EN1 ; ask clinic and set variables for call to SDM0
- +1 WRITE !!
- DO I^SDUTL
- +2 SET DIC="^SC("
- SET DIC(0)="AEMZQ"
- SET DIC("A")="Select CLINIC: "
- +3 SET DIC("S")="I $P(^(0),U,3)=""C"""
- DO ^DIC
- KILL DIC
- IF Y<0!'$DATA(^("SL"))
- GOTO END
- +4 KILL SDAPTYP,SDIN,SDRE,SDXXX
- +5 IF $DATA(^SC(+Y,"I"))
- SET SDIN=+^("I")
- SET SDRE=+$PIECE(^("I"),U,2)
- +6 KILL SDINA
- IF $DATA(SDIN)
- IF SDIN
- SET SDINA=SDIN
- KILL SDIN
- +7 IF $DATA(SD)
- IF $DATA(SC)
- IF +Y'=+SC
- KILL SD
- +8 SET SL=^SC(+Y,"SL")
- SET X=$PIECE(SL,U,3)
- SET STARTDAY=$SELECT(X:X,1:8)
- SET SC=Y
- +9 SET SB=STARTDAY-1/100
- SET X=$PIECE(SL,U,6)
- SET HSI=$SELECT(X=1:X,X:X,1:4)
- +10 SET SI=$SELECT(X="":4,X<3:4,X:X,1:4)
- +11 SET STR="#@!$* XXWVUTSRQPONMLKJIHGFEDCBA0123456789jklmnopqrstuvwxyz"
- +12 SET SDDIF=$SELECT(HSI<3:8/HSI,1:2)
- KILL Y
- +13 ;checks clinic code
- DO CS^SDM1A
- SET SDW=""
- SET WY="Y"
- +14 ;
- +15 IF $DATA(^SC("AIHSPC",+SC))
- Begin DoDot:1
- +16 WRITE !!,*7," This is a Principal Clinic!",!
- +17 KILL DIR
- SET DIR(0)="NO^1:2"
- SET DIR("B")=2
- +18 SET DIR("A",1)=" 1 Display availability of just this clinic"
- +19 SET DIR("A",2)=" 2 Display first available for clinics under this grouping"
- +20 SET DIR("A")="Select 1 or 2"
- DO ^DIR
- WRITE !
- +21 IF Y=1
- DO DEV
- QUIT
- +22 IF Y=2
- SET SDPC=+SC
- DO EN^ASDPC
- KILL SDPC
- End DoDot:1
- GOTO ASDMON
- +23 ;
- DEV ; ask for device then call SDM0, return to EN1
- +1 SET %ZIS="N"
- DO ^%ZIS
- +2 SET DFN=-1
- DO ^SDM0
- DO ^%ZISC
- GOTO EN1
- +3 ;
- +4 ;
- END DO KVAR^VADPT
- KILL SDAPTYP,SDSC,%,%DT,ASKC,COV,DA,DIC,DIE,DP,DR
- +1 KILL HEY,HSI,HY,J,SB,SC,SDDIF,SDJ,SDLN,SD17,SDMAX,SDU,SDYC,SI,SL
- +2 KILL SSC,STARTDAY,STR,SDZPR,WY,X,XX,Y,S,SD,SDAP16,SDEDT,SDTY,SM
- +3 KILL SS,ST,ARG,CCX,CCXN,HX,I,PXR,SDINA,SDW,COLLAT,SDDIS,SDMM,SDMLT1
- +4 KILL SDAV,SDHX,SDSOH,SDT
- +5 QUIT
