- 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 Jan 18, 2025@03:27:29 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 ;