SDCNP.m

SDCNP ;ALB/LDB - CANCEL SINGLE OR MULTIPLE APPOINTMENTS FOR PATIENT ; 3/2/05 2:33pm

 ;;5.3;Scheduling;**32,116,478,1015**;Aug 13, 1993;Build 21

 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

SDCNP     ;ALB/LDB - CANCEL SINGLE OR MULTIPLE APPOINTMENTS FOR PATIENT ; 3/2/05 2:33pm

 +1       ;;5.3;Scheduling;**32,116,478,1015**;Aug 13, 1993;Build 21

 +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