source: WorldVistAEHR/trunk/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXCESDAM.m@ 1476

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

initial load of WorldVistAEHR
File size: 4.8 KB
RevLine 
[613]1PXCESDAM ;ISL/dee,ALB/Zoltan - PCE List Manager display of appointments ;11/20/98
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**1,34,147,172**;Aug 12, 1996
3 ;
4 ;Originally Developed using code from:
5SDAM ;MJK/ALB - Appt Mgt ; 12/1/91
6 ;;5.3;Scheduling;;Aug 13, 1993
7 Q
8 ;
9 ; -- kill off handle data
10EN ; -- main entry point
11 D FULL^VALM1
12 D EN^VALM("PXCE SDAM MENU")
13 D MAKELIST^PXCENEW
14 Q
15 ;
16INIT ; -- set up appt man vars
17 K I,X,SDB,XQORNOD,SDFN,SDCLN,DA,DR,DIE,DNM,DQ,%B
18 S $P(PXCEVIEW,"^",2)="A"
19 I PXCEVIEW["P" D INTSDAM1^PXCESDA1
20 I PXCEVIEW["H" D INTSDAM3^PXCESDA3
21 Q
22 ;
23FNL ; -- what to do after action
24 D CLEAN^VALM10
25 K ^TMP("SDAM",$J),^TMP("SDAMIDX",$J),^TMP("VALMIDX",$J)
26 K SDAMCNT,SDFLDD,SDACNT,VALMHCNT,SDPRD,SDFN,SDCLN,SDAMLIST,SDT,SDATA,SDY,X,SDCL,Y,SDDA,VALMY
27 Q
28 ;
29EXIT ; -- exit action for protocol
30 D:PXCEVIEW'["P" PATKILL^PXCEPAT
31 Q
32 ;
33EXPND ; -- expand code
34 D EN^PXCEEXP
35 Q
36 ;
37SEL ;
38 N PXCEVIEN
39 N PXCEAPDT S PXCEAPDT=""
40 I '$D(PXCEPAT) N PXCEPAT S PXCEPAT=""
41 I '$D(PXCEHLOC) N PXCEHLOC S PXCEHLOC=""
42 S PXCEVIEN=$$SELAPPM
43 I PXCEVIEN=-1 G SELQ
44 ; next 3 lines PX*1.0*172
45 N PXREC,PXDUZ,PXPTSSN S PXDUZ=DUZ,PXPTSSN=$TR($G(PXCEPAT("SSN")),"-")
46 D SEC^PXCEEXP(.PXREC,PXDUZ,PXPTSSN)
47 I PXREC W !!,"Security regulations prohibit computer access to your own medical record." H 3 G SELQ
48 ;
49 D APPCHECK(.PXCEVIEN,PXCEHLOC,PXCEAPDT,PXCEPAT)
50 I '$D(PXCEVIEN) G SELQ
51 D:PXCEVIEN="" EN^PXCEVFIL("APPM")
52 D:PXCEVIEN>0 EN^PXCEAE
53SELQ K ^UTILITY("VASD",$J)
54 Q
55 ;
56SELAPPM() ;
57 N SDW,SDERR
58 S SDW=+$P(XQORNOD(0),"^",3)
59 I SDW'>0 K SDW D SELSDAM I '$D(SDW)!SDERR Q -1
60 I $P($P(^TMP("SDAMIDX",$J,SDW),"^",3),".",1)>DT D Q -1
61 . W !!,$C(7),"Can not update future encounters."
62 . D WAIT^PXCEHELP
63 D FULL^VALM1
64 N PXCEVIEN,PXCEINDX
65 I '$D(PXCEAPDT) N PXCEAPDT
66 I '$D(PXCEPAT) N PXCEPAT
67 I '$D(PXCEHLOC) N PXCEHLOC
68 S PXCEAPDT=$P(^TMP("SDAMIDX",$J,SDW),"^",3)
69 I $G(PXCEPAT)="" S PXCEPAT=$P(^TMP("SDAMIDX",$J,SDW),"^",2) D PATINFO^PXCEPAT(.PXCEPAT) I $D(DIRUT) Q -1
70 I $G(PXCEHLOC)="" S PXCEHLOC=$P(^TMP("SDAMIDX",$J,SDW),"^",4)
71 ;
72 ;Look for visits for this patient at the appointment date and time.
73 S PXCEVIEN=$$APPT2VST^PXUTL1(PXCEPAT,PXCEAPDT,PXCEHLOC)
74 Q $S(PXCEVIEN>0:PXCEVIEN,1:"")
75 ;
76SELSDAM ; -- select processing
77 N BG,LST,Y
78 N DIRUT,DTOUT,DUOUT,DIROUT,DIR,DA
79 S BG=1
80 S LST=+$O(@VALMAR@("IDX",VALMCNT,0))
81 I LST=BG S SDERR=0,SDW=BG Q
82 I 'LST W !!,$C(7),"There are no '",VALM("ENTITY"),"s' to select.",! D WAIT^PXCEHELP S SDERR=1 Q
83 S Y=+$P($P(XQORNOD(0),U,4),"=",2)
84 I 'Y S DIR(0)="N^"_BG_":"_LST,DIR("A")="Select "_VALM("ENTITY") D ^DIR I $D(DIRUT) S SDERR=1 Q
85 ;
86 ; -- check was valid entries
87 S SDERR=0,SDW=Y
88 I SDW<BG!(SDW>LST) D
89 .W !,$C(7),"Selection '",SDW,"' is not a valid choice."
90 .S SDERR=1
91 .D WAIT^PXCEHELP
92 Q
93 ;
94APPCHECK(PXCEVIEN,PXCEHLOC,PXCEAPDT,PXCEPAT) ; Pass in PXCEVIEN and kills it if should not be selected.
95 I PXCEVIEN="" D Q
96 . I $$CANCEL($G(PXCEHLOC),$G(PXCEAPDT),$G(PXCEPAT)) K PXCEVIEN
97 N VASD,VAERR
98 S VASD("W")=345678
99 S VASD("F")=+^AUPNVSIT(PXCEVIEN,0)-.0000001
100 S VASD("T")=VASD("F")+.0000002
101 S VASD("C",+$P(^AUPNVSIT(PXCEVIEN,0),"^",22))=""
102 D SDA^VADPT
103 I $D(^UTILITY("VASD",$J)) D
104 . I 'PXCEVIEN D
105 .. W !,$C(7),"PCE has no data related to this appointment."
106 .. W !,"You cannot add data for an appointment that has a status of ",$P(^UTILITY("VASD",$J,1,"E"),"^",3)
107 .. K PXCEVIEN
108 .. D WAIT^PXCEHELP
109 . E I PXCEKEYS["S" D
110 .. N DIR,DA
111 .. W !,$C(7),"Appointment has a status of ",$P(^UTILITY("VASD",$J,1,"E"),"^",3)
112 .. S DIR("A",1)="WARNING: Data stored in PCE related to this appointment"
113 .. S DIR("A",2)=" will NOT be used for Workload or Billing. This is a bad encounter"
114 .. S DIR("A")="Do you want to continue with this encounter"
115 .. S DIR("B")="NO"
116 .. S DIR(0)="Y"
117 .. D ^DIR
118 .. I Y'=1 K PXCEVIEN
119 . E D
120 .. W !,$C(7),"Appointment has a status of ",$P(^UTILITY("VASD",$J,1,"E"),"^",3)
121 .. W !,"WARNING: Data stored in PCE related to this appointment"
122 .. W !," will NOT be used for Workload or Billing. This is a bad encounter"
123 .. W !,"You must use a PCE Superviser option to access the encounter."
124 .. K PXCEVIEN
125 .. D WAIT^PXCEHELP
126 ;
127 ; Exit if we already know it should not be selected.
128 I $D(PXCEVIEN)["0" Q
129 ;
130 ;If Supervisor then ask if want to edit ancillary package data
131 I PXCEKEYS["S",$P($G(^AUPNVSIT(PXCEVIEN,150)),"^",3)="A" D
132 . N DIR,DA
133 . W $C(7)
134 . S DIR("A",1)="WARNING: Data stored in PCE came from another package and should"
135 . S DIR("A",2)=" only be changed in that package. If it is changed by PCE it will"
136 . S DIR("A",3)=" not agree with what is in the originating package."
137 . S DIR("A")="Do you want to continue with this encounter"
138 . S DIR("B")="NO"
139 . S DIR(0)="Y"
140 . D ^DIR
141 . I Y'=1 K PXCEVIEN
142 Q
143 ;
144CANCEL(PXHL,PXDT,PXDFN) ; True if the appointment is cancelled or no-showed.
145 N STATUS,CANC
146 S CANC=0
147 I PXHL,PXDT,PXDFN,PXHL=+$G(^DPT(PXDFN,"S",PXDT,0)) D
148 . S STATUS=$P(^DPT(PXDFN,"S",PXDT,0),U,2)
149 . I STATUS["N"!(STATUS["C") S CANC=1
150 Q CANC
Note: See TracBrowser for help on using the repository browser.