| 1 | PXBMPOV ;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 | ;
|
|---|
| 10 | POV(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 | ;
|
|---|
| 24 | PPP ;--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
|
|---|
| 33 | R 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 | ;
|
|---|
| 63 | POVXIT ;----EXIT AND CLEAN UP
|
|---|
| 64 | D WIN17^PXBCC(PXBCNT)
|
|---|
| 65 | ;
|
|---|
| 66 | ;--Send the data to the problem list
|
|---|
| 67 | PL 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 | ;
|
|---|
