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

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

initial load of WorldVistAEHR

File size: 2.8 KB
Line 
1PXCEINTR ;ISL/dee - PCE List Manager call to do interview questions ;7/9/96
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**172**;Aug 12, 1996
3 ;
4 Q
5 ;
6GETVIEN() ;Ask the user which visit or to add a new one.
7 N PXCEVIDX,PXCEVIEN
8 S PXCEVIDX=$$SEL1^PXCE("",1)
9 Q:PXCEVIDX="A" ""
10 Q:PXCEVIDX'>0 -1
11 S PXCEVIEN=$G(^TMP("PXCEIDX",$J,PXCEVIDX))
12 ;Check that it is not related to a no show or canceled apppointment
13 D APPCHECK^PXCESDAM(.PXCEVIEN)
14 Q:'$D(PXCEVIEN) -1
15 ;Cannot edit future visits
16 I $P(+^AUPNVSIT(PXCEVIEN,0),".")>DT D Q -1
17 . W !!,$C(7),"Can not update future encounters."
18 . D WAIT^PXCEHELP
19 . K PXCEVIEN
20 I $P(^AUPNVSIT(PXCEVIEN,0),"^",7)="E" D Q -1
21 . W !!,"You can not do the Checkout Interview on an Historical encounter."
22 . D WAIT^PXCEHELP
23 Q PXCEVIEN
24 ;
25INTRVIEW ;Do Interview form Encounter List.
26 ; Allows the adding of new encounters.
27 N PXCEVIEN
28 S PXCEVIEN=$$GETVIEN
29 Q:PXCEVIEN=-1
30 ;
31 N PXCEAPPM,PXCERET,PXCEWHAT
32 S PXCEWHAT="ADDEDIT"
33 I '$D(PXCEPAT) N PXCEPAT S PXCEPAT=""
34 I '$D(PXCEHLOC) N PXCEHLOC S PXCEHLOC=""
35 N PXREC S PXREC=0 ; PX*1.0*172 new logic added to dot structure below
36 I PXCEVIEN>0 D G:PXREC INTRVQ
37 . S PXCEPAT=$P(^AUPNVSIT(PXCEVIEN,0),"^",5)
38 . N PXDUZ,PXPTSSN S PXDUZ=DUZ,PXPTSSN=$P($G(^DPT(PXCEPAT,0)),U,9)
39 . D SEC^PXCEEXP(.PXREC,PXDUZ,PXPTSSN)
40 . I PXREC W !!,"Security regulations prohibit computer access to your own medical record." H 3 Q
41 . S PXCEHLOC=$P(^AUPNVSIT(PXCEVIEN,0),"^",22)
42 . I $$VSTAPPT^PXUTL1(PXCEPAT,+^AUPNVSIT(PXCEVIEN,0),$P(^(0),"^",22),PXCEVIEN) S PXCEAPPM=+^AUPNVSIT(PXCEVIEN,0),PXCEWHAT="INTV"
43 S PXCERET=$$INTV^PXAPI(PXCEWHAT,"PX","PXCE DATA ENTRY",.PXCEVIEN,.PXCEHLOC,.PXCEPAT,$G(PXCEAPPM))
44INTRVQ Q
45 ;
46SDINTRVW(PXCEWHAT) ;Do Interview form Appointment List.
47 N PXCEVIEN
48 N PXCEAPDT S PXCEAPDT=""
49 I '$D(PXCEPAT) N PXCEPAT S PXCEPAT=""
50 I '$D(PXCEHLOC) N PXCEHLOC S PXCEHLOC=""
51 S PXCEVIEN=$$SELAPPM^PXCESDAM
52 Q:PXCEVIEN=-1
53 ; next 3 lines added per PX*1.0*172
54 N PXREC,PXDUZ,PXPTSSN S PXDUZ=DUZ,PXPTSSN=$TR($G(PXCEPAT("SSN")),"-")
55 D SEC^PXCEEXP(.PXREC,PXDUZ,PXPTSSN)
56 I PXREC W !!,"Security regulations prohibit computer access to your own medical record." H 3 G SDINTRVQ
57 I 'PXCEVIEN D
58 . I PXCEWHAT'="INTV",PXCEWHAT'="ADQ" D
59 .. W $C(7),!,"There is no Encounter for this Appointment."
60 .. D WAIT^PXCEHELP
61 .. K PXCEVIEN
62 . E S PXCEVIEN=""
63 I '$D(PXCEVIEN) G SDINTRVQ
64 N PXCERET
65 S PXCERET=$$INTV^PXAPI(PXCEWHAT,"PX","PXCE DATA ENTRY",.PXCEVIEN,.PXCEHLOC,.PXCEPAT,PXCEAPDT)
66SDINTRVQ Q
67 ;
68UPDATENC ;From the Update Encounter Screen
69 I $P(^AUPNVSIT(PXCEVIEN,0),"^",7)="E" D Q
70 . W !!,"You can not do the Checkout Interview on an Historical encounter."
71 . D WAIT^PXCEHELP
72 D FULL^VALM1
73 I $$INTV^PXAPI($S($$VSTAPPT^PXUTL1(PXCEPAT,+^AUPNVSIT(PXCEVIEN,0),+$G(PXCEHLOC),PXCEVIEN):"INTV",1:"ADDEDIT"),"PX","PXCE DATA ENTRY",PXCEVIEN,PXCEHLOC,PXCEPAT)
74 Q
75 ;
Note: See TracBrowser for help on using the repository browser.