source: WorldVistAEHR/trunk/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXBMSTP.m@ 1639

Last change on this file since 1639 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.8 KB
RevLine 
[613]1PXBMSTP ;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 ;
9STP(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 ;
22S ;---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")
33SS 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
54STPXIT ;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
Note: See TracBrowser for help on using the repository browser.