PXBMCPT.m

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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PXBMCPT   4025     printed  Feb 18, 2025@23:53:16                                                                                                                                                                                                     Page 2

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