PXBMPOV.m

PXBMPOV ;ISL/JVS,ESW - MAIN ROUTINE DIAGNOSIS ; 12/5/02 11:39am

 ;;1.0;PCE PATIENT CARE ENCOUNTER;**11,14,108**;Aug 12, 1996

 ;

 W !,"This is not the entry into this routine" Q

 ;

 ;  VARABLE LIST

 ;

 ;

 ;

POV(PXBVST) ;---Real entry point

 Q:'$D(^AUPNVSIT(PXBVST))

 ; PXBVST  = Appointment-Encounter Visit IEN

 ; PXBDPRV = Default Provider for clinic appointment IEN

 ;--Set up

 N PXBCNT,I,J,IDATE,PRIP,PRIPOV,PRISEC,QUA,VISIT,PRI,POV,PRV,PXBENT,SAVE

 N PXBUT,FPRI,ENTRY,PXBSAVE,DATA,PXBPRBLM,PXBRES,PXBSPL,NAME,PATIENT

 N REQI,REQE,PROMPT,PROVIDER,PXDIGNS,CYCL,PXBNPOVL,FROM,NOREV,NOPLLIST

 N PXBNCPT,PXBNPRV,PXBNPOV,FIRST,PXBWIN,CLINIC,PXBPMT,LEAVE,VAR,%

 K ^TMP("PXBGPOVMATCH",$J)

 S CLINIC=$P(^AUPNVSIT(PXBVST,0),"^",22),PROMPT="POV",FIRST=1,PXBEXIT=1

 S (REQE,REQI)=""

 S ^TMP("PXBDPOV",$J,"START")=0

 ;

PPP ;--Obtain the POV (DIAGNOSIS)

 N PXBSKY,PXBKY,PXBSAM,PXBCNT,PRVDR,FPRI

 D PRV^PXBGPRV(PXBVST,.PXBSKY,.PXBKY,.PXBSAM,.PXBCNT,.PRVDR,.FPRI)

 K PXBSPL

 D TERM^PXBCC

 D HDR^PXBUTL(PXBVST,1)

 D REQ^PXBDREQ(6)

 N LNARR D POV^PXBGPOV(PXBVST)

 D EN0^PXBDPOV

