- PXBMPRV ;ISL/JVS,ESW - MAIN ROUTINE PROVIDER ; 10/31/02 12:10pm
- ;;1.0;PCE PATIENT CARE ENCOUNTER;**11,108**;Aug 12, 1996
- ;
- W !,"This is not the entry into this routine" Q
- ;
- ; VARABLE LIST
- ;
- ;
- PRV(PXBVST,FROM) ;-----PROVIDER STAND ALONE
- Q:'$D(^AUPNVSIT(PXBVST))
- ;
- ;--Obtain the correct provider
- ;--Set up
- N PXBCNT,I,J,IDATE,PRIP,PRIPOV,PRISEC,QUA,VISIT,PRI,POV,PRV,PXBENT,SAVE
- N PXBUT,FPRI,ENTRY,PXBSAVE,DATA,NAME,PATIENT,VAR,PROMPT,CYCL
- I '$G(PXBPRBLM) N REQI,REQE
- N PXBNCPT,PXBNPRV,PXBNPOV,FIRST,PXBWIN,CLINIC,PXBPMT,LEAVE,%,PXBNPRVL
- N FROM,NOREV
- S (REQI,REQE)=""
- S CLINIC=$P(^AUPNVSIT(PXBVST,0),"^",22)
- S ^TMP("PXBDPRV",$J,"START")=0,FIRST=1,PROMPT="PRV",PXBEXIT=1
- D HDR^PXBUTL(PXBVST,1)
- D REQ^PXBDREQ(5)
- ;
- PP ;--------RECYCLE ENTRY POINT
- D TERM^PXBCC
- D LOC^PXBCC(3,1) W IOEDEOP
- N PXBSKY,PXBKY,PXBSAM,PXBCNT,PRVDR,FPRI ;108
- D PRV^PXBGPRV(PXBVST,.PXBSKY,.PXBKY,.PXBSAM,.PXBCNT,.PRVDR,.FPRI)
- D EN0^PXBDPRV
- R D WIN17^PXBCC(PXBCNT),LOC^PXBCC(15,1)
- K ERROR S FROM="PRV" D LOC^PXBCC(15,1),PRV^PXBPPRV G:$G(PXBEXIT)<1 PRVXIT G:$G(ERROR) R
- W IOEDEOP
- I DATA["^P" D RSET^PXBDREQ("PRV") G PP
- I $G(PXBUT)=1,'$D(FIRST) G PRVXIT
- I $G(PXBUT)=1,$D(LEAVE) G PRVXIT
- K FIRST
- I $G(PXBUT)=1 G PRVXIT
- ;
- ;--Prompt for Primary or Secondary Provider
- D PRI^PXBPPRV1
- I $D(DIRUT) D RSET^PXBDREQ("PRV") G PP
- ;
- ;--Store the DATA
- D EN0^PXBSTOR(PXBVST,PATIENT,REQI)
- ;
- ;--Display the Requested Provider
- D PRINT^PXBDREQ(1)
- ;
- ;--File the data into the V files
- D EN1^PXKMAIN
- ;
- ;--IF called from DIAGNOSIS prompts
- I '$G(PXBPRBLM) D RSET^PXBDREQ("PRV")
- I $G(PXBPRBLM) G PRVXIT
- G PP
- ;
- PRVXIT ;----EXIT AND CLEAN UP
- D PRIM^PXBUTL
- D FULL0^PXBCC
- D CLEAR1^PXBCC
- K PXBKY,PXBSAM,PXBSKY,PXBVST
- ;
- ;----Do the EVENT to the Protocol
- ;D EVENT^PXKMAIN
- K ^TMP("PXBSTOR",$J),^TMP("PXK",$J),^TMP("PXBDPRV",$J)
- K ^TMP("PXBTOTAL",$J),^TMP("PXBTANA",$J)
- Q
- PXBMPRV ;ISL/JVS,ESW - MAIN ROUTINE PROVIDER ; 10/31/02 12:10pm
- +1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**11,108**;Aug 12, 1996
- +2 ;
- +3 WRITE !,"This is not the entry into this routine"
- QUIT
- +4 ;
- +5 ; VARABLE LIST
- +6 ;
- +7 ;
- PRV(PXBVST,FROM) ;-----PROVIDER STAND ALONE
- +1 IF '$DATA(^AUPNVSIT(PXBVST))
- QUIT
- +2 ;
- +3 ;--Obtain the correct provider
- +4 ;--Set up
- +5 NEW PXBCNT,I,J,IDATE,PRIP,PRIPOV,PRISEC,QUA,VISIT,PRI,POV,PRV,PXBENT,SAVE
- +6 NEW PXBUT,FPRI,ENTRY,PXBSAVE,DATA,NAME,PATIENT,VAR,PROMPT,CYCL
- +7 IF '$GET(PXBPRBLM)
- NEW REQI,REQE
- +8 NEW PXBNCPT,PXBNPRV,PXBNPOV,FIRST,PXBWIN,CLINIC,PXBPMT,LEAVE,%,PXBNPRVL
- +9 NEW FROM,NOREV
- +10 SET (REQI,REQE)=""
- +11 SET CLINIC=$PIECE(^AUPNVSIT(PXBVST,0),"^",22)
- +12 SET ^TMP("PXBDPRV",$JOB,"START")=0
- SET FIRST=1
- SET PROMPT="PRV"
- SET PXBEXIT=1
- +13 DO HDR^PXBUTL(PXBVST,1)
- +14 DO REQ^PXBDREQ(5)
- +15 ;
- PP ;--------RECYCLE ENTRY POINT
- +1 DO TERM^PXBCC
- +2 DO LOC^PXBCC(3,1)
- WRITE IOEDEOP
- +3 ;108
- NEW PXBSKY,PXBKY,PXBSAM,PXBCNT,PRVDR,FPRI
- +4 DO PRV^PXBGPRV(PXBVST,.PXBSKY,.PXBKY,.PXBSAM,.PXBCNT,.PRVDR,.FPRI)
- +5 DO EN0^PXBDPRV
- R DO WIN17^PXBCC(PXBCNT)
- DO LOC^PXBCC(15,1)
- +1 KILL ERROR
- SET FROM="PRV"
- DO LOC^PXBCC(15,1)
- DO PRV^PXBPPRV
- IF $GET(PXBEXIT)<1
- GOTO PRVXIT
- IF $GET(ERROR)
- GOTO R
- +2 WRITE IOEDEOP
- +3 IF DATA["^P"
- DO RSET^PXBDREQ("PRV")
- GOTO PP
- +4 IF $GET(PXBUT)=1
- IF '$DATA(FIRST)
- GOTO PRVXIT
- +5 IF $GET(PXBUT)=1
- IF $DATA(LEAVE)
- GOTO PRVXIT
- +6 KILL FIRST
- +7 IF $GET(PXBUT)=1
- GOTO PRVXIT
- +8 ;
- +9 ;--Prompt for Primary or Secondary Provider
- +10 DO PRI^PXBPPRV1
- +11 IF $DATA(DIRUT)
- DO RSET^PXBDREQ("PRV")
- GOTO PP
- +12 ;
- +13 ;--Store the DATA
- +14 DO EN0^PXBSTOR(PXBVST,PATIENT,REQI)
- +15 ;
- +16 ;--Display the Requested Provider
- +17 DO PRINT^PXBDREQ(1)
- +18 ;
- +19 ;--File the data into the V files
- +20 DO EN1^PXKMAIN
- +21 ;
- +22 ;--IF called from DIAGNOSIS prompts
- +23 IF '$GET(PXBPRBLM)
- DO RSET^PXBDREQ("PRV")
- +24 IF $GET(PXBPRBLM)
- GOTO PRVXIT
- +25 GOTO PP
- +26 ;
- PRVXIT ;----EXIT AND CLEAN UP
- +1 DO PRIM^PXBUTL
- +2 DO FULL0^PXBCC
- +3 DO CLEAR1^PXBCC
- +4 KILL PXBKY,PXBSAM,PXBSKY,PXBVST
- +5 ;
- +6 ;----Do the EVENT to the Protocol
- +7 ;D EVENT^PXKMAIN
- +8 KILL ^TMP("PXBSTOR",$JOB),^TMP("PXK",$JOB),^TMP("PXBDPRV",$JOB)
- +9 KILL ^TMP("PXBTOTAL",$JOB),^TMP("PXBTANA",$JOB)
- +10 QUIT
