PRSPTM ;WOIFO/MGD - PTP TERMINATE MEMORANDUM ;06/15/05
;;4.0;PAID;**93**;Sep 21, 1995;Build 7
;;Per VHA Directive 2004-038, this routine should not be modified.
;
; The following routine will allow HR to terminate a Part Time
; Physician's Memorandum of Service Level Expectations. Once
; terminated the memorandum will need to be reconciled.
; For a memorandum to be eligible for termination it must have already
; had had at least one Pay Period processed and it must be prior to
; the processing of the last Pay Period covered by the memorandum.
;
Q
MAIN ; Main Driver
N STDAT,ENDAT,AHRS,ICOM,ESOK
; Prompt for Part Time Physician
D PTP
I Y'>0 D KILL Q
S PRSIEN=+Y
; Find any memorandums that meet the termination qualifications
D MEM
Q:'$G(MIEN)
; Display employee and memorandum information
D DISPLAY
Q:$D(DIRUT)
TERM ; Issue Terminate Memorandum prompt
W !
S DIR(0)="YO",DIR("A")="Terminate Memoranda Y/N: "
D ^DIR K DIR
Q:Y'=1
; Prompt for Termination Date
D TDATE
Q:X=""!(X="^")
; Prompt for Termination Comments
D TCOM
Q:TCOM="^"
; Prompt for E-sig and update file
D ESIG
Q
;
PTP ; Prompt for Part Time Physician
W !
S DIC="^PRSPC(",DIC(0)="AEMQZ",DIC("A")="Select EMPLOYEE: "
D ^DIC K DIC
S PRSIEN=+Y
Q
;
MEM ; Find any memorandums that meet the termination qualifications
N MEM,INDX
S MEM=0,INDX=1
F S MEM=$O(^PRST(458.7,"B",PRSIEN,MEM)) Q:'MEM D
. S DATA=$G(^PRST(458.7,MEM,0))
. Q:DATA=""
. S STATUS=$P(DATA,U,6)
. Q:STATUS>2 ; Memorandum = 3:RECONCILIATION STARTED or 4:RECONCILED
. S START=$P(DATA,U,2),END=$P(DATA,U,3) ; Start Date, End Date
. ; Don't include future memoradums. The Delete Future Memorandum
. ; option must be used to to remove future memorandums.
. Q:START>DT
. ; Check for a memorandum that has already been terminated but the
. ; Begin Reconciliation Process option has not been run yet.
. Q:+$G(^PRST(458.7,MEM,4))
. S PPI=$P($G(^PRST(458,"AD",END)),U,1)
. ; The End Date for future memorandums may not be in #458 yet
. I PPI="" D Q
. . S MEM(INDX)=MEM_"^"_START_"^"_END_"^ACTIVE",INDX=INDX+1
. ; If the End Date is in #458 check the timecard status for that PP
. ; Quit if Timecard status for the last PP of the mem is not (T)imekeeper
. Q:$P($G(^PRST(458,PPI,"E",PRSIEN,0)),U,2)'="T"
. S MEM(INDX)=MEM_"^"_START_"^"_END_"^ACTIVE",INDX=INDX+1
; If no memos meet the termination qualifications
I '$D(MEM(1)) D Q
. W !!,"No memorandums meet the termination qualifications for the "
. W "selected employee."
. S MIEN=0
; If only one memo
I '$D(MEM(2)) S MIEN=$P($G(MEM(1)),U,1) Q
; Display list if more than one
I $D(MEM(2)) D
. W !!," # ",?5,"STARTS ENDS"
. F MEM=1:1 Q:'$D(MEM(MEM)) D
. . S DATA=MEM(MEM)
. . S START=$$FMTE^XLFDT($P(DATA,U,2))
. . S END=$$FMTE^XLFDT($P(DATA,U,3))
. . W !!,MEM,?5,START," TO ",END
. ;
ASK . ; Ask user to select which memorandum they want
. S END="",END=$O(MEM(END),-1)
. W !!,"Enter a number between 1 and ",END,": "
. R ASK:DTIME
. S ASK=$$UPPER^PRSRUTL(ASK)
. I ASK=""!(ASK="^") S MIEN=0 Q
. I '$D(MEM(ASK)) D G ASK
. . W !!,"Enter a number between 1 and ",END," or ^ to exit"
. S MIEN=$P(MEM(ASK),U,1)
Q
;
DISPLAY ; Display memorandum info to validate the correct employee was chosen
S SCRTTL="Terminate PT Physician Memoranda"
D HDR^PRSPUT1(PRSIEN,SCRTTL)
D MEM^PRSPUT1(PRSIEN,MIEN)
D AL^PRSPUT3(PRSIEN,)
D PPSUM^PRSPUT2(PRSIEN,MIEN)
S DIR(0)="E",DIR("A")="Press RETURN to continue" D ^DIR
Q
;
TDATE ; Prompt for Termination Date
S DATA0=$G(^PRST(458.7,MIEN,0))
S (STDAT,STDATI)=$P(DATA0,U,2),(ENDAT,ENDATI)=$P(DATA0,U,3)
S Y=STDAT
D DD^%DT
S STDAT=Y
S Y=ENDAT
D DD^%DT
S ENDAT=Y
S TDAT=0
W !!,"Termination date must be the last day of a pay period."
W !,"Start Date: ",STDAT," End Date: ",ENDAT,!
S %DT="AEX",%DT("A")="Termination Date: ",QUIT=0
F D Q:QUIT
. N DAY14,TPPI
. D ^%DT
. I X=""!(X="^") S QUIT=1 Q
. ; Validate that the Termination Date is the last day of a Pay Period.
. S TDATE=+Y
. Q:TDATE="^"
. S D1=TDATE
. D PP^PRSAPPU ; PPI and Day are set here
. S TPPI=$G(PPI) ; termination pay period IEN (if open)
. I DAY'=14 D Q
. . W !!,"The Termination Date must be the last day of a Pay Period."
. . W !,"Please re-enter.",!
. I TDATE<STDATI D Q
. . W !!,"The Termination Date can not be prior to the Start Date: ",STDAT
. . W !,"Please re-enter.",!
. I TDATE'<ENDATI D Q
. . W !!,"The Termination Date must be prior to the End Date: ",ENDAT
. . W !,"Please re-enter.",!
. ;
. ; Check to make sure that no Timecards for PPs after the termination
. ; date have a status of Payroll or Transmitted.
. I 'TPPI S QUIT=1 Q ; PP containing termination date is not open
. ; loop thru PPs after the PP of terminatio and check their status
. S FPPESR=0 ; init # of PPs that have status which prevents termination
. S PPI=TPPI F S PPI=$O(^PRST(458,PPI)) Q:'PPI D Q:DAY14>ENDATI
. . S DAY14=$P($G(^PRST(458,PPI,1)),U,14) ; last day of PPI
. . Q:DAY14>ENDATI ; pay period is after end of memo
. . S STATUS=$P($G(^PRST(458,PPI,"E",PRSIEN,0)),U,2)
. . Q:"^P^X^"'[(U_STATUS_U) ; quit if status not P or X
. . ; timecard has a status that prevents termination
. . S FPPESR=FPPESR+1
. . S STATEX=$$EXTERNAL^DILFD(458.01,1,"",STATUS)
. . W !,$P($G(^PRST(458,PPI,0)),U),?10,STATEX
. ;
. I FPPESR=0 S QUIT=1 Q ; All tests passed. Termination date is OK
. ;
. W !!,"You cannot select this Pay Period because there "
. W $S(FPPESR=1:"is ",1:"are "),FPPESR," Pay Period"
. W $S(FPPESR>1:"s ",1:" "),"after this"
. W !,"Pay Period where the timecard",$S(FPPESR=1:" has ",1:"s have ")
. W "a status other than Timekeeper.",!!
Q
;
TCOM ; Termination Comments
W !
S DIR(0)="FO^1:240^^O",DIR("A")="Termination Comments" D ^DIR
S TCOM=Y
Q
;
ESIG ; Prompt for Electronic Signature and store fields in #458.7
;
N ESOK,PPE,PPNUM,RCALFLG
D ^PRSAES
I ESOK D
. ; Update #458.7
. S MIEN=MIEN_","
. S PRSFDA(458.7,MIEN,22)=TDATE ; TERMINATION DATE
. S PRSFDA(458.7,MIEN,23)=DUZ ; TERMINATED BY
. D NOW^%DTC
. S PRSFDA(458.7,MIEN,24)=% ; TERMINATED DATE/TIME
. S PRSFDA(458.7,MIEN,25)=TCOM ; TERMINATION COMMENTS
. D UPDATE^DIE("","PRSFDA","MIEN"),MSG^DIALOG()
. S MIEN=+MIEN ; Remove comma from end
. ;
. ; Check for PP that need to have their ESR's deleted
. S X1=TDATE,X2=1
. D C^%DTC
. S PPI=+$G(^PRST(458,"AD",X))
. Q:'PPI ; There aren't any pay periods opened after the termination date
. ;
. S PPI=PPI-.01 ; init PPI to include 1st PP in loop
. F S PPI=$O(^PRST(458,PPI)) Q:'PPI D
. . Q:'$D(^PRST(458,PPI,"E",PRSIEN,0)) ; skip PP if no timecard/ESR
. . ;
. . ; Check for previously saved hours for this PP
. . S RCALFLG=0
. . S PPE=$P($G(^PRST(458,PPI,0)),U,1)
. . S PPNUM=$O(^PRST(458.7,MIEN,9,"B",PPE,0))
. . Q:PPNUM'>0
. . S RCALFLG=$S($P($G(^PRST(458.7,MIEN,9,PPNUM,0)),U,1)'="":1,1:0)
. . ;
. . F DAY=1:1:14 D
. . . S ESRSTAT=$P($G(^PRST(458,PPI,"E",PRSIEN,"D",DAY,7)),U,1)
. . . I ESRSTAT=5 D ; Clear Time Card posting information
. . . . K ^PRST(458,PPI,"E",PRSIEN,"D",DAY,2),^(3),^(10)
. . . ;
. . . ; delete any ESR data
. . . ; use fileman to delete ESR DAILY STATUS so x-ref will get updated
. . . S PRSFDA(458.02,DAY_","_PRSIEN_","_PPI_",",146)="@"
. . . D FILE^DIE("","PRSFDA"),MSG^DIALOG()
. . . ; delete ESR related fields
. . . K ^PRST(458,PPI,"E",PRSIEN,"D",DAY,5),^(6),^(7)
. . ;
. . ; If the PP had been certified before, re-calculate totals
. . I RCALFLG D PTP^PRSASR1(PRSIEN,PPI)
Q
;
KILL ; Clean up variables
;
K ASK,D1,DA,DATA,DATA0,DAY,DIR,DIRUT,END,ENDAT,ENDATI,ESRSTAT
K FPPESR,I,INDX,MEM,MIEN,PPE,PPI,PRSIEN,PRSFDA,QUIT,QUIT1
K SCRTTL,START,STATEX,STATUS,STDAT,STDATI,TCOM
K TDAT,TDATE,TDATI,X,X1,X2,Y,%,%DT
K ^TMP($J,"PRSPTM")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSPTM 7993 printed Dec 13, 2024@02:28:18 Page 2
PRSPTM ;WOIFO/MGD - PTP TERMINATE MEMORANDUM ;06/15/05
+1 ;;4.0;PAID;**93**;Sep 21, 1995;Build 7
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ; The following routine will allow HR to terminate a Part Time
+5 ; Physician's Memorandum of Service Level Expectations. Once
+6 ; terminated the memorandum will need to be reconciled.
+7 ; For a memorandum to be eligible for termination it must have already
+8 ; had had at least one Pay Period processed and it must be prior to
+9 ; the processing of the last Pay Period covered by the memorandum.
+10 ;
+11 QUIT
MAIN ; Main Driver
+1 NEW STDAT,ENDAT,AHRS,ICOM,ESOK
+2 ; Prompt for Part Time Physician
+3 DO PTP
+4 IF Y'>0
DO KILL
QUIT
+5 SET PRSIEN=+Y
+6 ; Find any memorandums that meet the termination qualifications
+7 DO MEM
+8 if '$GET(MIEN)
QUIT
+9 ; Display employee and memorandum information
+10 DO DISPLAY
+11 if $DATA(DIRUT)
QUIT
TERM ; Issue Terminate Memorandum prompt
+1 WRITE !
+2 SET DIR(0)="YO"
SET DIR("A")="Terminate Memoranda Y/N: "
+3 DO ^DIR
KILL DIR
+4 if Y'=1
QUIT
+5 ; Prompt for Termination Date
+6 DO TDATE
+7 if X=""!(X="^")
QUIT
+8 ; Prompt for Termination Comments
+9 DO TCOM
+10 if TCOM="^"
QUIT
+11 ; Prompt for E-sig and update file
+12 DO ESIG
+13 QUIT
+14 ;
PTP ; Prompt for Part Time Physician
+1 WRITE !
+2 SET DIC="^PRSPC("
SET DIC(0)="AEMQZ"
SET DIC("A")="Select EMPLOYEE: "
+3 DO ^DIC
KILL DIC
+4 SET PRSIEN=+Y
+5 QUIT
+6 ;
MEM ; Find any memorandums that meet the termination qualifications
+1 NEW MEM,INDX
+2 SET MEM=0
SET INDX=1
+3 FOR
SET MEM=$ORDER(^PRST(458.7,"B",PRSIEN,MEM))
if 'MEM
QUIT
Begin DoDot:1
+4 SET DATA=$GET(^PRST(458.7,MEM,0))
+5 if DATA=""
QUIT
+6 SET STATUS=$PIECE(DATA,U,6)
+7 ; Memorandum = 3:RECONCILIATION STARTED or 4:RECONCILED
if STATUS>2
QUIT
+8 ; Start Date, End Date
SET START=$PIECE(DATA,U,2)
SET END=$PIECE(DATA,U,3)
+9 ; Don't include future memoradums. The Delete Future Memorandum
+10 ; option must be used to to remove future memorandums.
+11 if START>DT
QUIT
+12 ; Check for a memorandum that has already been terminated but the
+13 ; Begin Reconciliation Process option has not been run yet.
+14 if +$GET(^PRST(458.7,MEM,4))
QUIT
+15 SET PPI=$PIECE($GET(^PRST(458,"AD",END)),U,1)
+16 ; The End Date for future memorandums may not be in #458 yet
+17 IF PPI=""
Begin DoDot:2
+18 SET MEM(INDX)=MEM_"^"_START_"^"_END_"^ACTIVE"
SET INDX=INDX+1
End DoDot:2
QUIT
+19 ; If the End Date is in #458 check the timecard status for that PP
+20 ; Quit if Timecard status for the last PP of the mem is not (T)imekeeper
+21 if $PIECE($GET(^PRST(458,PPI,"E",PRSIEN,0)),U,2)'="T"
QUIT
+22 SET MEM(INDX)=MEM_"^"_START_"^"_END_"^ACTIVE"
SET INDX=INDX+1
End DoDot:1
+23 ; If no memos meet the termination qualifications
+24 IF '$DATA(MEM(1))
Begin DoDot:1
+25 WRITE !!,"No memorandums meet the termination qualifications for the "
+26 WRITE "selected employee."
+27 SET MIEN=0
End DoDot:1
QUIT
+28 ; If only one memo
+29 IF '$DATA(MEM(2))
SET MIEN=$PIECE($GET(MEM(1)),U,1)
QUIT
+30 ; Display list if more than one
+31 IF $DATA(MEM(2))
Begin DoDot:1
+32 WRITE !!," # ",?5,"STARTS ENDS"
+33 FOR MEM=1:1
if '$DATA(MEM(MEM))
QUIT
Begin DoDot:2
+34 SET DATA=MEM(MEM)
+35 SET START=$$FMTE^XLFDT($PIECE(DATA,U,2))
+36 SET END=$$FMTE^XLFDT($PIECE(DATA,U,3))
+37 WRITE !!,MEM,?5,START," TO ",END
End DoDot:2
+38 ;
ASK ; Ask user to select which memorandum they want
+1 SET END=""
SET END=$ORDER(MEM(END),-1)
+2 WRITE !!,"Enter a number between 1 and ",END,": "
+3 READ ASK:DTIME
+4 SET ASK=$$UPPER^PRSRUTL(ASK)
+5 IF ASK=""!(ASK="^")
SET MIEN=0
QUIT
+6 IF '$DATA(MEM(ASK))
Begin DoDot:2
+7 WRITE !!,"Enter a number between 1 and ",END," or ^ to exit"
End DoDot:2
GOTO ASK
+8 SET MIEN=$PIECE(MEM(ASK),U,1)
End DoDot:1
+9 QUIT
+10 ;
DISPLAY ; Display memorandum info to validate the correct employee was chosen
+1 SET SCRTTL="Terminate PT Physician Memoranda"
+2 DO HDR^PRSPUT1(PRSIEN,SCRTTL)
+3 DO MEM^PRSPUT1(PRSIEN,MIEN)
+4 DO AL^PRSPUT3(PRSIEN,)
+5 DO PPSUM^PRSPUT2(PRSIEN,MIEN)
+6 SET DIR(0)="E"
SET DIR("A")="Press RETURN to continue"
DO ^DIR
+7 QUIT
+8 ;
TDATE ; Prompt for Termination Date
+1 SET DATA0=$GET(^PRST(458.7,MIEN,0))
+2 SET (STDAT,STDATI)=$PIECE(DATA0,U,2)
SET (ENDAT,ENDATI)=$PIECE(DATA0,U,3)
+3 SET Y=STDAT
+4 DO DD^%DT
+5 SET STDAT=Y
+6 SET Y=ENDAT
+7 DO DD^%DT
+8 SET ENDAT=Y
+9 SET TDAT=0
+10 WRITE !!,"Termination date must be the last day of a pay period."
+11 WRITE !,"Start Date: ",STDAT," End Date: ",ENDAT,!
+12 SET %DT="AEX"
SET %DT("A")="Termination Date: "
SET QUIT=0
+13 FOR
Begin DoDot:1
+14 NEW DAY14,TPPI
+15 DO ^%DT
+16 IF X=""!(X="^")
SET QUIT=1
QUIT
+17 ; Validate that the Termination Date is the last day of a Pay Period.
+18 SET TDATE=+Y
+19 if TDATE="^"
QUIT
+20 SET D1=TDATE
+21 ; PPI and Day are set here
DO PP^PRSAPPU
+22 ; termination pay period IEN (if open)
SET TPPI=$GET(PPI)
+23 IF DAY'=14
Begin DoDot:2
+24 WRITE !!,"The Termination Date must be the last day of a Pay Period."
+25 WRITE !,"Please re-enter.",!
End DoDot:2
QUIT
+26 IF TDATE<STDATI
Begin DoDot:2
+27 WRITE !!,"The Termination Date can not be prior to the Start Date: ",STDAT
+28 WRITE !,"Please re-enter.",!
End DoDot:2
QUIT
+29 IF TDATE'<ENDATI
Begin DoDot:2
+30 WRITE !!,"The Termination Date must be prior to the End Date: ",ENDAT
+31 WRITE !,"Please re-enter.",!
End DoDot:2
QUIT
+32 ;
+33 ; Check to make sure that no Timecards for PPs after the termination
+34 ; date have a status of Payroll or Transmitted.
+35 ; PP containing termination date is not open
IF 'TPPI
SET QUIT=1
QUIT
+36 ; loop thru PPs after the PP of terminatio and check their status
+37 ; init # of PPs that have status which prevents termination
SET FPPESR=0
+38 SET PPI=TPPI
FOR
SET PPI=$ORDER(^PRST(458,PPI))
if 'PPI
QUIT
Begin DoDot:2
+39 ; last day of PPI
SET DAY14=$PIECE($GET(^PRST(458,PPI,1)),U,14)
+40 ; pay period is after end of memo
if DAY14>ENDATI
QUIT
+41 SET STATUS=$PIECE($GET(^PRST(458,PPI,"E",PRSIEN,0)),U,2)
+42 ; quit if status not P or X
if "^P^X^"'[(U_STATUS_U)
QUIT
+43 ; timecard has a status that prevents termination
+44 SET FPPESR=FPPESR+1
+45 SET STATEX=$$EXTERNAL^DILFD(458.01,1,"",STATUS)
+46 WRITE !,$PIECE($GET(^PRST(458,PPI,0)),U),?10,STATEX
End DoDot:2
if DAY14>ENDATI
QUIT
+47 ;
+48 ; All tests passed. Termination date is OK
IF FPPESR=0
SET QUIT=1
QUIT
+49 ;
+50 WRITE !!,"You cannot select this Pay Period because there "
+51 WRITE $SELECT(FPPESR=1:"is ",1:"are "),FPPESR," Pay Period"
+52 WRITE $SELECT(FPPESR>1:"s ",1:" "),"after this"
+53 WRITE !,"Pay Period where the timecard",$SELECT(FPPESR=1:" has ",1:"s have ")
+54 WRITE "a status other than Timekeeper.",!!
End DoDot:1
if QUIT
QUIT
+55 QUIT
+56 ;
TCOM ; Termination Comments
+1 WRITE !
+2 SET DIR(0)="FO^1:240^^O"
SET DIR("A")="Termination Comments"
DO ^DIR
+3 SET TCOM=Y
+4 QUIT
+5 ;
ESIG ; Prompt for Electronic Signature and store fields in #458.7
+1 ;
+2 NEW ESOK,PPE,PPNUM,RCALFLG
+3 DO ^PRSAES
+4 IF ESOK
Begin DoDot:1
+5 ; Update #458.7
+6 SET MIEN=MIEN_","
+7 ; TERMINATION DATE
SET PRSFDA(458.7,MIEN,22)=TDATE
+8 ; TERMINATED BY
SET PRSFDA(458.7,MIEN,23)=DUZ
+9 DO NOW^%DTC
+10 ; TERMINATED DATE/TIME
SET PRSFDA(458.7,MIEN,24)=%
+11 ; TERMINATION COMMENTS
SET PRSFDA(458.7,MIEN,25)=TCOM
+12 DO UPDATE^DIE("","PRSFDA","MIEN")
DO MSG^DIALOG()
+13 ; Remove comma from end
SET MIEN=+MIEN
+14 ;
+15 ; Check for PP that need to have their ESR's deleted
+16 SET X1=TDATE
SET X2=1
+17 DO C^%DTC
+18 SET PPI=+$GET(^PRST(458,"AD",X))
+19 ; There aren't any pay periods opened after the termination date
if 'PPI
QUIT
+20 ;
+21 ; init PPI to include 1st PP in loop
SET PPI=PPI-.01
+22 FOR
SET PPI=$ORDER(^PRST(458,PPI))
if 'PPI
QUIT
Begin DoDot:2
+23 ; skip PP if no timecard/ESR
if '$DATA(^PRST(458,PPI,"E",PRSIEN,0))
QUIT
+24 ;
+25 ; Check for previously saved hours for this PP
+26 SET RCALFLG=0
+27 SET PPE=$PIECE($GET(^PRST(458,PPI,0)),U,1)
+28 SET PPNUM=$ORDER(^PRST(458.7,MIEN,9,"B",PPE,0))
+29 if PPNUM'>0
QUIT
+30 SET RCALFLG=$SELECT($PIECE($GET(^PRST(458.7,MIEN,9,PPNUM,0)),U,1)'="":1,1:0)
+31 ;
+32 FOR DAY=1:1:14
Begin DoDot:3
+33 SET ESRSTAT=$PIECE($GET(^PRST(458,PPI,"E",PRSIEN,"D",DAY,7)),U,1)
+34 ; Clear Time Card posting information
IF ESRSTAT=5
Begin DoDot:4
+35 KILL ^PRST(458,PPI,"E",PRSIEN,"D",DAY,2),^(3),^(10)
End DoDot:4
+36 ;
+37 ; delete any ESR data
+38 ; use fileman to delete ESR DAILY STATUS so x-ref will get updated
+39 SET PRSFDA(458.02,DAY_","_PRSIEN_","_PPI_",",146)="@"
+40 DO FILE^DIE("","PRSFDA")
DO MSG^DIALOG()
+41 ; delete ESR related fields
+42 KILL ^PRST(458,PPI,"E",PRSIEN,"D",DAY,5),^(6),^(7)
End DoDot:3
+43 ;
+44 ; If the PP had been certified before, re-calculate totals
+45 IF RCALFLG
DO PTP^PRSASR1(PRSIEN,PPI)
End DoDot:2
End DoDot:1
+46 QUIT
+47 ;
KILL ; Clean up variables
+1 ;
+2 KILL ASK,D1,DA,DATA,DATA0,DAY,DIR,DIRUT,END,ENDAT,ENDATI,ESRSTAT
+3 KILL FPPESR,I,INDX,MEM,MIEN,PPE,PPI,PRSIEN,PRSFDA,QUIT,QUIT1
+4 KILL SCRTTL,START,STATEX,STATUS,STDAT,STDATI,TCOM
+5 KILL TDAT,TDATE,TDATI,X,X1,X2,Y,%,%DT
+6 KILL ^TMP($JOB,"PRSPTM")
+7 QUIT
