source: FOIAVistA/tag/r/SCHEDULING-SD-SC/SDCNP.m@ 1764

Last change on this file since 1764 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.6 KB
Line 
1SDCNP ;ALB/LDB - CANCEL SINGLE OR MULTIPLE APPOINTMENTS FOR PATIENT ; 3/2/05 2:33pm
2 ;;5.3;Scheduling;**32,116,478**;Aug 13, 1993
3 K ORACTION
4RD 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
5 S (DA,DFN)=+Y,NAME=$P(Y,"^",2)
6EN D DT^SDUTL:'$D(DT) S HDT=DT,APL="" D NOW^%DTC S (SDTM,HDT)=$J(%,".",4),(SDERR,CNT)=0
7SEL 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
8 S SDPV=$S(X9=""!(X9["F"):"",1:1)
9 S SDERR=0 W ! I ('$O(^DPT(DFN,"S",$P(SDTM,".")))&'SDPV)!(SDPV&($O(^DPT(DFN,"S",0))'<SDTM)) G NO^SDCNP0
10STAT 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
11 S SDWH=$S(SDWH["P":"PC",SDWH="":"PC",1:"C"),SDCP=$S(SDWH="C":0,1:1)
12RSN 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
13REM R !,"CANCELLATION REMARKS: ",SDREM:DTIME G:SDREM["^"!('$T) END G:SDREM="" W ;SD/478
14 S TMPD=SDREM ;SD/478
15 I $L(SDREM)<3!($L(SDREM)>160)!(SDREM?."?") W !,*7,"Must be 3 to 160 characters in length" G REM
16 I SDREM'?.ANP W !,*7,"NO CONTROL CHARACTERS" G REM
17W K Z,Z1,ZX W !!,"READY TO CANCEL ",$S('SDPV:"PENDING",1:"PREVIOUS")," APPTS",!
18DATE 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
19 G ^SDCNP0
20END 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
21 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
22 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)
23 K MESS,MIN,DIW,DIWF,DIWL,DIWR,DIWT,DN,DQ,L0,SDADD,SDC,SDDAT,SDHX,SDT0,SD20,TST,TMPD Q
24OERR 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
Note: See TracBrowser for help on using the repository browser.