- 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 ;
