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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXBMPRV 1933 printed Apr 09, 2024@21:28:37 Page 2
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
