[613] | 1 | PXBMPRV ;ISL/JVS,ESW - MAIN ROUTINE PROVIDER ; 10/31/02 12:10pm
|
---|
| 2 | ;;1.0;PCE PATIENT CARE ENCOUNTER;**11,108**;Aug 12, 1996
|
---|
| 3 | ;
|
---|
| 4 | W !,"This is not the entry into this routine" Q
|
---|
| 5 | ;
|
---|
| 6 | ; VARABLE LIST
|
---|
| 7 | ;
|
---|
| 8 | ;
|
---|
| 9 | PRV(PXBVST,FROM) ;-----PROVIDER STAND ALONE
|
---|
| 10 | Q:'$D(^AUPNVSIT(PXBVST))
|
---|
| 11 | ;
|
---|
| 12 | ;--Obtain the correct provider
|
---|
| 13 | ;--Set up
|
---|
| 14 | N PXBCNT,I,J,IDATE,PRIP,PRIPOV,PRISEC,QUA,VISIT,PRI,POV,PRV,PXBENT,SAVE
|
---|
| 15 | N PXBUT,FPRI,ENTRY,PXBSAVE,DATA,NAME,PATIENT,VAR,PROMPT,CYCL
|
---|
| 16 | I '$G(PXBPRBLM) N REQI,REQE
|
---|
| 17 | N PXBNCPT,PXBNPRV,PXBNPOV,FIRST,PXBWIN,CLINIC,PXBPMT,LEAVE,%,PXBNPRVL
|
---|
| 18 | N FROM,NOREV
|
---|
| 19 | S (REQI,REQE)=""
|
---|
| 20 | S CLINIC=$P(^AUPNVSIT(PXBVST,0),"^",22)
|
---|
| 21 | S ^TMP("PXBDPRV",$J,"START")=0,FIRST=1,PROMPT="PRV",PXBEXIT=1
|
---|
| 22 | D HDR^PXBUTL(PXBVST,1)
|
---|
| 23 | D REQ^PXBDREQ(5)
|
---|
| 24 | ;
|
---|
| 25 | PP ;--------RECYCLE ENTRY POINT
|
---|
| 26 | D TERM^PXBCC
|
---|
| 27 | D LOC^PXBCC(3,1) W IOEDEOP
|
---|
| 28 | N PXBSKY,PXBKY,PXBSAM,PXBCNT,PRVDR,FPRI ;108
|
---|
| 29 | D PRV^PXBGPRV(PXBVST,.PXBSKY,.PXBKY,.PXBSAM,.PXBCNT,.PRVDR,.FPRI)
|
---|
| 30 | D EN0^PXBDPRV
|
---|
| 31 | R D WIN17^PXBCC(PXBCNT),LOC^PXBCC(15,1)
|
---|
| 32 | K ERROR S FROM="PRV" D LOC^PXBCC(15,1),PRV^PXBPPRV G:$G(PXBEXIT)<1 PRVXIT G:$G(ERROR) R
|
---|
| 33 | W IOEDEOP
|
---|
| 34 | I DATA["^P" D RSET^PXBDREQ("PRV") G PP
|
---|
| 35 | I $G(PXBUT)=1,'$D(FIRST) G PRVXIT
|
---|
| 36 | I $G(PXBUT)=1,$D(LEAVE) G PRVXIT
|
---|
| 37 | K FIRST
|
---|
| 38 | I $G(PXBUT)=1 G PRVXIT
|
---|
| 39 | ;
|
---|
| 40 | ;--Prompt for Primary or Secondary Provider
|
---|
| 41 | D PRI^PXBPPRV1
|
---|
| 42 | I $D(DIRUT) D RSET^PXBDREQ("PRV") G PP
|
---|
| 43 | ;
|
---|
| 44 | ;--Store the DATA
|
---|
| 45 | D EN0^PXBSTOR(PXBVST,PATIENT,REQI)
|
---|
| 46 | ;
|
---|
| 47 | ;--Display the Requested Provider
|
---|
| 48 | D PRINT^PXBDREQ(1)
|
---|
| 49 | ;
|
---|
| 50 | ;--File the data into the V files
|
---|
| 51 | D EN1^PXKMAIN
|
---|
| 52 | ;
|
---|
| 53 | ;--IF called from DIAGNOSIS prompts
|
---|
| 54 | I '$G(PXBPRBLM) D RSET^PXBDREQ("PRV")
|
---|
| 55 | I $G(PXBPRBLM) G PRVXIT
|
---|
| 56 | G PP
|
---|
| 57 | ;
|
---|
| 58 | PRVXIT ;----EXIT AND CLEAN UP
|
---|
| 59 | D PRIM^PXBUTL
|
---|
| 60 | D FULL0^PXBCC
|
---|
| 61 | D CLEAR1^PXBCC
|
---|
| 62 | K PXBKY,PXBSAM,PXBSKY,PXBVST
|
---|
| 63 | ;
|
---|
| 64 | ;----Do the EVENT to the Protocol
|
---|
| 65 | ;D EVENT^PXKMAIN
|
---|
| 66 | K ^TMP("PXBSTOR",$J),^TMP("PXK",$J),^TMP("PXBDPRV",$J)
|
---|
| 67 | K ^TMP("PXBTOTAL",$J),^TMP("PXBTANA",$J)
|
---|
| 68 | Q
|
---|