source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDPPAPP1.m@ 648

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

initial load of WorldVistAEHR

File size: 3.5 KB
RevLine 
[613]1SDPPAPP1 ;ALB/CAW - Display Appointments; 5/4/92
2 ;;5.3;Scheduling;**6,22,140,80,517**;Aug 13, 1993;Build 4
3 ;
4 ;
5EN1 ; Loop through appt. date/time
6 N SDAP,SDCI,SDOB,SDPDATA,SDPOV,SDPV,SDWHEN,SDSTART,SDSTOP
7 S SDFST=13,SDSEC=55,SDLEN=25,$P(SDASH,"-",IOM+1)="",SDSTART=$S($D(SDBEG):SDBEG,'SDBD:SDBD,1:SDBD-.1),SDSTOP=$S($D(SDEND):SDEND,1:SDED)
8 F SDDT=SDSTART:0 S SDDT=$O(^DPT(DFN,"S",SDDT)) Q:'SDDT!(SDDT>(SDSTOP+.9)) D
9 .S SDPDATA=^(SDDT,0)
10 .I $D(SDY),SDY'=+SDPDATA Q
11 .S ^TMP("SDAPT",$J,-SDDT,0)=SDPDATA
12 .I $D(^DPT(DFN,"S",SDDT,"R")) S ^TMP("SDAPT",$J,-SDDT,"R")=^DPT(DFN,"S",SDDT,"R")
13 .S POP=0 F SDAP=0:0 S SDAP=$O(^SC(+SDPDATA,"S",SDDT,1,SDAP)) Q:'SDAP D CHK Q:POP S SDCDATA=$G(^SC(+SDPDATA,"S",SDDT,1,SDAP,0)),SDCI=$G(^("C")),SDOB=$G(^("OB")) I +SDCDATA=DFN S ^TMP("SDAPT",$J,-SDDT,1)=SDCDATA,^("C")=SDCI ;SD/517 added CHK
14 .I '$D(SDCDATA) S (SDCDATA,SDCI,SDOB)=0 S ^TMP("SDAPT",$J,-SDDT,1)=SDCDATA,^("C")=SDCI
15 .K SDCDATA
16 F I=-9999999.99:0 S I=$O(^TMP("SDAPT",$J,I)) Q:'I S SDWHEN=$E(I,2,999),SDPDATA=^(I,0),SDCDATA=$G(^(1)),SDCI=$G(^("C")),SDREMARK=$G(^("R")) D INFO
17 K ^TMP("SDAPT",$J),POP
18 Q
19 ;
20CHK ;SD/517
21 Q:$D(^SC(+SDPDATA,"S",SDDT,1,SDAP,0))
22 S SDCDATA=DFN_U_0
23 S ^TMP("SDAPT",$J,-SDDT,1)=SDCDATA
24 S POP=1
25 Q
26 ;
27INFO ; Set information
28 ;
29DATE ; Date/Time and Type
30 S X="",X=$$SETSTR^VALM1("Date/Time:",X,2,10)
31 S X=$$SETSTR^VALM1($TR($$FMTE^XLFDT(SDWHEN,"5F")," ","0"),X,SDFST,SDLEN)
32 S X=$$SETSTR^VALM1("Type:",X,49,5)
33 S X=$$SETSTR^VALM1($P($G(^SD(409.1,+$P(SDPDATA,U,16),0)),U),X,SDSEC,SDLEN)
34 D SET(X)
35CLINIC ; Clinic and Eligibility of Visit
36 S X="",X=$$SETSTR^VALM1("Clinic:",X,5,7)
37 S X=$$SETSTR^VALM1($P($G(^SC(+SDPDATA,0)),U),X,SDFST,SDLEN)
38 I $P(SDCDATA,U,10)'="" D
39 .S X=$$SETSTR^VALM1("Elig. of Vst.:",X,40,14)
40 .S X=$$SETSTR^VALM1($P($G(^DIC(8,+$P(SDCDATA,U,10),0)),U),X,SDSEC,SDLEN)
41 D SET(X)
42STAT ; Status and Clerk
43 S X="",X=$$SETSTR^VALM1("Status:",X,5,7)
44 S X=$$SETSTR^VALM1($P($$STATUS^SDAM1(DFN,SDWHEN,+SDPDATA,SDPDATA),";",3),X,SDFST,SDLEN)
45 S X=$$SETSTR^VALM1("Clerk:",X,48,6)
46 S X=$$SETSTR^VALM1($P($G(^VA(200,$S($P(SDCDATA,U,6):$P(SDCDATA,U,6),1:+$P(SDPDATA,U,18)),0)),U),X,SDSEC,SDLEN)
47 D SET(X)
48PURP ; Purpose of Visit and Date Appt. Made
49 S X="",X=$$SETSTR^VALM1("POV:",X,8,4)
50 S SDPOV=$P(SDPDATA,U,7),SDPV=$S(SDPOV=1:"C&P",SDPOV=2:"10-10",SDPOV=3:"SCHEDULED",SDPOV=4:"UNSCHEDULED",1:"UNKNOWN")
51 S X=$$SETSTR^VALM1(SDPV,X,SDFST,SDLEN)
52 S X=$$SETSTR^VALM1("Date Made:",X,44,10)
53 S X=$$SETSTR^VALM1($TR($$FMTE^XLFDT($S($P(SDCDATA,U,7):$P(SDCDATA,U,7),1:$P(SDPDATA,U,19)),"5DF")," ","0"),X,SDSEC,SDLEN)
54 D SET(X)
55CI ; Checked-In and Checked-Out Times
56 S X=""
57 I +SDCI D
58 .S X=$$SETSTR^VALM1("Checked-In:",X,1,11)
59 .S X=$$SETSTR^VALM1($$FMTE^XLFDT($P(SDCI,U),"5"),X,SDFST,SDLEN)
60 I $P(SDCI,U,3)'="" D
61 .S X=$$SETSTR^VALM1("Checked-Out:",X,42,12)
62 .S X=$$SETSTR^VALM1($TR($$FMTE^XLFDT($P(SDCI,U,3),"5F")," ","0"),X,SDSEC,SDLEN)
63 ;following logic for Warning added per SD/517
64 I $D(SDCDATA) I $P(SDCDATA,U,2)=0 D
65 .S X="" D SET(X)
66 .D SET("**************************** WARNING *******************************************")
67 .D SET("There is a data inconsistency or data corruption problem with the above")
68 .D SET("appointment. Corrective action needs to be taken. Please cancel")
69 .D SET("the appointment above. If it is a valid appointment, it will have to")
70 .D SET("be re-entered via Appointment Management.")
71 .D SET("********************************************************************************")
72 .S X="" D SET(X)
73 ;
74 D:X'="" SET(X)
75 D ^SDPPAPP2
76 Q
77SET(X) ; Set in ^TMP global for display
78 ;
79 S SDLN=SDLN+1,^TMP("SDPPALL",$J,SDLN,0)=X
80 S VALMCNT=SDLN
81 Q
Note: See TracBrowser for help on using the repository browser.