PXBMSTP ;ISL/JVS - MAIN ROUTINE STOP CODES ;11/5/96 14:27
;;1.0;PCE PATIENT CARE ENCOUNTER;**11**;Aug 12, 1996
;
W !,"This is not the entry into this routine" Q
;
; VARABLE LIST
;
;
STP(PXBVST) ;-----STOP CODES
Q:'$D(^AUPNVSIT(PXBVST))
;
;--Obtain the correct provider
;--Set up
N PXBCNT,I,J,IDATE,PRIP,PRIPOV,PRISEC,QUA,VISIT,PRI,POV,PRV,PXBENT,SAVE
N PXBUT,FPRI,ENTRY,PXBSAVE,DATA,NAME,PATIENT,VAR
N REQI,REQE,PXKSTP,CYCL,FROM,PXBNSTPL,NOREV
N PXBNSTP,FIRST,PXBWIN,CLINIC,PXBPMT,LEAVE,CREDIT,PXBSKY,PXBKY,PXBSAM,%
S (REQE,REQI)=""
S CLINIC=$P(^AUPNVSIT(PXBVST,0),"^",22)
S ^TMP("PXBDSTP",$J,"START")=0,FIRST=1,FROM="STP",PXBEXIT=1
;
S ;---START
D TERM^PXBCC
D STP^PXBGSTP(PXBVST) ;--GATHER STP'S
D HDR^PXBUTL(PXBVST,1)
I $D(PXBCNT),PXBCNT=0 D REQ^PXBDREQ(7)
D HDR2^PXBUTL(FROM)
D LOC^PXBCC(3,1)
D EN0^PXBDSTP ;--DISPLAY STP'S
D LOC^PXBCC(15,1) W IOSC ;--MOVE TO LINE 17 AND SAVE CURSOR LOCATION
D WIN17^PXBCC(PXBVST) ;--SET UP WINDOW
D RSET^PXBDREQ("STP")
SS K ERROR,PXBDIC
D STP^PXBPSTP
G:$G(PXBEXIT)<1 STPXIT
D:$G(ERROR) RSET^PXBDREQ("STP")
G:$G(ERROR) SS
I $P(REQE,"^",10)=900 D HELP^PXBUTL0("STP900") D RSET^PXBDREQ("STP") G SS
K FIRST
;
;-----STORE THE INFORMATION
I $G(PXBDIC) K PXBDIC G S
I '$D(PXBUT) D STP^PXBSTOR1 S PXKSTP="" D STP^PXBGSTP(PXBVST),HDR2^PXBUTL(FROM),LOC^PXBCC(3,1),EN0^PXBDSTP W IOEDEOP D LOC^PXBCC(15,1) W IOSC D WIN17^PXBCC(PXBVST)
;
;-----PASS IT ON OUT THE DOOR
D RSET^PXBDREQ("STP")
;----------FOR SCHEDULING ADD/EDIT--------
I WHAT="ADDEDIT",$D(PXBNSTP) G STPXIT
;-----------VAUGHN 6/29/96-ALBANY----
I $G(PXBUT)=1!($D(DIRUT)) G STPXIT
I DATA["^S" G S
K PXBUT,DIRUT G SS
Q
STPXIT ;EXIT
D PRIM^PXBUTL
D FULL0^PXBCC
D CLEAR1^PXBCC
K ^TMP("PXBDSTP",$J),^TMP("PXBSTOR",$J),^TMP("PXK",$J)
K ^TMP("PXBTOTAL",$J),^TMP("PXBTANA",$J)
K DIRUT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXBMSTP 1888 printed Nov 22, 2024@17:37:03 Page 2
PXBMSTP ;ISL/JVS - MAIN ROUTINE STOP CODES ;11/5/96 14:27
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**11**;Aug 12, 1996
+2 ;
+3 WRITE !,"This is not the entry into this routine"
QUIT
+4 ;
+5 ; VARABLE LIST
+6 ;
+7 ;
STP(PXBVST) ;-----STOP CODES
+1 if '$DATA(^AUPNVSIT(PXBVST))
QUIT
+2 ;
+3 ;--Obtain the correct provider
+4 ;--Set up
+5 NEW PXBCNT,I,J,IDATE,PRIP,PRIPOV,PRISEC,QUA,VISIT,PRI,POV,PRV,PXBENT,SAVE
+6 NEW PXBUT,FPRI,ENTRY,PXBSAVE,DATA,NAME,PATIENT,VAR
+7 NEW REQI,REQE,PXKSTP,CYCL,FROM,PXBNSTPL,NOREV
+8 NEW PXBNSTP,FIRST,PXBWIN,CLINIC,PXBPMT,LEAVE,CREDIT,PXBSKY,PXBKY,PXBSAM,%
+9 SET (REQE,REQI)=""
+10 SET CLINIC=$PIECE(^AUPNVSIT(PXBVST,0),"^",22)
+11 SET ^TMP("PXBDSTP",$JOB,"START")=0
SET FIRST=1
SET FROM="STP"
SET PXBEXIT=1
+12 ;
S ;---START
+1 DO TERM^PXBCC
+2 ;--GATHER STP'S
DO STP^PXBGSTP(PXBVST)
+3 DO HDR^PXBUTL(PXBVST,1)
+4 IF $DATA(PXBCNT)
IF PXBCNT=0
DO REQ^PXBDREQ(7)
+5 DO HDR2^PXBUTL(FROM)
+6 DO LOC^PXBCC(3,1)
+7 ;--DISPLAY STP'S
DO EN0^PXBDSTP
+8 ;--MOVE TO LINE 17 AND SAVE CURSOR LOCATION
DO LOC^PXBCC(15,1)
WRITE IOSC
+9 ;--SET UP WINDOW
DO WIN17^PXBCC(PXBVST)
+10 DO RSET^PXBDREQ("STP")
SS KILL ERROR,PXBDIC
+1 DO STP^PXBPSTP
+2 if $GET(PXBEXIT)<1
GOTO STPXIT
+3 if $GET(ERROR)
DO RSET^PXBDREQ("STP")
+4 if $GET(ERROR)
GOTO SS
+5 IF $PIECE(REQE,"^",10)=900
DO HELP^PXBUTL0("STP900")
DO RSET^PXBDREQ("STP")
GOTO SS
+6 KILL FIRST
+7 ;
+8 ;-----STORE THE INFORMATION
+9 IF $GET(PXBDIC)
KILL PXBDIC
GOTO S
+10 IF '$DATA(PXBUT)
DO STP^PXBSTOR1
SET PXKSTP=""
DO STP^PXBGSTP(PXBVST)
DO HDR2^PXBUTL(FROM)
DO LOC^PXBCC(3,1)
DO EN0^PXBDSTP
WRITE IOEDEOP
DO LOC^PXBCC(15,1)
WRITE IOSC
DO WIN17^PXBCC(PXBVST)
+11 ;
+12 ;-----PASS IT ON OUT THE DOOR
+13 DO RSET^PXBDREQ("STP")
+14 ;----------FOR SCHEDULING ADD/EDIT--------
+15 IF WHAT="ADDEDIT"
IF $DATA(PXBNSTP)
GOTO STPXIT
+16 ;-----------VAUGHN 6/29/96-ALBANY----
+17 IF $GET(PXBUT)=1!($DATA(DIRUT))
GOTO STPXIT
+18 IF DATA["^S"
GOTO S
+19 KILL PXBUT,DIRUT
GOTO SS
+20 QUIT
STPXIT ;EXIT
+1 DO PRIM^PXBUTL
+2 DO FULL0^PXBCC
+3 DO CLEAR1^PXBCC
+4 KILL ^TMP("PXBDSTP",$JOB),^TMP("PXBSTOR",$JOB),^TMP("PXK",$JOB)
+5 KILL ^TMP("PXBTOTAL",$JOB),^TMP("PXBTANA",$JOB)
+6 KILL DIRUT
+7 QUIT
