PXBMPRV.m

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