Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXBMSTP

PXBMSTP.m

Go to the documentation of this file.
  1. PXBMSTP ;ISL/JVS - MAIN ROUTINE STOP CODES ;11/5/96 14:27
  1. ;;1.0;PCE PATIENT CARE ENCOUNTER;**11**;Aug 12, 1996
  1. ;
  1. W !,"This is not the entry into this routine" Q
  1. ;
  1. ; VARABLE LIST
  1. ;
  1. ;
  1. STP(PXBVST) ;-----STOP CODES
  1. Q:'$D(^AUPNVSIT(PXBVST))
  1. ;
  1. ;--Obtain the correct provider
  1. ;--Set up
  1. N PXBCNT,I,J,IDATE,PRIP,PRIPOV,PRISEC,QUA,VISIT,PRI,POV,PRV,PXBENT,SAVE
  1. N PXBUT,FPRI,ENTRY,PXBSAVE,DATA,NAME,PATIENT,VAR
  1. N REQI,REQE,PXKSTP,CYCL,FROM,PXBNSTPL,NOREV
  1. N PXBNSTP,FIRST,PXBWIN,CLINIC,PXBPMT,LEAVE,CREDIT,PXBSKY,PXBKY,PXBSAM,%
  1. S (REQE,REQI)=""
  1. S CLINIC=$P(^AUPNVSIT(PXBVST,0),"^",22)
  1. S ^TMP("PXBDSTP",$J,"START")=0,FIRST=1,FROM="STP",PXBEXIT=1
  1. ;
  1. S ;---START
  1. D TERM^PXBCC
  1. D STP^PXBGSTP(PXBVST) ;--GATHER STP'S
  1. D HDR^PXBUTL(PXBVST,1)
  1. I $D(PXBCNT),PXBCNT=0 D REQ^PXBDREQ(7)
  1. D HDR2^PXBUTL(FROM)
  1. D LOC^PXBCC(3,1)
  1. D EN0^PXBDSTP ;--DISPLAY STP'S
  1. D LOC^PXBCC(15,1) W IOSC ;--MOVE TO LINE 17 AND SAVE CURSOR LOCATION
  1. D WIN17^PXBCC(PXBVST) ;--SET UP WINDOW
  1. D RSET^PXBDREQ("STP")
  1. SS K ERROR,PXBDIC
  1. D STP^PXBPSTP
  1. G:$G(PXBEXIT)<1 STPXIT
  1. D:$G(ERROR) RSET^PXBDREQ("STP")
  1. G:$G(ERROR) SS
  1. I $P(REQE,"^",10)=900 D HELP^PXBUTL0("STP900") D RSET^PXBDREQ("STP") G SS
  1. K FIRST
  1. ;
  1. ;-----STORE THE INFORMATION
  1. I $G(PXBDIC) K PXBDIC G S
  1. 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)
  1. ;
  1. ;-----PASS IT ON OUT THE DOOR
  1. D RSET^PXBDREQ("STP")
  1. ;----------FOR SCHEDULING ADD/EDIT--------
  1. I WHAT="ADDEDIT",$D(PXBNSTP) G STPXIT
  1. ;-----------VAUGHN 6/29/96-ALBANY----
  1. I $G(PXBUT)=1!($D(DIRUT)) G STPXIT
  1. I DATA["^S" G S
  1. K PXBUT,DIRUT G SS
  1. Q
  1. STPXIT ;EXIT
  1. D PRIM^PXBUTL
  1. D FULL0^PXBCC
  1. D CLEAR1^PXBCC
  1. K ^TMP("PXBDSTP",$J),^TMP("PXBSTOR",$J),^TMP("PXK",$J)
  1. K ^TMP("PXBTOTAL",$J),^TMP("PXBTANA",$J)
  1. K DIRUT
  1. Q