PXBMCPT ;ISL/JVS,ESW - MAIN ROUTINE CPT CODES ; 12/5/02 11:36am
;;1.0;PCE PATIENT CARE ENCOUNTER;**11,108**;Aug 12, 1996
;
W !,"This is not the entry into this routine" Q
;
; VARABLE LIST
;
;
CPT(PXBVST) ;---Real entry point
Q:'$D(^AUPNVSIT(PXBVST))
D CPT^PXBMCPT2(PXBVST) Q
S TEST=1
; 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,PXBSKY,PXBKY,PXBSAM,PXBCNT,PRVDR
N PXBUT,FPRI,ENTRY,PXBSAVE,NAME,VAR,DOUBLEQQ,CPTQUA,PXBPRV,ERROR
N REQI,REQE,DATA,PROMPT,FIRSTCPT,KFIRST,FROM,IDATE,%,CYCL
N PXBNCPT,PXBNPRV,PXBNPOV,FIRST,PXBWIN,CLINIC,PXBPMT,LEAVE,PATIENT
N FROM,NOREV
S (REQE,REQI)=""
S CLINIC=$P(^AUPNVSIT(PXBVST,0),"^",22),PROMPT="CPT"
;--KILL OF THE TMP GLOGALS IN ALL PROMPTS
S ^TMP("PXBDCPT",$J,"START")=0,FIRST=1,FIRSTCPT=1,PXBEXIT=1
;
P ;--Obtain the correct provider
I $G(DOUBLEQQ) S FIRST=1
D TERM^PXBCC
D HDR^PXBUTL(PXBVST,1),REQ^PXBDREQ(4)
D PRV^PXBGPRV(PXBVST,.PXBSKY,.PXBKY,.PXBSAM,.PXBCNT,.PRVDR,.FPRI)
I $G(TEST)=1 S FROM="CPT" D EN0^PXBDPRV K FROM
I $G(TEST)=2 D CPT^PXBGCPT(PXBVST)
I $G(TEST)=2 D EN0^PXBDCPT
R D WIN17^PXBCC(PXBCNT),LOC^PXBCC(15,1)
K ERROR S FROM="CPT" D PRV^PXBPPRV W:$D(CYCL) IOSC K FROM G:$G(PXBEXIT)<1 CPTXIT G:$G(ERROR) R K CYCL
W IOEDEOP
I $G(DOUBLEQQ)=1,'$P(REQI,"^",1) G P
I DATA["^P" D RSET^PXBDREQ("PRV") G P
I $G(PXBUT)=1,'$D(FIRST) G CPTXIT
I $G(PXBUT)=1,$D(LEAVE) G CPTXIT
K FIRST
;
;--Prompt for Primary or Secondary Provider
S PROMPT="CPT^PRV" D PRI^PXBPPRV1 S PROMPT="CPT"
I $D(DIRUT) G P
;
;--Display the Requested Provider
D PRINT^PXBDREQ(1)
D EN0^PXBSTOR(PXBVST,PATIENT,REQI)
;
;--File the Provider data into the V files
D EN1^PXKMAIN
;
C ;--Display the CPT codes
D LOC^PXBCC(3,1) W IOEDEOP
D CPT^PXBGCPT(PXBVST)
D EN0^PXBDCPT
R2 D WIN17^PXBCC(PXBCNT),LOC^PXBCC(15,1)
K ERROR D CPT^PXBPCPT G:$G(PXBEXIT)<1 CPTXIT G:$G(ERROR) R2 W IOEDEOP
I DATA=""!(DATA["^P") D RSET^PXBDREQ("CPT"),RSET^PXBDREQ("PRV") K DIRUT,PXBUT G P
I DATA["^C" D RSET^PXBDREQ("CPT") G C
I DATA=""!(DATA["^") D RSET^PXBDREQ("CPT"),RSET^PXBDREQ("PRV") K DIRUT,PXBUT G P
;
;--Display the requested CPT code
D PRINT^PXBDREQ(2)
;
Q ;--Prompt of the QUANTITY of the CPT code
D WIN17^PXBCC(PXBCNT)
S PROMPT="CPT^QUA" D QUA^PXBPQUA S PROMPT="CPT"
I EDATA["^C" D RSET^PXBDREQ("CPT") G C
I EDATA["^P" D RSET^PXBDREQ("CPT"),RSET^PXBDREQ("PRV") K DIRUT,PXBUT G P
;
;--Create The ^TMP("PXK", ARRAY
D EN0^PXBSTOR(PXBVST,PATIENT,REQI)
;--File the data into the V files
D EN1^PXKMAIN
D RSET^PXBDREQ("CPT")
G C
;
CPTXIT ;----EXIT AND CLEAN UP
D KILL^PXBUTL3
D PRIM^PXBUTL
D FULL0^PXBCC
D CLEAR1^PXBCC
K PXBKY,PXBSAM,PXBSKY,PXBVST
;
;----Do the EVENT to the Protocol
K ^TMP("PXBDCPT",$J),^TMP("PXBSTOR",$J),^TMP("PXK",$J)
K ^TMP("PXBTOTAL",$J),^TMP("PXBTANA",$J)
Q
;
TEST3 ;---THIRD SERERIO FOR PROMPTING FOR CPT'S
I $G(DOUBLEQQ) S FIRST=1
D TERM^PXBCC
D HDR^PXBUTL(PXBVST,1),REQ^PXBDREQ(4)
D TEST3C
D TEST3Q
TEST3C ;--Display the CPT codes
D LOC^PXBCC(3,1) W IOEDEOP
D CPT^PXBGCPT(PXBVST)
D EN0^PXBDCPT
R23 D WIN17^PXBCC(PXBCNT),LOC^PXBCC(15,1)
K ERROR D CPT^PXBPCPT G:$G(PXBEXIT)<1 CPTXIT G:$G(ERROR) R2 W IOEDEOP
I DATA=""!(DATA["^P") D RSET^PXBDREQ("CPT"),RSET^PXBDREQ("PRV") K DIRUT,PXBUT G P
I DATA["^C" D RSET^PXBDREQ("CPT") G C
I DATA=""!(DATA["^") D RSET^PXBDREQ("CPT"),RSET^PXBDREQ("PRV") K DIRUT,PXBUT G P
;
;--Display the requested CPT code
D PRINT^PXBDREQ(2)
Q
TEST3Q ;--Prompt of the QUANTITY of the CPT code
D WIN17^PXBCC(PXBCNT)
S PROMPT="CPT^QUA" D QUA^PXBPQUA S PROMPT="CPT"
I EDATA["^C" D RSET^PXBDREQ("CPT") G C
I EDATA["^P" D RSET^PXBDREQ("CPT"),RSET^PXBDREQ("PRV") K DIRUT,PXBUT G P
;
;--Create The ^TMP("PXK", ARRAY
D EN0^PXBSTOR(PXBVST,PATIENT,REQI)
;--File the data into the V files
D EN1^PXKMAIN
D RSET^PXBDREQ("CPT")
G C
Q
PXBMCPT ;ISL/JVS,ESW - MAIN ROUTINE CPT CODES ; 12/5/02 11:36am
+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 ;
CPT(PXBVST) ;---Real entry point
+1 IF '$DATA(^AUPNVSIT(PXBVST))
QUIT
+2 DO CPT^PXBMCPT2(PXBVST)
QUIT
+3 SET TEST=1
+4 ; PXBVST = Appointment-Encounter Visit IEN
+5 ; PXBDPRV = Default Provider for clinic appointment IEN
+6 ;--Set up
+7 NEW PXBCNT,I,J,IDATE,PRIP,PRIPOV,PRISEC,QUA,VISIT,PRI,POV,PRV,PXBENT,SAVE,PXBSKY,PXBKY,PXBSAM,PXBCNT,PRVDR
+8 NEW PXBUT,FPRI,ENTRY,PXBSAVE,NAME,VAR,DOUBLEQQ,CPTQUA,PXBPRV,ERROR
+9 NEW REQI,REQE,DATA,PROMPT,FIRSTCPT,KFIRST,FROM,IDATE,%,CYCL
+10 NEW PXBNCPT,PXBNPRV,PXBNPOV,FIRST,PXBWIN,CLINIC,PXBPMT,LEAVE,PATIENT
+11 NEW FROM,NOREV
+12 SET (REQE,REQI)=""
+13 SET CLINIC=$PIECE(^AUPNVSIT(PXBVST,0),"^",22)
SET PROMPT="CPT"
+14 ;--KILL OF THE TMP GLOGALS IN ALL PROMPTS
+15 SET ^TMP("PXBDCPT",$JOB,"START")=0
SET FIRST=1
SET FIRSTCPT=1
SET PXBEXIT=1
+16 ;
P ;--Obtain the correct provider
+1 IF $GET(DOUBLEQQ)
SET FIRST=1
+2 DO TERM^PXBCC
+3 DO HDR^PXBUTL(PXBVST,1)
DO REQ^PXBDREQ(4)
+4 DO PRV^PXBGPRV(PXBVST,.PXBSKY,.PXBKY,.PXBSAM,.PXBCNT,.PRVDR,.FPRI)
+5 IF $GET(TEST)=1
SET FROM="CPT"
DO EN0^PXBDPRV
KILL FROM
+6 IF $GET(TEST)=2
DO CPT^PXBGCPT(PXBVST)
+7 IF $GET(TEST)=2
DO EN0^PXBDCPT
R DO WIN17^PXBCC(PXBCNT)
DO LOC^PXBCC(15,1)
+1 KILL ERROR
SET FROM="CPT"
DO PRV^PXBPPRV
IF $DATA(CYCL)
WRITE IOSC
KILL FROM
IF $GET(PXBEXIT)<1
GOTO CPTXIT
IF $GET(ERROR)
GOTO R
KILL CYCL
+2 WRITE IOEDEOP
+3 IF $GET(DOUBLEQQ)=1
IF '$PIECE(REQI,"^",1)
GOTO P
+4 IF DATA["^P"
DO RSET^PXBDREQ("PRV")
GOTO P
+5 IF $GET(PXBUT)=1
IF '$DATA(FIRST)
GOTO CPTXIT
+6 IF $GET(PXBUT)=1
IF $DATA(LEAVE)
GOTO CPTXIT
+7 KILL FIRST
+8 ;
+9 ;--Prompt for Primary or Secondary Provider
+10 SET PROMPT="CPT^PRV"
DO PRI^PXBPPRV1
SET PROMPT="CPT"
+11 IF $DATA(DIRUT)
GOTO P
+12 ;
+13 ;--Display the Requested Provider
+14 DO PRINT^PXBDREQ(1)
+15 DO EN0^PXBSTOR(PXBVST,PATIENT,REQI)
+16 ;
+17 ;--File the Provider data into the V files
+18 DO EN1^PXKMAIN
+19 ;
C ;--Display the CPT codes
+1 DO LOC^PXBCC(3,1)
WRITE IOEDEOP
+2 DO CPT^PXBGCPT(PXBVST)
+3 DO EN0^PXBDCPT
R2 DO WIN17^PXBCC(PXBCNT)
DO LOC^PXBCC(15,1)
+1 KILL ERROR
DO CPT^PXBPCPT
IF $GET(PXBEXIT)<1
GOTO CPTXIT
IF $GET(ERROR)
GOTO R2
WRITE IOEDEOP
+2 IF DATA=""!(DATA["^P")
DO RSET^PXBDREQ("CPT")
DO RSET^PXBDREQ("PRV")
KILL DIRUT,PXBUT
GOTO P
+3 IF DATA["^C"
DO RSET^PXBDREQ("CPT")
GOTO C
+4 IF DATA=""!(DATA["^")
DO RSET^PXBDREQ("CPT")
DO RSET^PXBDREQ("PRV")
KILL DIRUT,PXBUT
GOTO P
+5 ;
+6 ;--Display the requested CPT code
+7 DO PRINT^PXBDREQ(2)
+8 ;
Q ;--Prompt of the QUANTITY of the CPT code
+1 DO WIN17^PXBCC(PXBCNT)
+2 SET PROMPT="CPT^QUA"
DO QUA^PXBPQUA
SET PROMPT="CPT"
+3 IF EDATA["^C"
DO RSET^PXBDREQ("CPT")
GOTO C
+4 IF EDATA["^P"
DO RSET^PXBDREQ("CPT")
DO RSET^PXBDREQ("PRV")
KILL DIRUT,PXBUT
GOTO P
+5 ;
+6 ;--Create The ^TMP("PXK", ARRAY
+7 DO EN0^PXBSTOR(PXBVST,PATIENT,REQI)
+8 ;--File the data into the V files
+9 DO EN1^PXKMAIN
+10 DO RSET^PXBDREQ("CPT")
+11 GOTO C
+12 ;
CPTXIT ;----EXIT AND CLEAN UP
+1 DO KILL^PXBUTL3
+2 DO PRIM^PXBUTL
+3 DO FULL0^PXBCC
+4 DO CLEAR1^PXBCC
+5 KILL PXBKY,PXBSAM,PXBSKY,PXBVST
+6 ;
+7 ;----Do the EVENT to the Protocol
+8 KILL ^TMP("PXBDCPT",$JOB),^TMP("PXBSTOR",$JOB),^TMP("PXK",$JOB)
+9 KILL ^TMP("PXBTOTAL",$JOB),^TMP("PXBTANA",$JOB)
+10 QUIT
+11 ;
TEST3 ;---THIRD SERERIO FOR PROMPTING FOR CPT'S
+1 IF $GET(DOUBLEQQ)
SET FIRST=1
+2 DO TERM^PXBCC
+3 DO HDR^PXBUTL(PXBVST,1)
DO REQ^PXBDREQ(4)
+4 DO TEST3C
+5 DO TEST3Q
TEST3C ;--Display the CPT codes
+1 DO LOC^PXBCC(3,1)
WRITE IOEDEOP
+2 DO CPT^PXBGCPT(PXBVST)
+3 DO EN0^PXBDCPT
R23 DO WIN17^PXBCC(PXBCNT)
DO LOC^PXBCC(15,1)
+1 KILL ERROR
DO CPT^PXBPCPT
IF $GET(PXBEXIT)<1
GOTO CPTXIT
IF $GET(ERROR)
GOTO R2
WRITE IOEDEOP
+2 IF DATA=""!(DATA["^P")
DO RSET^PXBDREQ("CPT")
DO RSET^PXBDREQ("PRV")
KILL DIRUT,PXBUT
GOTO P
+3 IF DATA["^C"
DO RSET^PXBDREQ("CPT")
GOTO C
+4 IF DATA=""!(DATA["^")
DO RSET^PXBDREQ("CPT")
DO RSET^PXBDREQ("PRV")
KILL DIRUT,PXBUT
GOTO P
+5 ;
+6 ;--Display the requested CPT code
+7 DO PRINT^PXBDREQ(2)
+8 QUIT
TEST3Q ;--Prompt of the QUANTITY of the CPT code
+1 DO WIN17^PXBCC(PXBCNT)
+2 SET PROMPT="CPT^QUA"
DO QUA^PXBPQUA
SET PROMPT="CPT"
+3 IF EDATA["^C"
DO RSET^PXBDREQ("CPT")
GOTO C
+4 IF EDATA["^P"
DO RSET^PXBDREQ("CPT")
DO RSET^PXBDREQ("PRV")
KILL DIRUT,PXBUT
GOTO P
+5 ;
+6 ;--Create The ^TMP("PXK", ARRAY
+7 DO EN0^PXBSTOR(PXBVST,PATIENT,REQI)
+8 ;--File the data into the V files
+9 DO EN1^PXKMAIN
+10 DO RSET^PXBDREQ("CPT")
+11 GOTO C
+12 QUIT
