PXBMPOV ;ISL/JVS,ESW - MAIN ROUTINE DIAGNOSIS ;3/5/04 1:50pm
;;1.0;PCE PATIENT CARE ENCOUNTER;**11,14,108,124,174**;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
D ORD^PXBPPOV1
N PXCEVIEN,PXCEAFTR,PXD
S PXCEVIEN=PXBVST,PXD=$P(REQI,U,5)
D FULL0^PXBCC,GET800^PXCEC800 ;CI's PX*1.0*174
S PXBREQ(PXD,"I")=$G(PXCEAFTR(800))
;
;--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,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
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXBMPOV 2507 printed Nov 22, 2024@17:37:01 Page 2
PXBMPOV ;ISL/JVS,ESW - MAIN ROUTINE DIAGNOSIS ;3/5/04 1:50pm
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**11,14,108,124,174**;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 DO ORD^PXBPPOV1
+11 NEW PXCEVIEN,PXCEAFTR,PXD
+12 SET PXCEVIEN=PXBVST
SET PXD=$PIECE(REQI,U,5)
+13 ;CI's PX*1.0*174
DO FULL0^PXBCC
DO GET800^PXCEC800
+14 SET PXBREQ(PXD,"I")=$GET(PXCEAFTR(800))
+15 ;
+16 ;--Display the Requested Diagnosis
+17 DO PRINT^PXBDREQ(4)
DO EN0^PXBSTOR(PXBVST,PATIENT,REQI)
DO EN1^PXKMAIN
+18 ;
+19 ;--Request entry to problem list
+20 IF $DATA(DIRUT)!('$GET(PXBPRBLM))
KILL DIRUT,PXBPRBLM
DO EN0^PXBSTOR(PXBVST,PATIENT,REQI)
DO EN1^PXKMAIN
DO RSET^PXBDREQ("POV")
GOTO PPP
+21 ;
+22 ;--Request the Associated Provider
+23 ;---I NOT PROVIDER GO PPP
+24 ;
+25 ;--RETURN TO THE BEGINNING
+26 DO RSET^PXBDREQ("POV")
DO RSET^PXBDREQ("PRV")
+27 GOTO PPP
+28 QUIT
+29 ;
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 ;
