source: cprs/branches/tmg-cprs/m_files/TMGSDAC.m@ 1620

Last change on this file since 1620 was 796, checked in by Kevin Toppenberg, 14 years ago

Initial upload
File size: 6.0 KB
RevLine 
[796]1TMGSDAC ;TMG/kst/API FOR CANCELLING APPTS;2/23/09
2 ;;1.0;TMG-LIB;**1**;2/23/09
3 ;
4 ;"Called into from TMGRPC5
5 ;
6 ;"=======================================================================
7 ;" API -- Public Functions.
8 ;"=======================================================================
9 ;"CANCAPPT(DFN,APPTDATE,CLINIC,INFO) -- CANCEL AN APPOINTMENT
10 ;
11 ;"=======================================================================
12 ;"Dependancies
13 ;"=======================================================================
14 ;"=======================================================================
15 ;
16CANCAPPT(DFN,APPTDATE,CLINIC,INFO) ;
17 ;"Purpose: CANCEL AN APPOINTMENT
18 ;"INPUT: DFN -- The IEN of the patient for appt to cancel
19 ;" APPTDATE -- Appointment Date & Time to be cancelled -- FM format
20 ;" CLINIC -- IEN of Clinic for appt (file 44)
21 ;" INFO -- PASS BY REFERENCE.
22 ;" INFO("REASON IEN")= IEN of cancellation reason, from 409.2
23 ;" INFO("COMMENT") = Comment (3-160 chars length) (OPTIONAL)
24 ;"Result: 1 = OK,APPOINTMENT SUCCESSFULLY CANCELLED
25 ;" NEG NUMBER= ErrorNum^ErrorMessage.
26 ;
27 NEW RESULT SET RESULT="-1^NO MATCHING APPT FOUND TO DELETE" ;"Default to FAILURE
28 NEW DATEMADE SET DATEMADE=0
29 ;
30 IF $DATA(^SC(CLINIC))=0 DO GOTO CANCDONE
31 . SET RESULT="-1^INVALID CLINIC IEN: "_CLINIC
32 IF $DATA(^SC(CLINIC,"S",APPTDATE))=0 DO GOTO CANCDONE
33 . SET RESULT="-1^NO APPT FOUND AT SPECIFIED TIME"
34 NEW REASNIEN SET REASNIEN=+$GET(INFO("REASON IEN"))
35 IF (REASNIEN=0)!($DATA(^SD(409.2,REASNIEN))=0) DO GOTO CANCDONE
36 . SET RESULT="-1^INVALID CANCELLATION IEN: "_REASNIEN
37 NEW IEN SET IEN=0
38 FOR SET IEN=$ORDER(^SC(CLINIC,"S",APPTDATE,1,IEN)) QUIT:(+IEN'>0) DO
39 . NEW S SET S=$GET(^SC(CLINIC,"S",APPTDATE,1,IEN,0))
40 . IF +S'=DFN QUIT ;"Ignore appt if patient doesn't match.
41 . SET DATEMADE=+$PIECE(S,"^",7) ;"Store for later
42 . KILL ^SC(CLINIC,"S",APPTDATE,1,IEN) ;"<-- DELETION OF APPT (Part 1)
43 ;
44 IF DATEMADE=0 GOTO CANCDONE ;"Apparently no matching appt found above
45 IF $DATA(^DPT(DFN,"S",APPTDATE))=0 GOTO CANCDONE
46 ;
47 NEW TMGFDA,IENS,%,REASNSTR
48 SET REASNSTR=$EXTRACT($GET(INFO("REASON IEN")),1,160)
49 DO NOW^%DTC ;"Returns NOW in %
50 SET IENS=APPTDATE_","_DFN_","
51 SET TMGFDA(2.98,IENS,3)="C" ;"STATUS
52 SET TMGFDA(2.98,IENS,14)=DUZ ;"NO-SHOW/CANCELLED BY
53 SET TMGFDA(2.98,IENS,15)=% ;"NO-SHOW/CANCEL DATE/TIME
54 SET TMGFDA(2.98,IENS,16)=REASNIEN ;"CANCELLATION REASON
55 SET TMGFDA(2.98,IENS,19)=DUZ ;"DATA ENTRY CLERK
56 SET TMGFDA(2.98,IENS,20)=DATEMADE ;"DATE APPT. MADE
57 SET TMGFDA(2.98,IENS,17)=REASNSTR ;"CANCELLATION REMARKS
58 ;
59 DO FILE^DIE("","TMGFDA","TMGMSG") ;"File in INTERNAL format
60 IF $DATA(TMGMSG) DO GOTO CANCDONE
61 . SET RESULT="-1^"_$$GETERSTR(.TMGMSG)
62 ;
63 ;"send event to rest of system!!!
64 ;
65 SET RESULT=1 ;"Change to success if no problems at the end of the process.
66 ;
67CANCDONE ;
68 QUIT RESULT
69 ;
70 ;
71GETERSTR(TMGEARRAY) ;
72 ;"Purpose: convert a standard DIERR array into a string for output
73 ;"Input: TMGEARRAY -- PASS BY REFERENCE. example:
74 ;" array("DIERR")="1^1"
75 ;" array("DIERR",1)=311
76 ;" array("DIERR",1,"PARAM",0)=3
77 ;" array("DIERR",1,"PARAM","FIELD")=.02
78 ;" array("DIERR",1,"PARAM","FILE")=2
79 ;" array("DIERR",1,"PARAM","IENS")="+1,"
80 ;" array("DIERR",1,"TEXT",1)="The new record '+1,' lacks some required identifiers."
81 ;" array("DIERR","E",311,1)=""
82 ;"Results: returns one long equivalent string from above array.
83 ;"Note: This is a copy of the function GetErrStr^TMGDEBUG
84 ;" I copied it here so that this file has no TMG* dependencies.
85 ;
86 NEW TMGESTR,TMGIDX,TMGENUM
87 SET TMGESTR=""
88 FOR TMGENUM=1:1:+$GET(TMGEARRAY("DIERR")) DO
89 . SET TMGESTR=TMGESTR_"Fileman says: '"
90 . IF TMGENUM'=1 SET TMGESTR=TMGESTR_"(Error# "_TMGENUM_") "
91 . SET TMGIDX=$ORDER(TMGEARRAY("DIERR",TMGENUM,"TEXT",""))
92 . IF TMGIDX'="" FOR DO QUIT:(TMGIDX="")
93 . . SET TMGESTR=TMGESTR_$GET(TMGEARRAY("DIERR",TMGENUM,"TEXT",TMGIDX))_" "
94 . . SET TMGIDX=$ORDER(TMGEARRAY("DIERR",TMGENUM,"TEXT",TMGIDX))
95 . IF $GET(TMGEARRAY("DIERR",TMGENUM,"PARAM",0))>0 DO
96 . . SET TMGIDX=$ORDER(TMGEARRAY("DIERR",TMGENUM,"PARAM",0))
97 . . SET TMGESTR=TMGESTR_"Details: "
98 . . FOR DO QUIT:(TMGIDX="")
99 . . . IF TMGIDX="" QUIT
100 . . . SET TMGESTR=TMGESTR_"["_TMGIDX_"]="_$GET(TMGEARRAY("DIERR",1,"PARAM",TMGIDX))_" "
101 . . . SET TMGIDX=$ORDER(TMGEARRAY("DIERR",TMGENUM,"PARAM",TMGIDX))
102 ;
103 QUIT TMGESTR
104 ;
105
106
107 ;"------------------------------------------
108 ;"I think the code below can be delete later. It is done automatically by
109 ;" the XREF
110 ;"
111
112 ;"Input: DA(1) = DFN -- patient IEN
113 ;" DA -- appt time
114
115 ;"K Q8 F Q7=0:0 S Q7=$N(^SC($P(^DPT(DA(1),"S",DA,0),"^"),"S",DA,1,Q7)) Q:Q7'>0 I $P(^(Q7,0),"^")=DA(1),$P(^(0),"^",9)="C" S Q8="" Q
116 ;"I '$D(Q8) S ^DPT("ASDCN",$P(^DPT(DA(1),"S",DA,0),"^"),DA,DA(1))=$S($P(^DPT(DA(1),"S",DA,0),"^",2)["P":1,1:"")
117 ;"K Q7,Q8 Q
118
119
120 ;"This is called when setting STATUS field (#3, 0;2) in PATIENT file
121
122 K Q8
123 set Q7=0
124 set SC=$P(^DPT(DFN,"S",APTTIME,0),"^",1)
125 F S Q7=$order(^SC(SC,"S",APTTIME,1,Q7)) Q:Q7'>0 DO quit:$data(Q8)
126 . if $P(^SC(SC,"S",APTTIME,1,Q7,0),"^",1)'=DFN quit ;"0;1 = Patient IEN
127 . if $P(^SC(SC,"S",APTTIME,1,Q7,0),"^",9)="C" S Q8="" ;"0;9 = APPOINTMENT CANCELLED?
128 I '$D(Q8) DO ;"i.e. do this if APPOINTMENT CANCELLED <> 'C'
129 . new status set status=$P(^DPT(DFN,"S",APTTIME,0),"^",2) ;"0;2 = STATUS
130 . set ^DPT("ASDCN",SC,APTTIME,DFN)=$S(status["P":1,1:"") ;"P --> cancelled by patient
131 K Q7,Q8
132 Q
Note: See TracBrowser for help on using the repository browser.