- SDM ;SF/GFT,ALB/BOK - MAKE AN APPOINTMENT ; 22 Jul 2016 4:33 PM
- ;;5.3;Scheduling;**15,32,38,41,44,79,94,167,168,218,223,250,254,296,380,478,441,619**;Aug 13, 1993;Build 35
- ; If defined...
- ; appt mgt vars: SDFN := DFN of patient....will not be asked
- ; SDCLN := ifn of clinic.....will not be asked
- ; SDAMERR := returned if error occurs
- ;
- ; Reference to LANGDEL^DGRPE supported by DBIA #6405
- ; Reference to ^DPT(DFN,.207) supported by DBIA #6406
- ;
- S:'$D(SDMM) SDMM=0
- EN1 L W !! D I^SDUTL I '$D(SDCLN) S DIC="^SC(",DIC(0)="AEMZQ",DIC("A")="Select CLINIC: ",DIC("S")="I $P(^(0),U,3)=""C"",'$G(^(""OOS""))" D ^DIC K DIC G:Y<0!'$D(^("SL")) END
- N SDRES S:$D(SDCLN) Y=+SDCLN S SDRES=$$CLNCK^SDUTL2(+Y,1)
- I 'SDRES W !,?5,"Clinic MUST be corrected before continuing." G END:$D(SDCLN),SDM
- K SDAPTYP,SDIN,SDRE,SDXXX S:$D(SDCLN) Y=+SDCLN
- S TMPYCLNC=Y,STPCOD=$P($G(^SC(+TMPYCLNC,0)),U,7) ;SD/478
- 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=$G(^SC(+Y,"SL")),X=$P(SL,U,3),STARTDAY=$S($L(X):X,1:8),SC=Y,SB=STARTDAY-1/100,X=$P(SL,U,6),HSI=$S(X=1:X,X:X,1:4),SI=$S(X="":4,X<3:4,X:X,1:4),STR="#@!$* XXWVUTSRQPONMLKJIHGFEDCBA0123456789jklmnopqrstuvwxyz",SDDIF=$S(HSI<3:8/HSI,1:2) K Y
- I $D(^SC(+SC,"SDPROT")),$P(^("SDPROT"),U)="Y",'$D(^SC(+SC,"SDPRIV",DUZ)) W !,*7,"Access to ",$$CNAM(+SC)," is prohibited!",!,"Only users with a special code may access this clinic.",*7 S:$D(SDCLN) SDAMERR="" G END:$D(SDCLN),SDM
- D CS^SDM1A S SDW="",WY="Y"
- I '$D(ORACTION),'$D(SDFN) S (DIC,DIE)="^DPT(",DIC(0)="AQZME" D ^DIC S DFN=+Y G:Y<0 END:$D(SDCLN),^SDM0:X[U,SDM
- S:$D(SDFN) DFN=SDFN
- I $D(^DPT(DFN,.35)),$P(^(.35),U)]"" W !?10,*7,"PATIENT HAS DIED." S:$D(SDFN) SDAMERR="" G END:$D(SDFN),SDM
- D ^SDM4 I $S('$D(COLLAT):1,COLLAT=7:1,1:0) G:$D(SDCLN) END G SDM
- ;-- get sub-category for appointment type
- S SDXSCAT=$$SUB^DGSAUTL(SDAPTYP,2,"")
- K SDXXX D EN G END:$D(SDCLN),SDM
- EN K SDMLT1 W:$P(VAEL(9),U,2)]"" !!,?15,"MEANS TEST STATUS: ",$P(VAEL(9),U,2),!
- ; *** sck, mt blocking removed
- ;S X="EASMTCHK" X ^%ZOSF("TEST") I $T,$$MT^EASMTCHK(DFN,+$G(SDAPTYP),"M") S SDAMERR="" Q
- S Y=DFN,Y(0)=^DPT(DFN,0) I VADM(7)]"" W !?3,*7,VADM(7)
- I $D(^DGS(41.1,"B",DFN)) F I=0:0 S I=$O(^DGS(41.1,"B",DFN,I)) Q:I'>0 I $P(^DGS(41.1,I,0),U,2)'<DT&('$P(^DGS(41.1,I,0),U,13)) W !,"SCHEDULED FOR ADMISSION ON " S Y=$P(^(0),U,2) D DT^SDM0
- PEND S %="" W:$O(^DPT(DFN,"S",DT))'>DT !,"NO PENDING APPOINTMENTS"
- I $O(^DPT(DFN,"S",DT))>DT D G END:%<0,HELP:'%
- .S %=1 W !,"DISPLAY PENDING APPOINTMENTS:"
- .D YN^DICN
- .I %Y["^" S SDMLT1=1
- D:%=1
- .N DX,DY,SDXY,SDEND S SDXY="S DX=$X,DY=0"_$S($L($G(^%ZOSF("XY"))):" "_^("XY"),1:"") X SDXY
- .S CN=1
- .F Y=DT:0 S Y=$O(^DPT(DFN,"S",Y)) Q:Y'>0 I "I"[$P(^(Y,0),U,2) X:(($Y+4)>IOSL) "D OUT^SDUTL X SDXY" Q:$G(SDEND) D CHKSO W:$X>9 ! W CN,".",?4 D DT^SDM0 W ?23 S DA=+SSC W SDLN,$S($D(^SC(DA,0)):$P(^(0),U),1:"DELETED CLINIC "),COV," ",SDAT16 D
- ..S CNIEN=0 F S CNIEN=$O(^SC(+SSC,"S",HY,1,CNIEN)) Q:'+CNIEN S CNPAT=$P($G(^SC(+SSC,"S",HY,1,CNIEN,0)),U) I CNPAT=DFN W:+$G(^SC(+SSC,"S",HY,1,CNIEN,"CONS")) " Consult Appt." S CN=CN+1 Q ;SD/478
- ;Prompt for ETHNICITY if no value on file
- I '$O(^DPT(DFN,.06,0)) D
- .S DA=DFN,DR="6ETHNICITY",DIE="^DPT("
- .S DR(2,2.06)=".01ETHNICITY"
- .D ^DIE K DR
- ;Prompt for RACE if no value on file
- I '$O(^DPT(DFN,.02,0)) D
- .S DA=DFN,DR="2RACE",DIE="^DPT("
- .S DR(2,2.02)=".01RACE"
- .D ^DIE K DR
- ;Prompt for Language if no value on file ;*///*
- I '$O(^DPT(DFN,.207,0)) D
- .S DA=DFN,DIE="^DPT(",DR="7LANGUAGE DATE/TIME;",DR(2,2.07)=".02//ENGLISH"
- .D ^DIE K DR
- .D LANGDEL^DGRPE ; check if no language entered
- I $S('$D(^DPT(DFN,.11)):1,$P(^(.11),U)="":1,1:0) N FLG S FLG(1)=1 D EN^DGREGAED(DFN,.FLG)
- Q:$D(SDXXX)
- E S Y=$P(SL,U,5)
- S SDW="" I $D(^DPT(DFN,.1)) S SDW=^(.1) W !,"NOTE - PATIENT IS NOW IN WARD "_SDW
- Q:$D(SDXXX)
- EN2 F X=0:0 S X=$O(^DPT(DFN,"DE",X)) Q:'$D(^(+X,0)) I ^(0)-SC=0!'(^(0)-Y) F XX=0:0 S XX=$O(^DPT(DFN,"DE",X,1,XX)) Q:XX<1 S SDDIS=$P(^(XX,0),U,3) I 'SDDIS D:'$D(SDMULT) A^SDCNSLT G ^SDM0
- I '$D(^SC(+Y,0)) S Y=+SC
- S Y=$P(^SC(Y,0),U)
- ; SCRESTA = Array of pt's teams causing restricted consults
- N SCRESTA
- S SCREST=$$RESTPT^SCAPMCU4(DFN,DT,"SCRESTA")
- IF SCREST D
- .N SCTM
- . S SCCLNM=Y
- . W !,?5,"Patient has restricted consults due to team assignment(s):"
- .S SCTM=0
- .F S SCTM=$O(SCRESTA(SCTM)) Q:'SCTM W !,?10,SCRESTA(SCTM)
- IF SCREST&'$G(SCOKCONS) D Q
- .W !,?5,"This patient may only be given appointments and enrolled in clinics via"
- .W !,?15,"Make Consult Appointment Option, and"
- .W !,?15,"Edit Clinic Enrollment Data option"
- D:$G(SCREST) MAIL^SCMCCON(DFN,.SCCLNM,2,DT,"SCRESTA")
- K DR,SCREST,SCCLNM
- D:'$D(SDMULT) ^SDCNSLT ;SD/478
- G ^SDM0
- ;
- CHKSO S COV=$S($P(^DPT(DFN,"S",Y,0),U,11)=1:" (COLLATERAL)",1:""),HY=Y,SSC=^(0),SDAT16=$S($D(^SD(409.1,+$P(SSC,U,16),0)):$P(^(0),U),1:"")
- F SDJ=3,4,5 I $P(^DPT(DFN,"S",HY,0),U,SDJ)]"" S Y=$P(^(0),U,SDJ) W:$X>9 ! W ?10,"*" D DT^SDM0 W ?32,$S(SDJ=3:"LAB",SDJ=4:"XRAY",1:"EKG")
- S SDLN="" F J=0:0 S J=$O(^SC(+SSC,"S",HY,1,J)) Q:'J I $D(^(J,0)),+^(0)=DFN S SDLN="("_$P(^(0),U,2)_" MIN) " Q
- S Y=HY Q
- ;
- END D KVAR^VADPT K SDAPTYP,SDSC,%,%DT,ASKC,COV,DA,DIC,DIE,DP,DR,HEY,HSI,HY,J,SB,SC,SDDIF,SDJ,SDLN,SD17,SDMAX,SDU,SDYC,SI,SL,SSC,STARTDAY,STR
- K WY,X,XX,Y,S,SD,SDAP16,SDEDT,SDTY,SM,SS,ST,ARG,CCX,CCXN,HX,I,PXR,SDINA,SDW,COLLAT,SDDIS I $D(SDMM) K:'SDMM SDMM
- K A,CC,CLNIEN,CN,CNIEN,CNPAT,CNSLTLNK,CNSULT,CNT,CONS,CPRSTAT,CW,DSH,DTENTR,DTIN,DTLMT,DTR,ND,P8,PROC,PT,PTIEN,PTNM,RTMP,NOSHOW,SCPTTM,SD1,SDAMSCN,SDATE,SDDOT,SDII,SDINC,SDINCM,SDLEN,SDNS,SDSI,SDST,SDSTR,SDSTRTDT
- K SDXSCAT,SENDER,SERVICE,SRV,STATUS,STPCOD,TMP,TMPYCLNC,TYPE
- I '$D(SDMLT) K SDMLT1
- Q
- ;
- OERR S XQORQUIT=1 Q:'$D(ORVP) S DFN=+ORVP G SDM
- ;
- HELP W !,"YES - TO DISPLAY FUTURE APPOINTMENTS",!,"NO - FUTURE APPOINTMENTS NOT DISPLAYED" G PEND
- ;
- CNAM(SDCL) ;Return clinic name
- ;Input: SDCL=clinic ien
- N SDX
- S SDX=$P($G(^SC(+SDCL,0)),U)
- Q $S($L(SDX):SDX,1:"this clinic")
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDM 6139 printed Feb 19, 2025@00:24:46 Page 2
- SDM ;SF/GFT,ALB/BOK - MAKE AN APPOINTMENT ; 22 Jul 2016 4:33 PM
- +1 ;;5.3;Scheduling;**15,32,38,41,44,79,94,167,168,218,223,250,254,296,380,478,441,619**;Aug 13, 1993;Build 35
- +2 ; If defined...
- +3 ; appt mgt vars: SDFN := DFN of patient....will not be asked
- +4 ; SDCLN := ifn of clinic.....will not be asked
- +5 ; SDAMERR := returned if error occurs
- +6 ;
- +7 ; Reference to LANGDEL^DGRPE supported by DBIA #6405
- +8 ; Reference to ^DPT(DFN,.207) supported by DBIA #6406
- +9 ;
- +10 if '$DATA(SDMM)
- SET SDMM=0
- EN1 LOCK
- WRITE !!
- DO I^SDUTL
- IF '$DATA(SDCLN)
- SET DIC="^SC("
- SET DIC(0)="AEMZQ"
- SET DIC("A")="Select CLINIC: "
- SET DIC("S")="I $P(^(0),U,3)=""C"",'$G(^(""OOS""))"
- DO ^DIC
- KILL DIC
- if Y<0!'$DATA(^("SL"))
- GOTO END
- +1 NEW SDRES
- if $DATA(SDCLN)
- SET Y=+SDCLN
- SET SDRES=$$CLNCK^SDUTL2(+Y,1)
- +2 IF 'SDRES
- WRITE !,?5,"Clinic MUST be corrected before continuing."
- if $DATA(SDCLN)
- GOTO END
- GOTO SDM
- +3 KILL SDAPTYP,SDIN,SDRE,SDXXX
- if $DATA(SDCLN)
- SET Y=+SDCLN
- +4 ;SD/478
- SET TMPYCLNC=Y
- SET STPCOD=$PIECE($GET(^SC(+TMPYCLNC,0)),U,7)
- +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=$GET(^SC(+Y,"SL"))
- SET X=$PIECE(SL,U,3)
- SET STARTDAY=$SELECT($LENGTH(X):X,1:8)
- SET SC=Y
- SET SB=STARTDAY-1/100
- SET X=$PIECE(SL,U,6)
- SET HSI=$SELECT(X=1:X,X:X,1:4)
- SET SI=$SELECT(X="":4,X<3:4,X:X,1:4)
- SET STR="#@!$* XXWVUTSRQPONMLKJIHGFEDCBA0123456789jklmnopqrstuvwxyz"
- SET SDDIF=$SELECT(HSI<3:8/HSI,1:2)
- KILL Y
- +9 IF $DATA(^SC(+SC,"SDPROT"))
- IF $PIECE(^("SDPROT"),U)="Y"
- IF '$DATA(^SC(+SC,"SDPRIV",DUZ))
- WRITE !,*7,"Access to ",$$CNAM(+SC)," is prohibited!",!,"Only users with a special code may access this clinic.",*7
- if $DATA(SDCLN)
- SET SDAMERR=""
- if $DATA(SDCLN)
- GOTO END
- GOTO SDM
- +10 DO CS^SDM1A
- SET SDW=""
- SET WY="Y"
- +11 IF '$DATA(ORACTION)
- IF '$DATA(SDFN)
- SET (DIC,DIE)="^DPT("
- SET DIC(0)="AQZME"
- DO ^DIC
- SET DFN=+Y
- if Y<0
- if $DATA(SDCLN)
- GOTO END
- if X[U
- GOTO ^SDM0
- GOTO SDM
- +12 if $DATA(SDFN)
- SET DFN=SDFN
- +13 IF $DATA(^DPT(DFN,.35))
- IF $PIECE(^(.35),U)]""
- WRITE !?10,*7,"PATIENT HAS DIED."
- if $DATA(SDFN)
- SET SDAMERR=""
- if $DATA(SDFN)
- GOTO END
- GOTO SDM
- +14 DO ^SDM4
- IF $SELECT('$DATA(COLLAT):1,COLLAT=7:1,1:0)
- if $DATA(SDCLN)
- GOTO END
- GOTO SDM
- +15 ;-- get sub-category for appointment type
- +16 SET SDXSCAT=$$SUB^DGSAUTL(SDAPTYP,2,"")
- +17 KILL SDXXX
- DO EN
- if $DATA(SDCLN)
- GOTO END
- GOTO SDM
- EN KILL SDMLT1
- if $PIECE(VAEL(9),U,2)]""
- WRITE !!,?15,"MEANS TEST STATUS: ",$PIECE(VAEL(9),U,2),!
- +1 ; *** sck, mt blocking removed
- +2 ;S X="EASMTCHK" X ^%ZOSF("TEST") I $T,$$MT^EASMTCHK(DFN,+$G(SDAPTYP),"M") S SDAMERR="" Q
- +3 SET Y=DFN
- SET Y(0)=^DPT(DFN,0)
- IF VADM(7)]""
- WRITE !?3,*7,VADM(7)
- +4 IF $DATA(^DGS(41.1,"B",DFN))
- FOR I=0:0
- SET I=$ORDER(^DGS(41.1,"B",DFN,I))
- if I'>0
- QUIT
- IF $PIECE(^DGS(41.1,I,0),U,2)'<DT&('$PIECE(^DGS(41.1,I,0),U,13))
- WRITE !,"SCHEDULED FOR ADMISSION ON "
- SET Y=$PIECE(^(0),U,2)
- DO DT^SDM0
- PEND SET %=""
- if $ORDER(^DPT(DFN,"S",DT))'>DT
- WRITE !,"NO PENDING APPOINTMENTS"
- +1 IF $ORDER(^DPT(DFN,"S",DT))>DT
- Begin DoDot:1
- +2 SET %=1
- WRITE !,"DISPLAY PENDING APPOINTMENTS:"
- +3 DO YN^DICN
- +4 IF %Y["^"
- SET SDMLT1=1
- End DoDot:1
- if %<0
- GOTO END
- if '%
- GOTO HELP
- +5 if %=1
- Begin DoDot:1
- +6 NEW DX,DY,SDXY,SDEND
- SET SDXY="S DX=$X,DY=0"_$SELECT($LENGTH($GET(^%ZOSF("XY"))):" "_^("XY"),1:"")
- XECUTE SDXY
- +7 SET CN=1
- +8 FOR Y=DT:0
- SET Y=$ORDER(^DPT(DFN,"S",Y))
- if Y'>0
- QUIT
- IF "I"[$PIECE(^(Y,0),U,2)
- if (($Y+4)>IOSL)
- XECUTE "D OUT^SDUTL X SDXY"
- if $GET(SDEND)
- QUIT
- DO CHKSO
- if $X>9
- WRITE !
- WRITE CN,".",?4
- DO DT^SDM0
- WRITE ?23
- SET DA=+SSC
- WRITE SDLN,$SELECT($DATA(^SC(DA,0)):$PIECE(^(0),U),1:"DELETED CLINIC "),COV," ",SDAT16
- Begin DoDot:2
- +9 ;SD/478
- SET CNIEN=0
- FOR
- SET CNIEN=$ORDER(^SC(+SSC,"S",HY,1,CNIEN))
- if '+CNIEN
- QUIT
- SET CNPAT=$PIECE($GET(^SC(+SSC,"S",HY,1,CNIEN,0)),U)
- IF CNPAT=DFN
- if +$GET(^SC(+SSC,"S",HY,1,CNIEN,"CONS"))
- WRITE " Consult Appt."
- SET CN=CN+1
- QUIT
- End DoDot:2
- End DoDot:1
- +10 ;Prompt for ETHNICITY if no value on file
- +11 IF '$ORDER(^DPT(DFN,.06,0))
- Begin DoDot:1
- +12 SET DA=DFN
- SET DR="6ETHNICITY"
- SET DIE="^DPT("
- +13 SET DR(2,2.06)=".01ETHNICITY"
- +14 DO ^DIE
- KILL DR
- End DoDot:1
- +15 ;Prompt for RACE if no value on file
- +16 IF '$ORDER(^DPT(DFN,.02,0))
- Begin DoDot:1
- +17 SET DA=DFN
- SET DR="2RACE"
- SET DIE="^DPT("
- +18 SET DR(2,2.02)=".01RACE"
- +19 DO ^DIE
- KILL DR
- End DoDot:1
- +20 ;Prompt for Language if no value on file ;*///*
- +21 IF '$ORDER(^DPT(DFN,.207,0))
- Begin DoDot:1
- +22 SET DA=DFN
- SET DIE="^DPT("
- SET DR="7LANGUAGE DATE/TIME;"
- SET DR(2,2.07)=".02//ENGLISH"
- +23 DO ^DIE
- KILL DR
- +24 ; check if no language entered
- DO LANGDEL^DGRPE
- End DoDot:1
- +25 IF $SELECT('$DATA(^DPT(DFN,.11)):1,$PIECE(^(.11),U)="":1,1:0)
- NEW FLG
- SET FLG(1)=1
- DO EN^DGREGAED(DFN,.FLG)
- +26 if $DATA(SDXXX)
- QUIT
- E SET Y=$PIECE(SL,U,5)
- +1 SET SDW=""
- IF $DATA(^DPT(DFN,.1))
- SET SDW=^(.1)
- WRITE !,"NOTE - PATIENT IS NOW IN WARD "_SDW
- +2 if $DATA(SDXXX)
- QUIT
- EN2 FOR X=0:0
- SET X=$ORDER(^DPT(DFN,"DE",X))
- if '$DATA(^(+X,0))
- QUIT
- IF ^(0)-SC=0!'(^(0)-Y)
- FOR XX=0:0
- SET XX=$ORDER(^DPT(DFN,"DE",X,1,XX))
- if XX<1
- QUIT
- SET SDDIS=$PIECE(^(XX,0),U,3)
- IF 'SDDIS
- if '$DATA(SDMULT)
- DO A^SDCNSLT
- GOTO ^SDM0
- +1 IF '$DATA(^SC(+Y,0))
- SET Y=+SC
- +2 SET Y=$PIECE(^SC(Y,0),U)
- +3 ; SCRESTA = Array of pt's teams causing restricted consults
- +4 NEW SCRESTA
- +5 SET SCREST=$$RESTPT^SCAPMCU4(DFN,DT,"SCRESTA")
- +6 IF SCREST
- Begin DoDot:1
- +7 NEW SCTM
- +8 SET SCCLNM=Y
- +9 WRITE !,?5,"Patient has restricted consults due to team assignment(s):"
- +10 SET SCTM=0
- +11 FOR
- SET SCTM=$ORDER(SCRESTA(SCTM))
- if 'SCTM
- QUIT
- WRITE !,?10,SCRESTA(SCTM)
- End DoDot:1
- +12 IF SCREST&'$GET(SCOKCONS)
- Begin DoDot:1
- +13 WRITE !,?5,"This patient may only be given appointments and enrolled in clinics via"
- +14 WRITE !,?15,"Make Consult Appointment Option, and"
- +15 WRITE !,?15,"Edit Clinic Enrollment Data option"
- End DoDot:1
- QUIT
- +16 if $GET(SCREST)
- DO MAIL^SCMCCON(DFN,.SCCLNM,2,DT,"SCRESTA")
- +17 KILL DR,SCREST,SCCLNM
- +18 ;SD/478
- if '$DATA(SDMULT)
- DO ^SDCNSLT
- +19 GOTO ^SDM0
- +20 ;
- CHKSO SET COV=$SELECT($PIECE(^DPT(DFN,"S",Y,0),U,11)=1:" (COLLATERAL)",1:"")
- SET HY=Y
- SET SSC=^(0)
- SET SDAT16=$SELECT($DATA(^SD(409.1,+$PIECE(SSC,U,16),0)):$PIECE(^(0),U),1:"")
- +1 FOR SDJ=3,4,5
- IF $PIECE(^DPT(DFN,"S",HY,0),U,SDJ)]""
- SET Y=$PIECE(^(0),U,SDJ)
- if $X>9
- WRITE !
- WRITE ?10,"*"
- DO DT^SDM0
- WRITE ?32,$SELECT(SDJ=3:"LAB",SDJ=4:"XRAY",1:"EKG")
- +2 SET SDLN=""
- FOR J=0:0
- SET J=$ORDER(^SC(+SSC,"S",HY,1,J))
- if 'J
- QUIT
- IF $DATA(^(J,0))
- IF +^(0)=DFN
- SET SDLN="("_$PIECE(^(0),U,2)_" MIN) "
- QUIT
- +3 SET Y=HY
- QUIT
- +4 ;
- END DO KVAR^VADPT
- KILL SDAPTYP,SDSC,%,%DT,ASKC,COV,DA,DIC,DIE,DP,DR,HEY,HSI,HY,J,SB,SC,SDDIF,SDJ,SDLN,SD17,SDMAX,SDU,SDYC,SI,SL,SSC,STARTDAY,STR
- +1 KILL WY,X,XX,Y,S,SD,SDAP16,SDEDT,SDTY,SM,SS,ST,ARG,CCX,CCXN,HX,I,PXR,SDINA,SDW,COLLAT,SDDIS
- IF $DATA(SDMM)
- if 'SDMM
- KILL SDMM
- +2 KILL A,CC,CLNIEN,CN,CNIEN,CNPAT,CNSLTLNK,CNSULT,CNT,CONS,CPRSTAT,CW,DSH,DTENTR,DTIN,DTLMT,DTR,ND,P8,PROC,PT,PTIEN,PTNM,RTMP,NOSHOW,SCPTTM,SD1,SDAMSCN,SDATE,SDDOT,SDII,SDINC,SDINCM,SDLEN,SDNS,SDSI,SDST,SDSTR,SDSTRTDT
- +3 KILL SDXSCAT,SENDER,SERVICE,SRV,STATUS,STPCOD,TMP,TMPYCLNC,TYPE
- +4 IF '$DATA(SDMLT)
- KILL SDMLT1
- +5 QUIT
- +6 ;
- OERR SET XQORQUIT=1
- if '$DATA(ORVP)
- QUIT
- SET DFN=+ORVP
- GOTO SDM
- +1 ;
- HELP WRITE !,"YES - TO DISPLAY FUTURE APPOINTMENTS",!,"NO - FUTURE APPOINTMENTS NOT DISPLAYED"
- GOTO PEND
- +1 ;
- CNAM(SDCL) ;Return clinic name
- +1 ;Input: SDCL=clinic ien
- +2 NEW SDX
- +3 SET SDX=$PIECE($GET(^SC(+SDCL,0)),U)
- +4 QUIT $SELECT($LENGTH(SDX):SDX,1:"this clinic")