PXBMSTP.m

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

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