PXBPSTP ;ISL/JVS - PROMPT FOR STOP CODE ;7/24/96 09:55
;;1.0;PCE PATIENT CARE ENCOUNTER;**11**;Aug 12, 1996
;
; VARIABLE LIST
; SELINE= LILine number of selected item
;
STP ;-----First Stop Code Entry point
I $D(PXBNSTPL) D LOC^PXBCC(2,0) W IOUON,"Previous Entry: ",$G(PXBNSTPL(1)) F I=1:1:10 W " "
W IOUOFF
N TIMED,EDATA,DIC,LINE,XFLAG,SELINE,NOT,STOPC,STOPI
I '$D(IOSC) D TERM^PXBCC
S DOUBLEQQ=0,TIMED="I '$T!(DATA=""^"")",FROM="STP"
I $P($G(^AUPNVSIT(PXBVST,0)),"^",22)&($P(^SC($P(^AUPNVSIT(PXBVST,0),"^",22),0),"^",7)) D
.S STOPC=$P(^DIC(40.7,$P(^SC($P(^AUPNVSIT(PXBVST,0),"^",22),0),"^",7),0),"^",2)
.S STOPI=$P(^SC($P(^AUPNVSIT(PXBVST,0),"^",22),0),"^",7)
S DIC("S")="I '$P(^DIC(40.7,Y,0),""^"",3)!($P(^DIC(40.7,Y,0),""^"",3)>$P(IDATE,""."",1))&($G(STOPI)'=Y)"
;
;
D LOC^PXBCC(15,0)
S ;-----Second Stop Code Entry point
D WIN17^PXBCC(PXBCNT)
I PXBCNT>10 W !,"Enter '+' for next page, '-' for previous page."
I '$D(PXKSTP) W !,"Enter a STOP CODE: " W IOELEOL
I $D(PXKSTP) W !,"Enter ",IOINHI,"NEXT",IOINLOW," STOP CODE: " W IOELEOL
R DATA:DTIME S EDATA=DATA
;
;
S1 ;-----Third Stop Code Entry point
X TIMED I S PXBUT=1 S:DATA="^" LEAVE=1 G STPX
I DATA?1.N1"E".NAP S DATA=" "_DATA
I $L(DATA)>200 S (DATA,EDATA)=$E(DATA,1,199)
I DATA?24.N S (DATA,EDATA)=$E(DATA,1,24)
D CASE^PXBUTL
I DATA=$G(STOPC),DATA'="" W !,"You cannot select main STOP CODE "_$G(STOPC) G S
;---SPACE BAR--
I DATA=" ",$D(^DISV(DUZ,"PXBPOV-6")) S (DATA,EDATA)=^DISV(DUZ,"PXBPOV-6") W DATA
I DATA="^^" S PXBEXIT=0 G STPX
S2 ;-----Fourth Stop Code Entry point
W IOEDEOP
;-----If this Prompt can jump to other prompts put symbols in here
I DATA["^S" S PXBDIC=1 G STPX
I DATA="" S PXBUT=1 G STPX
;
;
I PXBCNT>10&((DATA="+")!(DATA="-")) D DSTP4^PXBDSTP(DATA) W IORC D WIN17^PXBCC(PXBCNT) G S
;
;
M ;-----IF Multiple entries can be added
D ADDM^PXBPSTP1
I $G(NF) G S1
;-----IF Multiple entries can be deleted
D DELM^PXBPSTP1
I $G(NF) G S1
;
LI ;-----If picked a line number--no for it reason at this time
;I (DATA>0)&(DATA<(PXBCNT+1))&($L(DATA)'>$L(PXBCNT)) S XFLAG=1 D:PXBCNT>10 DSTP4^PXBDSTP(DATA) S SELINE=DATA,HERE=1 D
;.F I=1:1:$L(DATA) W IOCUB,IOECH
;.S DATA=$P($G(PXBSAM(DATA)),"^",1)
;I $D(XFLAG),XFLAG=1 S Y=DATA K XFLAG G SFIN
;
;
;-----If Stop Code selected is already in the file
I '$G(DOUBLEQQ),$D(PXBKY(DATA)) D
.S HERE=1
.I PXBCNT>10 D DSTP4^PXBDSTP($O(PXBKY(DATA,0)))
.K Q D TIMES^PXBUTL(DATA)
.I Q=1 S LINE=$O(PXBKY(DATA,0)) S XFLAG=1 D REVSTP^PXBCC(LINE)
.I Q>1 S NLINE=0 F S NLINE=$O(Q(NLINE)) Q:NLINE="" D REVSTP^PXBCC(NLINE)
I $D(Q),Q>1 D WHICH^PXBPWCH G LI
I $D(XFLAG),XFLAG=1 S Y=DATA G SFIN
;
;
;-----If it is Needed to do a DIC lookup on data
I '$D(PXBWIN) D WIN17^PXBCC(PXBCNT)
;
;-----If a ?? is entered by the user
I DATA'="??" D:DATA="?" EN1^PXBHLP0("PXB","STP",1,"",1) G:DATA="^S" S1 I DATA="?" G S
I DATA="??" S DOUBLEQQ=1 D EN1^PXBHLP0("PXB","STP","",1,2) S:$L(DATA,"^")>1 (Y,DATA,EDATA)=$P($P(DATA,"^",2),"--",1) G:Y>0 SFIN I DATA<1 S DATA="^S" G S2
;
;
;-----If a "?" is NOT entered and needs a lookup
S (VAL,Y)=$$DOUBLE1^PXBGSTP2(WHAT) I Y<1 S DATA="^S" G S2
S (X,DATA,EDATA)=$P($P(VAL,"^",2),"--",1),DIC=40.7,DIC(0)="MZ" D ^DIC
;
;
;
SFIN ;-----Finish up the Variables of the STOP CODE
I $G(HERE) K HERE G STP
I $L(Y,"^")'>1 S X=Y,DIC=40.7,DIC(0)="ZM" D ^DIC
I +Y<0 D CPTMNO^PXBUTL0 G S ;-HELP MESSAGE'CPTM'IS OK
S STP=Y(0)
S PXBNSTP($P(Y(0),"^",2))=""
S PXBNSTP($P(Y(0),"^",1))=""
S PXBNSTPL(1)=$P(STP,"^",2) S ^DISV(DUZ,"PXBPOV-6")=$P(STP,"^",2)
I $D(PXBKY($P(Y(0),"^"))),$G(SELINE) S $P(REQI,"^",11)=$O(PXBSKY(SELINE,0))
I $D(PXBKY($P(Y(0),"^"))),'$G(SELINE) S $P(REQI,"^",11)=$O(PXBSKY($O(PXBKY($P(Y(0),"^"),0)),0))
S $P(REQI,"^",10)=+Y
S $P(REQE,"^",10)=$P(STP,"^",2)
;-----If the Stop code is inactive issur a warning
I DATA]"" S NOT=$$ACTIVE^PXBPSTP1(REQI,REQE) I $G(NOT) K NOT D RSET^PXBDREQ("STP") G S
I $D(PXBKY($P(STP,"^",2))) W "--"_$P(PXBSAM($O(PXBKY($P(STP,"^",2),0))),"^",2)
STPX ;-----Exit the routine and clean up the variabLES
I $G(WHAT)="INTV",DATA="^" S PXBEXIT="^^"
I '$D(REQE) S REQE=""
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXBPSTP 4221 printed Apr 09, 2024@21:27:44 Page 2
PXBPSTP ;ISL/JVS - PROMPT FOR STOP CODE ;7/24/96 09:55
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**11**;Aug 12, 1996
+2 ;
+3 ; VARIABLE LIST
+4 ; SELINE= LILine number of selected item
+5 ;
STP ;-----First Stop Code Entry point
+1 IF $DATA(PXBNSTPL)
DO LOC^PXBCC(2,0)
WRITE IOUON,"Previous Entry: ",$GET(PXBNSTPL(1))
FOR I=1:1:10
WRITE " "
+2 WRITE IOUOFF
+3 NEW TIMED,EDATA,DIC,LINE,XFLAG,SELINE,NOT,STOPC,STOPI
+4 IF '$DATA(IOSC)
DO TERM^PXBCC
+5 SET DOUBLEQQ=0
SET TIMED="I '$T!(DATA=""^"")"
SET FROM="STP"
+6 IF $PIECE($GET(^AUPNVSIT(PXBVST,0)),"^",22)&($PIECE(^SC($PIECE(^AUPNVSIT(PXBVST,0),"^",22),0),"^",7))
Begin DoDot:1
+7 SET STOPC=$PIECE(^DIC(40.7,$PIECE(^SC($PIECE(^AUPNVSIT(PXBVST,0),"^",22),0),"^",7),0),"^",2)
+8 SET STOPI=$PIECE(^SC($PIECE(^AUPNVSIT(PXBVST,0),"^",22),0),"^",7)
End DoDot:1
+9 SET DIC("S")="I '$P(^DIC(40.7,Y,0),""^"",3)!($P(^DIC(40.7,Y,0),""^"",3)>$P(IDATE,""."",1))&($G(STOPI)'=Y)"
+10 ;
+11 ;
+12 DO LOC^PXBCC(15,0)
S ;-----Second Stop Code Entry point
+1 DO WIN17^PXBCC(PXBCNT)
+2 IF PXBCNT>10
WRITE !,"Enter '+' for next page, '-' for previous page."
+3 IF '$DATA(PXKSTP)
WRITE !,"Enter a STOP CODE: "
WRITE IOELEOL
+4 IF $DATA(PXKSTP)
WRITE !,"Enter ",IOINHI,"NEXT",IOINLOW," STOP CODE: "
WRITE IOELEOL
+5 READ DATA:DTIME
SET EDATA=DATA
+6 ;
+7 ;
S1 ;-----Third Stop Code Entry point
+1 XECUTE TIMED
IF $TEST
SET PXBUT=1
if DATA="^"
SET LEAVE=1
GOTO STPX
+2 IF DATA?1.N1"E".NAP
SET DATA=" "_DATA
+3 IF $LENGTH(DATA)>200
SET (DATA,EDATA)=$EXTRACT(DATA,1,199)
+4 IF DATA?24.N
SET (DATA,EDATA)=$EXTRACT(DATA,1,24)
+5 DO CASE^PXBUTL
+6 IF DATA=$GET(STOPC)
IF DATA'=""
WRITE !,"You cannot select main STOP CODE "_$GET(STOPC)
GOTO S
+7 ;---SPACE BAR--
+8 IF DATA=" "
IF $DATA(^DISV(DUZ,"PXBPOV-6"))
SET (DATA,EDATA)=^DISV(DUZ,"PXBPOV-6")
WRITE DATA
+9 IF DATA="^^"
SET PXBEXIT=0
GOTO STPX
S2 ;-----Fourth Stop Code Entry point
+1 WRITE IOEDEOP
+2 ;-----If this Prompt can jump to other prompts put symbols in here
+3 IF DATA["^S"
SET PXBDIC=1
GOTO STPX
+4 IF DATA=""
SET PXBUT=1
GOTO STPX
+5 ;
+6 ;
+7 IF PXBCNT>10&((DATA="+")!(DATA="-"))
DO DSTP4^PXBDSTP(DATA)
WRITE IORC
DO WIN17^PXBCC(PXBCNT)
GOTO S
+8 ;
+9 ;
M ;-----IF Multiple entries can be added
+1 DO ADDM^PXBPSTP1
+2 IF $GET(NF)
GOTO S1
+3 ;-----IF Multiple entries can be deleted
+4 DO DELM^PXBPSTP1
+5 IF $GET(NF)
GOTO S1
+6 ;
LI ;-----If picked a line number--no for it reason at this time
+1 ;I (DATA>0)&(DATA<(PXBCNT+1))&($L(DATA)'>$L(PXBCNT)) S XFLAG=1 D:PXBCNT>10 DSTP4^PXBDSTP(DATA) S SELINE=DATA,HERE=1 D
+2 ;.F I=1:1:$L(DATA) W IOCUB,IOECH
+3 ;.S DATA=$P($G(PXBSAM(DATA)),"^",1)
+4 ;I $D(XFLAG),XFLAG=1 S Y=DATA K XFLAG G SFIN
+5 ;
+6 ;
+7 ;-----If Stop Code selected is already in the file
+8 IF '$GET(DOUBLEQQ)
IF $DATA(PXBKY(DATA))
Begin DoDot:1
+9 SET HERE=1
+10 IF PXBCNT>10
DO DSTP4^PXBDSTP($ORDER(PXBKY(DATA,0)))
+11 KILL Q
DO TIMES^PXBUTL(DATA)
+12 IF Q=1
SET LINE=$ORDER(PXBKY(DATA,0))
SET XFLAG=1
DO REVSTP^PXBCC(LINE)
+13 IF Q>1
SET NLINE=0
FOR
SET NLINE=$ORDER(Q(NLINE))
if NLINE=""
QUIT
DO REVSTP^PXBCC(NLINE)
End DoDot:1
+14 IF $DATA(Q)
IF Q>1
DO WHICH^PXBPWCH
GOTO LI
+15 IF $DATA(XFLAG)
IF XFLAG=1
SET Y=DATA
GOTO SFIN
+16 ;
+17 ;
+18 ;-----If it is Needed to do a DIC lookup on data
+19 IF '$DATA(PXBWIN)
DO WIN17^PXBCC(PXBCNT)
+20 ;
+21 ;-----If a ?? is entered by the user
+22 IF DATA'="??"
if DATA="?"
DO EN1^PXBHLP0("PXB","STP",1,"",1)
if DATA="^S"
GOTO S1
IF DATA="?"
GOTO S
+23 IF DATA="??"
SET DOUBLEQQ=1
DO EN1^PXBHLP0("PXB","STP","",1,2)
if $LENGTH(DATA,"^")>1
SET (Y,DATA,EDATA)=$PIECE($PIECE(DATA,"^",2),"--",1)
if Y>0
GOTO SFIN
IF DATA<1
SET DATA="^S"
GOTO S2
+24 ;
+25 ;
+26 ;-----If a "?" is NOT entered and needs a lookup
+27 SET (VAL,Y)=$$DOUBLE1^PXBGSTP2(WHAT)
IF Y<1
SET DATA="^S"
GOTO S2
+28 SET (X,DATA,EDATA)=$PIECE($PIECE(VAL,"^",2),"--",1)
SET DIC=40.7
SET DIC(0)="MZ"
DO ^DIC
+29 ;
+30 ;
+31 ;
SFIN ;-----Finish up the Variables of the STOP CODE
+1 IF $GET(HERE)
KILL HERE
GOTO STP
+2 IF $LENGTH(Y,"^")'>1
SET X=Y
SET DIC=40.7
SET DIC(0)="ZM"
DO ^DIC
+3 ;-HELP MESSAGE'CPTM'IS OK
IF +Y<0
DO CPTMNO^PXBUTL0
GOTO S
+4 SET STP=Y(0)
+5 SET PXBNSTP($PIECE(Y(0),"^",2))=""
+6 SET PXBNSTP($PIECE(Y(0),"^",1))=""
+7 SET PXBNSTPL(1)=$PIECE(STP,"^",2)
SET ^DISV(DUZ,"PXBPOV-6")=$PIECE(STP,"^",2)
+8 IF $DATA(PXBKY($PIECE(Y(0),"^")))
IF $GET(SELINE)
SET $PIECE(REQI,"^",11)=$ORDER(PXBSKY(SELINE,0))
+9 IF $DATA(PXBKY($PIECE(Y(0),"^")))
IF '$GET(SELINE)
SET $PIECE(REQI,"^",11)=$ORDER(PXBSKY($ORDER(PXBKY($PIECE(Y(0),"^"),0)),0))
+10 SET $PIECE(REQI,"^",10)=+Y
+11 SET $PIECE(REQE,"^",10)=$PIECE(STP,"^",2)
+12 ;-----If the Stop code is inactive issur a warning
+13 IF DATA]""
SET NOT=$$ACTIVE^PXBPSTP1(REQI,REQE)
IF $GET(NOT)
KILL NOT
DO RSET^PXBDREQ("STP")
GOTO S
+14 IF $DATA(PXBKY($PIECE(STP,"^",2)))
WRITE "--"_$PIECE(PXBSAM($ORDER(PXBKY($PIECE(STP,"^",2),0))),"^",2)
STPX ;-----Exit the routine and clean up the variabLES
+1 IF $GET(WHAT)="INTV"
IF DATA="^"
SET PXBEXIT="^^"
+2 IF '$DATA(REQE)
SET REQE=""
+3 QUIT
