1 | PXBMSTP ;ISL/JVS - MAIN ROUTINE STOP CODES ;11/5/96 14:27
|
---|
2 | ;;1.0;PCE PATIENT CARE ENCOUNTER;**11**;Aug 12, 1996
|
---|
3 | ;
|
---|
4 | W !,"This is not the entry into this routine" Q
|
---|
5 | ;
|
---|
6 | ; VARABLE LIST
|
---|
7 | ;
|
---|
8 | ;
|
---|
9 | STP(PXBVST) ;-----STOP CODES
|
---|
10 | Q:'$D(^AUPNVSIT(PXBVST))
|
---|
11 | ;
|
---|
12 | ;--Obtain the correct provider
|
---|
13 | ;--Set up
|
---|
14 | N PXBCNT,I,J,IDATE,PRIP,PRIPOV,PRISEC,QUA,VISIT,PRI,POV,PRV,PXBENT,SAVE
|
---|
15 | N PXBUT,FPRI,ENTRY,PXBSAVE,DATA,NAME,PATIENT,VAR
|
---|
16 | N REQI,REQE,PXKSTP,CYCL,FROM,PXBNSTPL,NOREV
|
---|
17 | N PXBNSTP,FIRST,PXBWIN,CLINIC,PXBPMT,LEAVE,CREDIT,PXBSKY,PXBKY,PXBSAM,%
|
---|
18 | S (REQE,REQI)=""
|
---|
19 | S CLINIC=$P(^AUPNVSIT(PXBVST,0),"^",22)
|
---|
20 | S ^TMP("PXBDSTP",$J,"START")=0,FIRST=1,FROM="STP",PXBEXIT=1
|
---|
21 | ;
|
---|
22 | S ;---START
|
---|
23 | D TERM^PXBCC
|
---|
24 | D STP^PXBGSTP(PXBVST) ;--GATHER STP'S
|
---|
25 | D HDR^PXBUTL(PXBVST,1)
|
---|
26 | I $D(PXBCNT),PXBCNT=0 D REQ^PXBDREQ(7)
|
---|
27 | D HDR2^PXBUTL(FROM)
|
---|
28 | D LOC^PXBCC(3,1)
|
---|
29 | D EN0^PXBDSTP ;--DISPLAY STP'S
|
---|
30 | D LOC^PXBCC(15,1) W IOSC ;--MOVE TO LINE 17 AND SAVE CURSOR LOCATION
|
---|
31 | D WIN17^PXBCC(PXBVST) ;--SET UP WINDOW
|
---|
32 | D RSET^PXBDREQ("STP")
|
---|
33 | SS K ERROR,PXBDIC
|
---|
34 | D STP^PXBPSTP
|
---|
35 | G:$G(PXBEXIT)<1 STPXIT
|
---|
36 | D:$G(ERROR) RSET^PXBDREQ("STP")
|
---|
37 | G:$G(ERROR) SS
|
---|
38 | I $P(REQE,"^",10)=900 D HELP^PXBUTL0("STP900") D RSET^PXBDREQ("STP") G SS
|
---|
39 | K FIRST
|
---|
40 | ;
|
---|
41 | ;-----STORE THE INFORMATION
|
---|
42 | I $G(PXBDIC) K PXBDIC G S
|
---|
43 | 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)
|
---|
44 | ;
|
---|
45 | ;-----PASS IT ON OUT THE DOOR
|
---|
46 | D RSET^PXBDREQ("STP")
|
---|
47 | ;----------FOR SCHEDULING ADD/EDIT--------
|
---|
48 | I WHAT="ADDEDIT",$D(PXBNSTP) G STPXIT
|
---|
49 | ;-----------VAUGHN 6/29/96-ALBANY----
|
---|
50 | I $G(PXBUT)=1!($D(DIRUT)) G STPXIT
|
---|
51 | I DATA["^S" G S
|
---|
52 | K PXBUT,DIRUT G SS
|
---|
53 | Q
|
---|
54 | STPXIT ;EXIT
|
---|
55 | D PRIM^PXBUTL
|
---|
56 | D FULL0^PXBCC
|
---|
57 | D CLEAR1^PXBCC
|
---|
58 | K ^TMP("PXBDSTP",$J),^TMP("PXBSTOR",$J),^TMP("PXK",$J)
|
---|
59 | K ^TMP("PXBTOTAL",$J),^TMP("PXBTANA",$J)
|
---|
60 | K DIRUT
|
---|
61 | Q
|
---|