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

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

initial load of WorldVistAEHR

File size: 2.4 KB
Line 
1PXBMPOV ;ISL/JVS,ESW - MAIN ROUTINE DIAGNOSIS ;3/5/04 1:50pm
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**11,14,108,124,174**;Aug 12, 1996
3 ;
4 W !,"This is not the entry into this routine" Q
5 ;
6 ; VARABLE LIST
7 ;
8 ;
9 ;
10POV(PXBVST) ;---Real entry point
11 Q:'$D(^AUPNVSIT(PXBVST))
12 ; PXBVST = Appointment-Encounter Visit IEN
13 ; PXBDPRV = Default Provider for clinic appointment IEN
14 ;--Set up
15 N PXBCNT,I,J,IDATE,PRIP,PRIPOV,PRISEC,QUA,VISIT,PRI,POV,PRV,PXBENT,SAVE
16 N PXBUT,FPRI,ENTRY,PXBSAVE,DATA,PXBPRBLM,PXBRES,PXBSPL,NAME,PATIENT
17 N REQI,REQE,PROMPT,PROVIDER,PXDIGNS,CYCL,PXBNPOVL,FROM,NOREV,NOPLLIST
18 N PXBNCPT,PXBNPRV,PXBNPOV,FIRST,PXBWIN,CLINIC,PXBPMT,LEAVE,VAR,%
19 K ^TMP("PXBGPOVMATCH",$J)
20 S CLINIC=$P(^AUPNVSIT(PXBVST,0),"^",22),PROMPT="POV",FIRST=1,PXBEXIT=1
21 S (REQE,REQI)=""
22 S ^TMP("PXBDPOV",$J,"START")=0
23 ;
24PPP ;--Obtain the POV (DIAGNOSIS)
25 N PXBSKY,PXBKY,PXBSAM,PXBCNT,PRVDR,FPRI
26 D PRV^PXBGPRV(PXBVST,.PXBSKY,.PXBKY,.PXBSAM,.PXBCNT,.PRVDR,.FPRI)
27 K PXBSPL
28 D TERM^PXBCC
29 D HDR^PXBUTL(PXBVST,1)
30 D REQ^PXBDREQ(6)
31 N LNARR D POV^PXBGPOV(PXBVST)
32 D EN0^PXBDPOV
33R D WIN17^PXBCC(PXBCNT),LOC^PXBCC(15,1)
34 K ERROR D POV^PXBPPOV G:$G(PXBEXIT)<1 POVXIT G:$G(ERROR) R W IOEDEOP
35 K FIRST
36 I DATA["^P" D RSET^PXBDREQ("POV") G PPP
37 I $G(PXBUT)=1,$D(LEAVE) G POVXIT
38 ;
39 ;--Prompt for Primary or Secondary DIAGNOSIS
40 D WIN17^PXBCC(PXBCNT)
41 D PRI^PXBPPOV1
42 I $D(DIRUT) D RSET^PXBDREQ("POV") G PPP
43 D ORD^PXBPPOV1
44 N PXCEVIEN,PXCEAFTR,PXD
45 S PXCEVIEN=PXBVST,PXD=$P(REQI,U,5)
46 D FULL0^PXBCC,GET800^PXCEC800 ;CI's PX*1.0*174
47 S PXBREQ(PXD,"I")=$G(PXCEAFTR(800))
48 ;
49 ;--Display the Requested Diagnosis
50 D PRINT^PXBDREQ(4),EN0^PXBSTOR(PXBVST,PATIENT,REQI),EN1^PXKMAIN
51 ;
52 ;--Request entry to problem list
53 I $D(DIRUT)!('$G(PXBPRBLM)) K DIRUT,PXBPRBLM D EN0^PXBSTOR(PXBVST,PATIENT,REQI),EN1^PXKMAIN,RSET^PXBDREQ("POV") G PPP
54 ;
55 ;--Request the Associated Provider
56 ;---I NOT PROVIDER GO PPP
57 ;
58 ;--RETURN TO THE BEGINNING
59 D RSET^PXBDREQ("POV"),RSET^PXBDREQ("PRV")
60 G PPP
61 Q
62 ;
63POVXIT ;----EXIT AND CLEAN UP
64 D WIN17^PXBCC(PXBCNT)
65 ;
66 ;--Send the data to the problem list
67PL I '$G(PXBEXIT)<1 D
68 .I '$G(PXBPRBON) Q
69 .I PXBCNT>0 N LNARR D SET^PXBPL
70 D PRIM^PXBUTL
71 ;D PRIMD^PXBUTL
72 D FULL0^PXBCC
73 D CLEAR1^PXBCC
74 K PXBKY,PXBSAM,PXBSKY,PXBVST
75 ;----Do the EVENT to the Protocol
76 ;D EVENT^PXKMAIN
77 K ^TMP("PXBDPOV",$J),^TMP("PXBSTOR",$J),^TMP("PXK",$J),^TMP("PXBDPL",$J)
78 K ^TMP("PXBTOTAL",$J),^TMP("PXBTANA",$J),^TMP("PXBGPOVMATCH",$J)
79 Q
80 ;
Note: See TracBrowser for help on using the repository browser.