| 1 | PXBMCPT ;ISL/JVS,ESW - MAIN ROUTINE CPT CODES ; 12/5/02 11:36am
|
|---|
| 2 | ;;1.0;PCE PATIENT CARE ENCOUNTER;**11,108**;Aug 12, 1996
|
|---|
| 3 | ;
|
|---|
| 4 | W !,"This is not the entry into this routine" Q
|
|---|
| 5 | ;
|
|---|
| 6 | ; VARABLE LIST
|
|---|
| 7 | ;
|
|---|
| 8 | ;
|
|---|
| 9 | CPT(PXBVST) ;---Real entry point
|
|---|
| 10 | Q:'$D(^AUPNVSIT(PXBVST))
|
|---|
| 11 | D CPT^PXBMCPT2(PXBVST) Q
|
|---|
| 12 | S TEST=1
|
|---|
| 13 | ; PXBVST = Appointment-Encounter Visit IEN
|
|---|
| 14 | ; PXBDPRV = Default Provider for clinic appointment IEN
|
|---|
| 15 | ;--Set up
|
|---|
| 16 | N PXBCNT,I,J,IDATE,PRIP,PRIPOV,PRISEC,QUA,VISIT,PRI,POV,PRV,PXBENT,SAVE,PXBSKY,PXBKY,PXBSAM,PXBCNT,PRVDR
|
|---|
| 17 | N PXBUT,FPRI,ENTRY,PXBSAVE,NAME,VAR,DOUBLEQQ,CPTQUA,PXBPRV,ERROR
|
|---|
| 18 | N REQI,REQE,DATA,PROMPT,FIRSTCPT,KFIRST,FROM,IDATE,%,CYCL
|
|---|
| 19 | N PXBNCPT,PXBNPRV,PXBNPOV,FIRST,PXBWIN,CLINIC,PXBPMT,LEAVE,PATIENT
|
|---|
| 20 | N FROM,NOREV
|
|---|
| 21 | S (REQE,REQI)=""
|
|---|
| 22 | S CLINIC=$P(^AUPNVSIT(PXBVST,0),"^",22),PROMPT="CPT"
|
|---|
| 23 | ;--KILL OF THE TMP GLOGALS IN ALL PROMPTS
|
|---|
| 24 | S ^TMP("PXBDCPT",$J,"START")=0,FIRST=1,FIRSTCPT=1,PXBEXIT=1
|
|---|
| 25 | ;
|
|---|
| 26 | P ;--Obtain the correct provider
|
|---|
| 27 | I $G(DOUBLEQQ) S FIRST=1
|
|---|
| 28 | D TERM^PXBCC
|
|---|
| 29 | D HDR^PXBUTL(PXBVST,1),REQ^PXBDREQ(4)
|
|---|
| 30 | D PRV^PXBGPRV(PXBVST,.PXBSKY,.PXBKY,.PXBSAM,.PXBCNT,.PRVDR,.FPRI)
|
|---|
| 31 | I $G(TEST)=1 S FROM="CPT" D EN0^PXBDPRV K FROM
|
|---|
| 32 | I $G(TEST)=2 D CPT^PXBGCPT(PXBVST)
|
|---|
| 33 | I $G(TEST)=2 D EN0^PXBDCPT
|
|---|
| 34 | R D WIN17^PXBCC(PXBCNT),LOC^PXBCC(15,1)
|
|---|
| 35 | 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
|
|---|
| 36 | W IOEDEOP
|
|---|
| 37 | I $G(DOUBLEQQ)=1,'$P(REQI,"^",1) G P
|
|---|
| 38 | I DATA["^P" D RSET^PXBDREQ("PRV") G P
|
|---|
| 39 | I $G(PXBUT)=1,'$D(FIRST) G CPTXIT
|
|---|
| 40 | I $G(PXBUT)=1,$D(LEAVE) G CPTXIT
|
|---|
| 41 | K FIRST
|
|---|
| 42 | ;
|
|---|
| 43 | ;--Prompt for Primary or Secondary Provider
|
|---|
| 44 | S PROMPT="CPT^PRV" D PRI^PXBPPRV1 S PROMPT="CPT"
|
|---|
| 45 | I $D(DIRUT) G P
|
|---|
| 46 | ;
|
|---|
| 47 | ;--Display the Requested Provider
|
|---|
| 48 | D PRINT^PXBDREQ(1)
|
|---|
| 49 | D EN0^PXBSTOR(PXBVST,PATIENT,REQI)
|
|---|
| 50 | ;
|
|---|
| 51 | ;--File the Provider data into the V files
|
|---|
| 52 | D EN1^PXKMAIN
|
|---|
| 53 | ;
|
|---|
| 54 | C ;--Display the CPT codes
|
|---|
| 55 | D LOC^PXBCC(3,1) W IOEDEOP
|
|---|
| 56 | D CPT^PXBGCPT(PXBVST)
|
|---|
| 57 | D EN0^PXBDCPT
|
|---|
| 58 | R2 D WIN17^PXBCC(PXBCNT),LOC^PXBCC(15,1)
|
|---|
| 59 | K ERROR D CPT^PXBPCPT G:$G(PXBEXIT)<1 CPTXIT G:$G(ERROR) R2 W IOEDEOP
|
|---|
| 60 | I DATA=""!(DATA["^P") D RSET^PXBDREQ("CPT"),RSET^PXBDREQ("PRV") K DIRUT,PXBUT G P
|
|---|
| 61 | I DATA["^C" D RSET^PXBDREQ("CPT") G C
|
|---|
| 62 | I DATA=""!(DATA["^") D RSET^PXBDREQ("CPT"),RSET^PXBDREQ("PRV") K DIRUT,PXBUT G P
|
|---|
| 63 | ;
|
|---|
| 64 | ;--Display the requested CPT code
|
|---|
| 65 | D PRINT^PXBDREQ(2)
|
|---|
| 66 | ;
|
|---|
| 67 | Q ;--Prompt of the QUANTITY of the CPT code
|
|---|
| 68 | D WIN17^PXBCC(PXBCNT)
|
|---|
| 69 | S PROMPT="CPT^QUA" D QUA^PXBPQUA S PROMPT="CPT"
|
|---|
| 70 | I EDATA["^C" D RSET^PXBDREQ("CPT") G C
|
|---|
| 71 | I EDATA["^P" D RSET^PXBDREQ("CPT"),RSET^PXBDREQ("PRV") K DIRUT,PXBUT G P
|
|---|
| 72 | ;
|
|---|
| 73 | ;--Create The ^TMP("PXK", ARRAY
|
|---|
| 74 | D EN0^PXBSTOR(PXBVST,PATIENT,REQI)
|
|---|
| 75 | ;--File the data into the V files
|
|---|
| 76 | D EN1^PXKMAIN
|
|---|
| 77 | D RSET^PXBDREQ("CPT")
|
|---|
| 78 | G C
|
|---|
| 79 | ;
|
|---|
| 80 | CPTXIT ;----EXIT AND CLEAN UP
|
|---|
| 81 | D KILL^PXBUTL3
|
|---|
| 82 | D PRIM^PXBUTL
|
|---|
| 83 | D FULL0^PXBCC
|
|---|
| 84 | D CLEAR1^PXBCC
|
|---|
| 85 | K PXBKY,PXBSAM,PXBSKY,PXBVST
|
|---|
| 86 | ;
|
|---|
| 87 | ;----Do the EVENT to the Protocol
|
|---|
| 88 | K ^TMP("PXBDCPT",$J),^TMP("PXBSTOR",$J),^TMP("PXK",$J)
|
|---|
| 89 | K ^TMP("PXBTOTAL",$J),^TMP("PXBTANA",$J)
|
|---|
| 90 | Q
|
|---|
| 91 | ;
|
|---|
| 92 | TEST3 ;---THIRD SERERIO FOR PROMPTING FOR CPT'S
|
|---|
| 93 | I $G(DOUBLEQQ) S FIRST=1
|
|---|
| 94 | D TERM^PXBCC
|
|---|
| 95 | D HDR^PXBUTL(PXBVST,1),REQ^PXBDREQ(4)
|
|---|
| 96 | D TEST3C
|
|---|
| 97 | D TEST3Q
|
|---|
| 98 | TEST3C ;--Display the CPT codes
|
|---|
| 99 | D LOC^PXBCC(3,1) W IOEDEOP
|
|---|
| 100 | D CPT^PXBGCPT(PXBVST)
|
|---|
| 101 | D EN0^PXBDCPT
|
|---|
| 102 | R23 D WIN17^PXBCC(PXBCNT),LOC^PXBCC(15,1)
|
|---|
| 103 | K ERROR D CPT^PXBPCPT G:$G(PXBEXIT)<1 CPTXIT G:$G(ERROR) R2 W IOEDEOP
|
|---|
| 104 | I DATA=""!(DATA["^P") D RSET^PXBDREQ("CPT"),RSET^PXBDREQ("PRV") K DIRUT,PXBUT G P
|
|---|
| 105 | I DATA["^C" D RSET^PXBDREQ("CPT") G C
|
|---|
| 106 | I DATA=""!(DATA["^") D RSET^PXBDREQ("CPT"),RSET^PXBDREQ("PRV") K DIRUT,PXBUT G P
|
|---|
| 107 | ;
|
|---|
| 108 | ;--Display the requested CPT code
|
|---|
| 109 | D PRINT^PXBDREQ(2)
|
|---|
| 110 | Q
|
|---|
| 111 | TEST3Q ;--Prompt of the QUANTITY of the CPT code
|
|---|
| 112 | D WIN17^PXBCC(PXBCNT)
|
|---|
| 113 | S PROMPT="CPT^QUA" D QUA^PXBPQUA S PROMPT="CPT"
|
|---|
| 114 | I EDATA["^C" D RSET^PXBDREQ("CPT") G C
|
|---|
| 115 | I EDATA["^P" D RSET^PXBDREQ("CPT"),RSET^PXBDREQ("PRV") K DIRUT,PXBUT G P
|
|---|
| 116 | ;
|
|---|
| 117 | ;--Create The ^TMP("PXK", ARRAY
|
|---|
| 118 | D EN0^PXBSTOR(PXBVST,PATIENT,REQI)
|
|---|
| 119 | ;--File the data into the V files
|
|---|
| 120 | D EN1^PXKMAIN
|
|---|
| 121 | D RSET^PXBDREQ("CPT")
|
|---|
| 122 | G C
|
|---|
| 123 | Q
|
|---|
