- PXBPWCH ;ISL/JVS - PROMPT WHICH LINE ;11/7/96 08:57
- ;;1.0;PCE PATIENT CARE ENCOUNTER;**11,73**;Aug 12, 1996
- ;
- ;
- ;
- ;
- ;
- ;
- WHICH ;--When there is more than one entry to select ask which line no.
- N TIMED,PXBUT,DIC,X,N,V
- I '$D(IOEDEOP) D TERM^PXBCC
- S TIMED="I '$T!(DATA[""^"")"
- S N=0,V=0 F I=1:1:Q S N=$O(Q(N)) S $P(V," or ",I)=N
- WH W !!,"Select one of the HIGHLIGHTED lines above("_V_"): ",IOELEOL
- R DATA:DTIME
- X TIMED I S PXBUT=1,DATA="^",EDATA="^" G WFIN
- I DATA?.N1"E".NAP S DATA=" "_DATA
- I DATA?24.N S (DATA,EDATA)=$E(DATA,1,24)
- ;---SPACE BAR---
- I DATA'=" ",DATA'["^",DATA'="" S ^DISV(DUZ,"PXBWH-7")=DATA
- I DATA=" ",$D(^DISV(DUZ,"PXBWH-7")) S DATA=^DISV(DUZ,"PXBWH-7") W DATA
- I DATA["?" G HEL
- I DATA<0 K DATA G WH
- I DATA="" S DATA="???" G HEL
- I DATA>PXBCNT K DATA G WH
- G WFIN
- Q
- HEL ;--HELP
- I DATA'?1.3"?" S DATA="???"
- I DATA["?" W IOEDEOP D:DATA="?" HELP^PXBUTL0("WH1") D:DATA="??" HELP^PXBUTL0("WH2") D:DATA="???" HELP^PXBUTL0("WH3") F I=1:1:5 W IOCUU
- G WH
- WFIN ;--FINISH UP VARIABLES
- S EDATA=DATA
- ;--need to set the right item to hilighted and restore the others.
- S NLINE=0
- F S NLINE=$O(Q(NLINE)) Q:NLINE="" D:NLINE'=DATA REVCPT^PXBCC(NLINE,0)
- WHIX ;--EXIT AND CLEANUP
- W IORC,IOEDEOP
- K Q
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXBPWCH 1269 printed Feb 18, 2025@23:53:34 Page 2
- PXBPWCH ;ISL/JVS - PROMPT WHICH LINE ;11/7/96 08:57
- +1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**11,73**;Aug 12, 1996
- +2 ;
- +3 ;
- +4 ;
- +5 ;
- +6 ;
- +7 ;
- WHICH ;--When there is more than one entry to select ask which line no.
- +1 NEW TIMED,PXBUT,DIC,X,N,V
- +2 IF '$DATA(IOEDEOP)
- DO TERM^PXBCC
- +3 SET TIMED="I '$T!(DATA[""^"")"
- +4 SET N=0
- SET V=0
- FOR I=1:1:Q
- SET N=$ORDER(Q(N))
- SET $PIECE(V," or ",I)=N
- WH WRITE !!,"Select one of the HIGHLIGHTED lines above("_V_"): ",IOELEOL
- +1 READ DATA:DTIME
- +2 XECUTE TIMED
- IF $TEST
- SET PXBUT=1
- SET DATA="^"
- SET EDATA="^"
- GOTO WFIN
- +3 IF DATA?.N1"E".NAP
- SET DATA=" "_DATA
- +4 IF DATA?24.N
- SET (DATA,EDATA)=$EXTRACT(DATA,1,24)
- +5 ;---SPACE BAR---
- +6 IF DATA'=" "
- IF DATA'["^"
- IF DATA'=""
- SET ^DISV(DUZ,"PXBWH-7")=DATA
- +7 IF DATA=" "
- IF $DATA(^DISV(DUZ,"PXBWH-7"))
- SET DATA=^DISV(DUZ,"PXBWH-7")
- WRITE DATA
- +8 IF DATA["?"
- GOTO HEL
- +9 IF DATA<0
- KILL DATA
- GOTO WH
- +10 IF DATA=""
- SET DATA="???"
- GOTO HEL
- +11 IF DATA>PXBCNT
- KILL DATA
- GOTO WH
- +12 GOTO WFIN
- +13 QUIT
- HEL ;--HELP
- +1 IF DATA'?1.3"?"
- SET DATA="???"
- +2 IF DATA["?"
- WRITE IOEDEOP
- if DATA="?"
- DO HELP^PXBUTL0("WH1")
- if DATA="??"
- DO HELP^PXBUTL0("WH2")
- if DATA="???"
- DO HELP^PXBUTL0("WH3")
- FOR I=1:1:5
- WRITE IOCUU
- +3 GOTO WH
- WFIN ;--FINISH UP VARIABLES
- +1 SET EDATA=DATA
- +2 ;--need to set the right item to hilighted and restore the others.
- +3 SET NLINE=0
- +4 FOR
- SET NLINE=$ORDER(Q(NLINE))
- if NLINE=""
- QUIT
- if NLINE'=DATA
- DO REVCPT^PXBCC(NLINE,0)
- WHIX ;--EXIT AND CLEANUP
- +1 WRITE IORC,IOEDEOP
- +2 KILL Q
- +3 QUIT