SDCNP ;ALB/LDB - CANCEL SINGLE OR MULTIPLE APPOINTMENTS FOR PATIENT ; 3/2/05 2:33pm
;;5.3;Scheduling;**32,116,478**;Aug 13, 1993
K ORACTION
RD G END:$D(ORACTION)!($D(SDAMTYP)) S DIC="^DPT(",DIC(0)="AEQM" D ^DIC G:X=""!(X="^") END I Y<0 W !,*7,*7,"PATIENT NOT FOUND",*7,*7 G RD
S (DA,DFN)=+Y,NAME=$P(Y,"^",2)
EN D DT^SDUTL:'$D(DT) S HDT=DT,APL="" D NOW^%DTC S (SDTM,HDT)=$J(%,".",4),(SDERR,CNT)=0
SEL R !,"DO YOU WANT TO CANCEL (P)AST OR (F)UTURE APPOINTMENTS? F// ",X9:DTIME G:X9["^"!('$T) END S:X9="" X9="F" S X9=$$UP^XLFSTR(X9) I "FP"'[X9!(X9["?") W !,"Enter a P to cancel past appointments or F to cancel future appointments" G SEL
S SDPV=$S(X9=""!(X9["F"):"",1:1)
S SDERR=0 W ! I ('$O(^DPT(DFN,"S",$P(SDTM,".")))&'SDPV)!(SDPV&($O(^DPT(DFN,"S",0))'<SDTM)) G NO^SDCNP0
STAT R !,"APPOINTMENTS CANCELLED BY (P)ATIENT OR BY (C)LINIC? P// ",SDWH:DTIME G:SDWH="^"!('$T) END S SDWH=$$UP^XLFSTR(SDWH) I SDWH'="",SDWH'["P",SDWH'["C" W !,"Enter a P for by Patient or a C for by Clinic" G STAT
S SDWH=$S(SDWH["P":"PC",SDWH="":"PC",1:"C"),SDCP=$S(SDWH="C":0,1:1)
RSN S SDSCRPC=$S(SDWH["P":"P",1:"C"),DIC="^SD(409.2,",DIC(0)="AEQM",DIC("S")="I '$P(^(0),U,4),(SDSCRPC_""B""[$P(^(0),U,2))" D ^DIC G:X="^" END S SDSCR=$S(X="":X,1:+Y) K SDSCRPC,DIC I X="" G RSN
REM R !,"CANCELLATION REMARKS: ",SDREM:DTIME G:SDREM["^"!('$T) END G:SDREM="" W ;SD/478
S TMPD=SDREM ;SD/478
I $L(SDREM)<3!($L(SDREM)>160)!(SDREM?."?") W !,*7,"Must be 3 to 160 characters in length" G REM
I SDREM'?.ANP W !,*7,"NO CONTROL CHARACTERS" G REM
W K Z,Z1,ZX W !!,"READY TO CANCEL ",$S('SDPV:"PENDING",1:"PREVIOUS")," APPTS",!
DATE I SDPV S %DT="AEXP",%DT("A")="DISPLAY APPTS STARTING WITH DATE: FIRST// " S %DT(0)="-NOW" D ^%DT G:X["^" END S HDT=$S(Y>0:Y,1:0) K %DT
G ^SDCNP0
END D END^SDAUT2 K %,%DT,%H,%I,%Y,A,A1,A2,A8,A9,B,ADDR,DTOUT,ANS,APL,APP,APPZ,AT,CNT,C,CDATE,CHAR,CLIN,CNN,COMMENT,COV,D0,DA,DATE,DGPGM,DGVAR,DI,DIC,DIE,DIPGM,DIV,DK,DL,DOW,DR,DUPE,ENDATE,GDATE,HDT,HSI,I,J,L,L1,L5,LL,NAME,NDT,NDATE,M1,M8,MAX
K PDAT,POP,Q,Q1,S,S1,S2,S3,S5,S9,SD0,SD2,SB,SC,SD,SDA,SDAP,SD1,SDCL,SDCP,SDCNT,SDCNT1,SDCTR,SDCTRL,SDDH,SDDI,SDDIF,SDDK,SDDM,SDDT,SDDT1,SDEND,SDERR,SDFOR,SDINP,SDIO,SDJ,SDJ1,SDLET,SDLN,SDLN1,SDLN2,SDMSG,SDMDT,SDNODE,SDP,SDP1,SDPV,SDPT,SDPRT,SDR
K A0,A1,A3,A5,ALL,SDREM,SDS,SDRT,SDTADE,SDTADB,SDPRT,SDSCR,SDSOH,SDA,SDT,SDTH,SDT1,SDTTM,SDX,SDX1,SDV,SDV2,SL,SM,STARTDAY,STIME,STR,TIME,SDTM,SDWH,SDXX,X1,X3,X8,X9,SI,SS,ST,SDSTRTDT,X,Y,Z,Z0,Z1,Z5,Z6,Z7,Z9,ZL,ZX,^UTILITY($J)
K MESS,MIN,DIW,DIWF,DIWL,DIWR,DIWT,DN,DQ,L0,SDADD,SDC,SDDAT,SDHX,SDT0,SD20,TST,TMPD Q
OERR S XQORQUIT=1 Q:'$D(ORVP) S (DA,DFN)=+ORVP,NAME=$S($D(^DPT(DFN,0)):$P(^(0),"^",1),1:"") D EN N PAUSE W !,"Press Return to continue: " R PAUSE:DTIME K PAUSE Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDCNP 2733 printed Oct 16, 2024@18:49:44 Page 2
SDCNP ;ALB/LDB - CANCEL SINGLE OR MULTIPLE APPOINTMENTS FOR PATIENT ; 3/2/05 2:33pm
+1 ;;5.3;Scheduling;**32,116,478**;Aug 13, 1993
+2 KILL ORACTION
RD if $DATA(ORACTION)!($DATA(SDAMTYP))
GOTO END
SET DIC="^DPT("
SET DIC(0)="AEQM"
DO ^DIC
if X=""!(X="^")
GOTO END
IF Y<0
WRITE !,*7,*7,"PATIENT NOT FOUND",*7,*7
GOTO RD
+1 SET (DA,DFN)=+Y
SET NAME=$PIECE(Y,"^",2)
EN if '$DATA(DT)
DO DT^SDUTL
SET HDT=DT
SET APL=""
DO NOW^%DTC
SET (SDTM,HDT)=$JUSTIFY(%,".",4)
SET (SDERR,CNT)=0
SEL READ !,"DO YOU WANT TO CANCEL (P)AST OR (F)UTURE APPOINTMENTS? F// ",X9:DTIME
if X9["^"!('$TEST)
GOTO END
if X9=""
SET X9="F"
SET X9=$$UP^XLFSTR(X9)
IF "FP"'[X9!(X9["?")
WRITE !,"Enter a P to cancel past appointments or F to cancel future appointments"
GOTO SEL
+1 SET SDPV=$SELECT(X9=""!(X9["F"):"",1:1)
+2 SET SDERR=0
WRITE !
IF ('$ORDER(^DPT(DFN,"S",$PIECE(SDTM,".")))&'SDPV)!(SDPV&($ORDER(^DPT(DFN,"S",0))'<SDTM))
GOTO NO^SDCNP0
STAT READ !,"APPOINTMENTS CANCELLED BY (P)ATIENT OR BY (C)LINIC? P// ",SDWH:DTIME
if SDWH="^"!('$TEST)
GOTO END
SET SDWH=$$UP^XLFSTR(SDWH)
IF SDWH'=""
IF SDWH'["P"
IF SDWH'["C"
WRITE !,"Enter a P for by Patient or a C for by Clinic"
GOTO STAT
+1 SET SDWH=$SELECT(SDWH["P":"PC",SDWH="":"PC",1:"C")
SET SDCP=$SELECT(SDWH="C":0,1:1)
RSN SET SDSCRPC=$SELECT(SDWH["P":"P",1:"C")
SET DIC="^SD(409.2,"
SET DIC(0)="AEQM"
SET DIC("S")="I '$P(^(0),U,4),(SDSCRPC_""B""[$P(^(0),U,2))"
DO ^DIC
if X="^"
GOTO END
SET SDSCR=$SELECT(X="":X,1:+Y)
KILL SDSCRPC,DIC
IF X=""
GOTO RSN
REM ;SD/478
READ !,"CANCELLATION REMARKS: ",SDREM:DTIME
if SDREM["^"!('$TEST)
GOTO END
if SDREM=""
GOTO W
+1 ;SD/478
SET TMPD=SDREM
+2 IF $LENGTH(SDREM)<3!($LENGTH(SDREM)>160)!(SDREM?."?")
WRITE !,*7,"Must be 3 to 160 characters in length"
GOTO REM
+3 IF SDREM'?.ANP
WRITE !,*7,"NO CONTROL CHARACTERS"
GOTO REM
W KILL Z,Z1,ZX
WRITE !!,"READY TO CANCEL ",$SELECT('SDPV:"PENDING",1:"PREVIOUS")," APPTS",!
DATE IF SDPV
SET %DT="AEXP"
SET %DT("A")="DISPLAY APPTS STARTING WITH DATE: FIRST// "
SET %DT(0)="-NOW"
DO ^%DT
if X["^"
GOTO END
SET HDT=$SELECT(Y>0:Y,1:0)
KILL %DT
+1 GOTO ^SDCNP0
END DO END^SDAUT2
KILL %,%DT,%H,%I,%Y,A,A1,A2,A8,A9,B,ADDR,DTOUT,ANS,APL,APP,APPZ,AT,CNT,C,CDATE,CHAR,CLIN,CNN,COMMENT,COV,D0,DA,DATE,DGPGM,DGVAR,DI,DIC,DIE,DIPGM,DIV,DK,DL,DOW,DR,DUPE,ENDATE,GDATE,HDT,HSI,I,J,L,L1,L5,LL,NAME,NDT,NDATE,M1,M8,MAX
+1 KILL PDAT,POP,Q,Q1,S,S1,S2,S3,S5,S9,SD0,SD2,SB,SC,SD,SDA,SDAP,SD1,SDCL,SDCP,SDCNT,SDCNT1,SDCTR,SDCTRL,SDDH,SDDI,SDDIF,SDDK,SDDM,SDDT,SDDT1,SDEND,SDERR,SDFOR,SDINP,SDIO,SDJ,SDJ1,SDLET,SDLN,SDLN1,SDLN2,SDMSG,SDMDT,SDNODE,SDP,SDP1,SDPV,SDPT,SDPRT,
SDR
+2 KILL A0,A1,A3,A5,ALL,SDREM,SDS,SDRT,SDTADE,SDTADB,SDPRT,SDSCR,SDSOH,SDA,SDT,SDTH,SDT1,SDTTM,SDX,SDX1,SDV,SDV2,SL,SM,STARTDAY,STIME,STR,TIME,SDTM,SDWH,SDXX,X1,X3,X8,X9,SI,SS,ST,SDSTRTDT,X,Y,Z,Z0,Z1,Z5,Z6,Z7,Z9,ZL,ZX,^UTILITY($JOB)
+3 KILL MESS,MIN,DIW,DIWF,DIWL,DIWR,DIWT,DN,DQ,L0,SDADD,SDC,SDDAT,SDHX,SDT0,SD20,TST,TMPD
QUIT
OERR SET XQORQUIT=1
if '$DATA(ORVP)
QUIT
SET (DA,DFN)=+ORVP
SET NAME=$SELECT($DATA(^DPT(DFN,0)):$PIECE(^(0),"^",1),1:"")
DO EN
NEW PAUSE
WRITE !,"Press Return to continue: "
READ PAUSE:DTIME
KILL PAUSE
QUIT
