PXBDREQ ;ISL/JVS - DISPLAY REQUESTS ;6/17/03 10:29
;;1.0;PCE PATIENT CARE ENCOUNTER;**73,124,199**;Aug 12, 1996;Build 51
;
; Variable list
; These two variables represent the data that has been selected
; to be saved in the v files by the user
;
; REQ*=PROVIDER^PRIMARY^CPT^QUANTITY^POV^PRIMARY
; REQI=Internal Values
; REQE=External Values
;
REQ(NO) ;--Display the REQUESTED Data
N ENTRY,VAR
S VAR="N"_NO D @VAR
Q
N4 ;---Fourth Method--for the CPT prompts
W !,"PROVIDER: ...Enter the provider associated with the CPT'S....."
D UNDON^PXBCC
W !,?5,"CPT: "
F W $C(32) Q:$X=(IOM-(4))
W !
D UNDOFF^PXBCC
Q
N5 ;---Fifth Method--for the PROVIDER prompts
W !,"PROVIDER: ...Select a Provider....."
D UNDON^PXBCC
W !
F W $C(32) Q:$X=(IOM-(4))
W !
D UNDOFF^PXBCC
Q
;
N6 ;---Sixth Method--for the POV(DIAGNOSIS) prompts
W !,"ICD CODE: ...Select a DIAGNOSIS Code....."
D UNDON^PXBCC
W !
F W $C(32) Q:$X=(IOM-(4))
W !
D UNDOFF^PXBCC
Q
N7 ;---SEVENTH Method--for the STOP CODES prompts
W !,"STOP CODE: ...Select an AMIS STOP Code....."
D UNDON^PXBCC
W !
F W $C(32) Q:$X=(IOM-(4))
W !
D UNDOFF^PXBCC
Q
N8 ;---EIGHTH Method--for the ENCOUNTERS prompts
W !,"ENCOUNTERS: ...Select an ENCOUNTER ....."
D UNDON^PXBCC
W !
F W $C(32) Q:$X=(IOM-(4))
W !
D UNDOFF^PXBCC
Q
;
PRINT(NO) ;--Display the requested information
N ENTRY,VAR
S VAR="ZP"_NO D @VAR
Q
ZP1 ;--PROVIDER AND PRIMARY
I '$D(REQE) Q
D LOC^PXBCC(1,10) W $P(REQE,"^",1)_" "_$P(REQE,"^",2),IOELEOL
Q
ZP2 ;--CPT PROCEDURE AND DESCRIPTION
I '$D(REQE) Q
S ENTRY=$P(REQE,"^",3) I ENTRY]"" D RREVH^PXBCC(1,10,ENTRY)
Q
ZP3 ;--QUANTITY OF PROCEDURES
I '$D(REQE) Q
S ENTRY=$P(REQE,"^",4) I ENTRY]"" D RREV^PXBCC(1,45,ENTRY)
Q
ZP4 ;--DIAGNOSIS
I '$D(REQE) Q
D LOC^PXBCC(1,10) W $P(REQE,"^",5)_" "_$P(REQE,"^",6),IOELEOL
Q
;
ZP5 ;--STOP CODE
I '$D(REQE) Q
S ENTRY=$P(REQE,"^",10) I ENTRY]"" D RREV^PXBCC(0,10,ENTRY)
Q
;
ZP6 ;PX124
ZP7 ;
ZP8 ;
ZP9 ;
ZP10 ;
ZP11 ;
ZP12 ;
ZP13 ;
ZP14 ;
ZP15 ;
I $D(REQE) D LOC^PXBCC(1,0) W "DIAGNOSIS: ",$E($P(REQE,"^",NO+6),1,68),IOELEOL
Q
;
RSET(CATEGORY) ; Reset the data in the REQ, REQI and REQE variables
; CATEGORY IS EQUAL TO FILE MNEMONIC (e.g. CPT, POV, PRV)
D @CATEGORY
Q
CPT ;CPT CODES
N PX124
S $P(REQI,"^",3)="",$P(REQE,"^",3)="",$P(REQI,"^",8)=""
S $P(REQI,"^",4)="",$P(REQE,"^",4)=""
F PX124=12:1:22 S $P(REQI,"^",PX124)="",$P(REQE,"^",PX124)=""
K REQ
Q
PRV ;PROVIDER
S $P(REQI,"^",1)="",$P(REQE,"^",1)="",$P(REQI,"^",7)=""
S $P(REQI,"^",2)="",$P(REQE,"^",2)=""
Q
POV ;PURPOSE OF VISIT
S $P(REQI,"^",5)="",$P(REQE,"^",5)="",$P(REQI,"^",9)=""
S $P(REQI,"^",6)="",$P(REQE,"^",6)=""
Q
STP ;STOPCODES
S $P(REQI,"^",10)="",$P(REQE,"^",10)=""
S $P(REQI,"^",11)="",$P(REQE,"^",11)=""
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXBDREQ 2903 printed Apr 09, 2024@21:29:55 Page 2
PXBDREQ ;ISL/JVS - DISPLAY REQUESTS ;6/17/03 10:29
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**73,124,199**;Aug 12, 1996;Build 51
+2 ;
+3 ; Variable list
+4 ; These two variables represent the data that has been selected
+5 ; to be saved in the v files by the user
+6 ;
+7 ; REQ*=PROVIDER^PRIMARY^CPT^QUANTITY^POV^PRIMARY
+8 ; REQI=Internal Values
+9 ; REQE=External Values
+10 ;
REQ(NO) ;--Display the REQUESTED Data
+1 NEW ENTRY,VAR
+2 SET VAR="N"_NO
DO @VAR
+3 QUIT
N4 ;---Fourth Method--for the CPT prompts
+1 WRITE !,"PROVIDER: ...Enter the provider associated with the CPT'S....."
+2 DO UNDON^PXBCC
+3 WRITE !,?5,"CPT: "
+4 FOR
WRITE $CHAR(32)
if $X=(IOM-(4))
QUIT
+5 WRITE !
+6 DO UNDOFF^PXBCC
+7 QUIT
N5 ;---Fifth Method--for the PROVIDER prompts
+1 WRITE !,"PROVIDER: ...Select a Provider....."
+2 DO UNDON^PXBCC
+3 WRITE !
+4 FOR
WRITE $CHAR(32)
if $X=(IOM-(4))
QUIT
+5 WRITE !
+6 DO UNDOFF^PXBCC
+7 QUIT
+8 ;
N6 ;---Sixth Method--for the POV(DIAGNOSIS) prompts
+1 WRITE !,"ICD CODE: ...Select a DIAGNOSIS Code....."
+2 DO UNDON^PXBCC
+3 WRITE !
+4 FOR
WRITE $CHAR(32)
if $X=(IOM-(4))
QUIT
+5 WRITE !
+6 DO UNDOFF^PXBCC
+7 QUIT
N7 ;---SEVENTH Method--for the STOP CODES prompts
+1 WRITE !,"STOP CODE: ...Select an AMIS STOP Code....."
+2 DO UNDON^PXBCC
+3 WRITE !
+4 FOR
WRITE $CHAR(32)
if $X=(IOM-(4))
QUIT
+5 WRITE !
+6 DO UNDOFF^PXBCC
+7 QUIT
N8 ;---EIGHTH Method--for the ENCOUNTERS prompts
+1 WRITE !,"ENCOUNTERS: ...Select an ENCOUNTER ....."
+2 DO UNDON^PXBCC
+3 WRITE !
+4 FOR
WRITE $CHAR(32)
if $X=(IOM-(4))
QUIT
+5 WRITE !
+6 DO UNDOFF^PXBCC
+7 QUIT
+8 ;
PRINT(NO) ;--Display the requested information
+1 NEW ENTRY,VAR
+2 SET VAR="ZP"_NO
DO @VAR
+3 QUIT
ZP1 ;--PROVIDER AND PRIMARY
+1 IF '$DATA(REQE)
QUIT
+2 DO LOC^PXBCC(1,10)
WRITE $PIECE(REQE,"^",1)_" "_$PIECE(REQE,"^",2),IOELEOL
+3 QUIT
ZP2 ;--CPT PROCEDURE AND DESCRIPTION
+1 IF '$DATA(REQE)
QUIT
+2 SET ENTRY=$PIECE(REQE,"^",3)
IF ENTRY]""
DO RREVH^PXBCC(1,10,ENTRY)
+3 QUIT
ZP3 ;--QUANTITY OF PROCEDURES
+1 IF '$DATA(REQE)
QUIT
+2 SET ENTRY=$PIECE(REQE,"^",4)
IF ENTRY]""
DO RREV^PXBCC(1,45,ENTRY)
+3 QUIT
ZP4 ;--DIAGNOSIS
+1 IF '$DATA(REQE)
QUIT
+2 DO LOC^PXBCC(1,10)
WRITE $PIECE(REQE,"^",5)_" "_$PIECE(REQE,"^",6),IOELEOL
+3 QUIT
+4 ;
ZP5 ;--STOP CODE
+1 IF '$DATA(REQE)
QUIT
+2 SET ENTRY=$PIECE(REQE,"^",10)
IF ENTRY]""
DO RREV^PXBCC(0,10,ENTRY)
+3 QUIT
+4 ;
ZP6 ;PX124
ZP7 ;
ZP8 ;
ZP9 ;
ZP10 ;
ZP11 ;
ZP12 ;
ZP13 ;
ZP14 ;
ZP15 ;
+1 IF $DATA(REQE)
DO LOC^PXBCC(1,0)
WRITE "DIAGNOSIS: ",$EXTRACT($PIECE(REQE,"^",NO+6),1,68),IOELEOL
+2 QUIT
+3 ;
RSET(CATEGORY) ; Reset the data in the REQ, REQI and REQE variables
+1 ; CATEGORY IS EQUAL TO FILE MNEMONIC (e.g. CPT, POV, PRV)
+2 DO @CATEGORY
+3 QUIT
CPT ;CPT CODES
+1 NEW PX124
+2 SET $PIECE(REQI,"^",3)=""
SET $PIECE(REQE,"^",3)=""
SET $PIECE(REQI,"^",8)=""
+3 SET $PIECE(REQI,"^",4)=""
SET $PIECE(REQE,"^",4)=""
+4 FOR PX124=12:1:22
SET $PIECE(REQI,"^",PX124)=""
SET $PIECE(REQE,"^",PX124)=""
+5 KILL REQ
+6 QUIT
PRV ;PROVIDER
+1 SET $PIECE(REQI,"^",1)=""
SET $PIECE(REQE,"^",1)=""
SET $PIECE(REQI,"^",7)=""
+2 SET $PIECE(REQI,"^",2)=""
SET $PIECE(REQE,"^",2)=""
+3 QUIT
POV ;PURPOSE OF VISIT
+1 SET $PIECE(REQI,"^",5)=""
SET $PIECE(REQE,"^",5)=""
SET $PIECE(REQI,"^",9)=""
+2 SET $PIECE(REQI,"^",6)=""
SET $PIECE(REQE,"^",6)=""
+3 QUIT
STP ;STOPCODES
+1 SET $PIECE(REQI,"^",10)=""
SET $PIECE(REQE,"^",10)=""
+2 SET $PIECE(REQI,"^",11)=""
SET $PIECE(REQE,"^",11)=""
+3 QUIT
+4 ;
