- 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 Feb 18, 2025@23:53:20 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