R D WIN17^PXBCC(PXBCNT),LOC^PXBCC(15,1)

 K ERROR D POV^PXBPPOV G:$G(PXBEXIT)<1 POVXIT G:$G(ERROR) R W IOEDEOP

 K FIRST

 I DATA["^P" D RSET^PXBDREQ("POV") G PPP

 I $G(PXBUT)=1,$D(LEAVE) G POVXIT

 ;

 ;--Prompt for Primary or Secondary DIAGNOSIS

 D WIN17^PXBCC(PXBCNT)

 D PRI^PXBPPOV1

 I $D(DIRUT) D RSET^PXBDREQ("POV") G PPP

 ;

 ;--Display the Requested Diagnosis

 D PRINT^PXBDREQ(4),EN0^PXBSTOR(PXBVST,PATIENT,REQI),EN1^PXKMAIN

 ;

 ;--Request entry to problem list

 I $D(DIRUT)!('$G(PXBPRBLM)) K DIRUT,PXBPRBLM D EN0^PXBSTOR(PXBVST,PATIENT,REQI),EN1^PXKMAIN D RSET^PXBDREQ("POV") G PPP

 ;

 ;--Request the Associated Provider

 ;---I NOT PROVIDER GO PPP

 ;

 ;--RETURN TO THE BEGINNING

 D RSET^PXBDREQ("POV"),RSET^PXBDREQ("PRV")

 G PPP

 Q

 ;

POVXIT ;----EXIT AND CLEAN UP

 D WIN17^PXBCC(PXBCNT)

 ;

 ;--Send the data to the problem list

PL I '$G(PXBEXIT)<1 D

 .I '$G(PXBPRBON) Q

 .I PXBCNT>0 N LNARR D SET^PXBPL

 D PRIM^PXBUTL

 ;D PRIMD^PXBUTL

 D FULL0^PXBCC

 D CLEAR1^PXBCC

 K PXBKY,PXBSAM,PXBSKY,PXBVST

 ;----Do the EVENT to the Protocol

 ;D EVENT^PXKMAIN

 K ^TMP("PXBDPOV",$J),^TMP("PXBSTOR",$J),^TMP("PXK",$J),^TMP("PXBDPL",$J)

 K ^TMP("PXBTOTAL",$J),^TMP("PXBTANA",$J),^TMP("PXBGPOVMATCH",$J)

 Q

 ;

PXBMPOV   ;ISL/JVS,ESW - MAIN ROUTINE DIAGNOSIS ; 12/5/02 11:39am

 +1       ;;1.0;PCE PATIENT CARE ENCOUNTER;**11,14,108**;Aug 12, 1996

 +2       ;

 +3        WRITE !,"This is not the entry into this routine"

           QUIT 

 +4       ;

 +5       ;  VARABLE LIST

 +6       ;

 +7       ;

 +8       ;

POV(PXBVST) ;---Real entry point

 +1        IF '$DATA(^AUPNVSIT(PXBVST))

               QUIT 

 +2       ; PXBVST  = Appointment-Encounter Visit IEN

 +3       ; PXBDPRV = Default Provider for clinic appointment IEN

 +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,PXBPRBLM,PXBRES,PXBSPL,NAME,PATIENT

 +7        NEW REQI,REQE,PROMPT,PROVIDER,PXDIGNS,CYCL,PXBNPOVL,FROM,NOREV,NOPLLIST

 +8        NEW PXBNCPT,PXBNPRV,PXBNPOV,FIRST,PXBWIN,CLINIC,PXBPMT,LEAVE,VAR,%

 +9        KILL ^TMP("PXBGPOVMATCH",$JOB)

 +10       SET CLINIC=$PIECE(^AUPNVSIT(PXBVST,0),"^",22)

           SET PROMPT="POV"

           SET FIRST=1

           SET PXBEXIT=1

 +11       SET (REQE,REQI)=""

 +12       SET ^TMP("PXBDPOV",$JOB,"START")=0

 +13      ;

PPP       ;--Obtain the POV (DIAGNOSIS)

 +1        NEW PXBSKY,PXBKY,PXBSAM,PXBCNT,PRVDR,FPRI

 +2        DO PRV^PXBGPRV(PXBVST,.PXBSKY,.PXBKY,.PXBSAM,.PXBCNT,.PRVDR,.FPRI)

 +3        KILL PXBSPL

 +4        DO TERM^PXBCC

 +5        DO HDR^PXBUTL(PXBVST,1)

 +6        DO REQ^PXBDREQ(6)

 +7        NEW LNARR

           DO POV^PXBGPOV(PXBVST)

 +8        DO EN0^PXBDPOV

R          DO WIN17^PXBCC(PXBCNT)

           DO LOC^PXBCC(15,1)

 +1        KILL ERROR

           DO POV^PXBPPOV

           IF $GET(PXBEXIT)<1

               GOTO POVXIT

           IF $GET(ERROR)

               GOTO R

           WRITE IOEDEOP

 +2        KILL FIRST

 +3        IF DATA["^P"

               DO RSET^PXBDREQ("POV")

               GOTO PPP

 +4        IF $GET(PXBUT)=1

               IF $DATA(LEAVE)

                   GOTO POVXIT

 +5       ;

 +6       ;--Prompt for Primary or Secondary DIAGNOSIS

 +7        DO WIN17^PXBCC(PXBCNT)

 +8        DO PRI^PXBPPOV1

 +9        IF $DATA(DIRUT)

               DO RSET^PXBDREQ("POV")

               GOTO PPP

 +10      ;

 +11      ;--Display the Requested Diagnosis

 +12       DO PRINT^PXBDREQ(4)

           DO EN0^PXBSTOR(PXBVST,PATIENT,REQI)

           DO EN1^PXKMAIN

 +13      ;

 +14      ;--Request entry to problem list

 +15       IF $DATA(DIRUT)!('$GET(PXBPRBLM))

               KILL DIRUT,PXBPRBLM

               DO EN0^PXBSTOR(PXBVST,PATIENT,REQI)

               DO EN1^PXKMAIN

               DO RSET^PXBDREQ("POV")

               GOTO PPP

 +16      ;

 +17      ;--Request the Associated Provider

 +18      ;---I NOT PROVIDER GO PPP

 +19      ;

 +20      ;--RETURN TO THE BEGINNING

 +21       DO RSET^PXBDREQ("POV")

           DO RSET^PXBDREQ("PRV")

 +22       GOTO PPP

 +23       QUIT 

 +24      ;

POVXIT    ;----EXIT AND CLEAN UP

 +1        DO WIN17^PXBCC(PXBCNT)

 +2       ;

 +3       ;--Send the data to the problem list

PL         IF '$GET(PXBEXIT)<1

               Begin DoDot:1

 +1                IF '$GET(PXBPRBON)

                       QUIT 

 +2                IF PXBCNT>0

                       NEW LNARR

                       DO SET^PXBPL

               End DoDot:1

 +3        DO PRIM^PXBUTL

 +4       ;D PRIMD^PXBUTL

 +5        DO FULL0^PXBCC

 +6        DO CLEAR1^PXBCC

 +7        KILL PXBKY,PXBSAM,PXBSKY,PXBVST

 +8       ;----Do the EVENT to the Protocol

 +9       ;D EVENT^PXKMAIN

 +10       KILL ^TMP("PXBDPOV",$JOB),^TMP("PXBSTOR",$JOB),^TMP("PXK",$JOB),^TMP("PXBDPL",$JOB)

 +11       KILL ^TMP("PXBTOTAL",$JOB),^TMP("PXBTANA",$JOB),^TMP("PXBGPOVMATCH",$JOB)

 +12       QUIT 

 +13      ;