PSOCIDC1 ;BIR/LE-Copay Correction of erroneous billed copays ;11/8/05 12:50pm
;;7.0;OUTPATIENT PHARMACY;**226**;DEC 1997
;External reference to ^XUSEC supported by DBIA 10076
;External reference to IBARX supported by DBIA 125
;External reference to $$PROD^XUPROD(1) supported by DBIA 4440
;
N NAMSP,DTOUT,DUOUT,ZTSK,ZTRTN,ZTIO,ZTDTH,ZTDESC,QUIT,RUNOPT,JOBN,Y
S NAMSP=$$NAMSP
S JOBN="CANCEL COPAY"
;
L +^XTMP(NAMSP):0 I '$T D Q
. D BMES^XPDUTL(JOBN_" job is already running. Halting...")
. D MES^XPDUTL("")
. D QUIT
;
I '$D(^XTMP(NAMSP)) D INITXTMP(NAMSP,"Correct erroneously billed copays, PSO*7*226",90) ;90 day life
S QUIT=0
;
;ques 1, if running from mumps prompt
I '$D(XPDQUES("POS1")) D I QUIT D QUIT Q
. ;selected cancel run at last install, dont allow to run manually
. I $G(^XTMP(NAMSP,0,"LAST"))["CANCEL" D Q
. . S QUIT=1
. . W !!,*7,"The last install of this patch you selected to NOT Run the Copay Correction process."
. . W !,"If you have changed your mind, you must re-install the patch to run",!!
. K DIR
. S DIR("A",1)="****************** SELECT RUN OPTION ******************"
. S DIR("A")="Do you want to run the Copay Correction process? Y or N//"
. S DIR(0)="YA^^"
. D ^DIR I $D(DTOUT)!($D(DUOUT)) W !,"Halting..." S QUIT=1 Q
. S RUNOPT=Y
. S:'RUNOPT QUIT=1
;
;ques 1, if running from kids install
I $D(XPDQUES("POS1")) D I 'RUNOPT D QUIT Q
. S RUNOPT=XPDQUES("POS1")
. S:'RUNOPT ^XTMP(NAMSP,0,"LAST")="CANCEL RUN^"_$$NOW^XLFDT_"^^^"
. D BMES^XPDUTL("***** SELECTED "_$S('RUNOPT:"NOT ",1:"")_"TO RUN THE COPAY CORRECTION PROCESS *****")
;
I $G(^XTMP(NAMSP,0,"LAST"))["COMPLETED" D Q
. W !!,*7,"This job has been run before to completion on "
. W $$FMTE^XLFDT($P($G(^XTMP(NAMSP,0,"LAST")),"^",2)),!!
. D QUIT
;
;ques 2, if running from mumps prompt
I '$D(XPDQUES("POS2")) D I 'ZTDTH D QUIT Q
. K DIR
. S DIR("A")="Enter when to Queue the "_JOBN_" job to run in date@time format "
. S DIR("B")="NOW"
. S DIR(0)="D^::%DT"
. S DIR("?")="Enter when to start the job. The default is Now. You can enter a date and time in the format like this: 081505@3:30p"
. D ^DIR I $D(DUOUT) W !,"Halting..." S ZTDTH="" Q
. S:$D(DTOUT) Y=$$NOW^XLFDT S ZTDTH=$$FMTH^XLFDT(Y)
;
;ques 2, if running from kids install
I $D(XPDQUES("POS2")) S ZTDTH=$$FMTH^XLFDT(XPDQUES("POS2"))
;
D BMES^XPDUTL("===================================================")
D MES^XPDUTL("Queuing background job to "_JOBN_" erroneous billed copays...")
D MES^XPDUTL("Start time: "_$$HTE^XLFDT(ZTDTH))
D MES^XPDUTL("===================================================")
I ZTDTH="" D BMES^XPDUTL(JOBN_" NOT QUEUED") D QUIT Q
;
S:$D(^XTMP(NAMSP,0,"LAST")) ^XTMP(NAMSP,0,"ZAUDIT",$H)="RE-STARTED ON"_"^"_$$NOW^XLFDT_"^"_$P(^XTMP(NAMSP,0,"LAST"),"^",2,5)
;
I $P($G(^XTMP(NAMSP,0,"LAST")),"^")="STOP" D
. S $P(^XTMP(NAMSP,0,"LAST"),"^",1,2)="RUN^"_$$NOW^XLFDT
E D
. S ^XTMP(NAMSP,0,"LAST")="RUN^"_$$NOW^XLFDT_"^^^"
;
S ZTRTN="EN^PSOCIDC1",ZTIO=""
S ZTDESC="Background job to "_JOBN_" for erroneously billed copays via PSO*7*143"
S ZTSAVE("JOBN")=""
L -^XTMP(NAMSP)
D ^%ZTLOAD
D:$D(ZTSK)
. D MES^XPDUTL("*** Task #"_ZTSK_" Queued! ***")
. D BMES^XPDUTL("")
D BMES^XPDUTL("")
K XPDQUES
Q
QUIT ;
L -^XTMP(NAMSP)
Q
EN ;
N NAMSP S NAMSP=$$NAMSP
;if can't get Lock, then already running.
L +^XTMP(NAMSP):3 I '$T D Q
. S:$D(ZTQUEUED) ZTREQ="@"
. S $P(^XTMP(NAMSP,0,"LAST"),"^",1,2)="LOCKED^"_$$NOW^XLFDT
;
N DFN,PSODT,RXP,PSOTEXT,XX,YY,PSOCNT,PSOUCNT,PSOCCNT,PSOSTART,PSOEND,PSOVETS,PSOCVETS,PSOUVETS,PSOTRX,XIEN
N PSOSCMX,PSODFN,PSOUDFN,PSOREL,PSOAMT,PSOCAMT,PSOUAMT,FOUND,PSOTRF,PSOEND2,PSOSTRT2,CC
N PSOTIME,PSOSTNM,PSOS1,PSOINST,I,PSOTC,PSOCNTS,PSOUCNTS,PSOCCNTS,LIN,%,X1,XMY,STO,PSOSCP
D NOW^%DTC S (Y,PSOS1)=% D DD^%DT S PSOSTART=Y
S PSOSTRT2=$$FMTE^XLFDT(%,"1PS")
I '$G(DT) S DT=$$DT^XLFDT
S PSODT=+$P($G(^XTMP(NAMSP,0,"LAST")),"^",3)
S RXP=+$P($G(^XTMP(NAMSP,0,"LAST")),"^",4)
;
;get 1st occurence of install date of patch PSO*7*143 (CIDC)
S XIEN=+$O(^XPD(9.7,"B","PSO*7.0*156",0))
S:'PSODT PSODT=+$P($G(^XPD(9.7,XIEN,1)),"^",3)
I 'PSODT D Q
. S ^XTMP(NAMSP,0,.1)="CIDC PATCH PSO*7*143 IS NOT INSTALLED"
. S $P(^XTMP(NAMSP,0,"LAST"),"^",1,2)="COMPLETED^"_$$NOW^XLFDT
. D MAIL3^PSOCIDC3(^XTMP(NAMSP,0,.1))
;
S (PSOTRX,PSOTRF)=1
N STOP K ^XTMP(NAMSP,0,"STOP") S STOP=0 ;init stop flag to 0
F CC=1:1 S PSODT=$O(^PSRX("AD",PSODT)) Q:'PSODT D Q:STOP ;FINISH DATE
. I $D(^XTMP(NAMSP,0,"STOP")) D Q
. . S $P(^XTMP(NAMSP,0,"LAST"),"^",1,2)="STOP^"_$$NOW^XLFDT,STOP=1
. F PSOTRX=PSOTRX+1:1 S RXP=$O(^PSRX("AD",PSODT,RXP)) Q:'RXP D
.. Q:'$D(^PSRX(RXP,"ICD",0))
.. ;save last date & fill info
.. S $P(^XTMP(NAMSP,0,"LAST"),"^",3,5)=PSODT_"^"_RXP_"^"_PSOTRX
.. S (DFN,PSODFN)=$P($G(^PSRX(RXP,0)),"^",2)
.. Q:('PSODFN)!('$D(^DPT(PSODFN,0))) ;quit, no valid DFN info
.. D ELIG^VADPT S PSOSCP="",PSOSCP=$P(VAEL(3),U,2) K VAEL ;SC percentage
.. ;search all fills
.. S YY="" F S YY=$O(^PSRX("AD",PSODT,RXP,YY)) Q:YY="" D:PSOSCP<50 CHECK^PSOCIDC2
G STP:STOP
;
S (PSOUCNT,PSOCNT,PSOCCNT)=0
D CANCEL^PSOCIDC2 G STP:STOP
D TOTAL^PSOCIDC2
S $P(^XTMP(NAMSP,0,"LAST"),"^",1,2)="COMPLETED^"_$$NOW^XLFDT
D MAIL^PSOCIDC4
D MAIL2^PSOCIDC4
STP ;
L -^XTMP(NAMSP)
I $D(^XTMP(NAMSP,0,"STOP")) S ^XTMP(NAMSP,0,"ZAUDIT",$H)="STOPPED ON"_"^"_$P(^XTMP(NAMSP,0,"LAST"),"^",2,5)
S:$D(ZTQUEUED) ZTREQ="@"
K JOBN
Q
;
STATUS ;show status of job running
I $$ST D
. W !,"Currently processing:"
. I ^XTMP($$NAMSP,0,"LAST")["COMPLETED" D
. . W !,"COMPLETED ON ",$$FMTE^XLFDT($P($G(^XTMP($$NAMSP,0,"LAST")),"^",2)),!
. W !?5,"Released Date > ",$P(^XTMP($$NAMSP,0,"LAST"),"^",3)
. W !?5," RX # > ",$P(^XTMP($$NAMSP,0,"LAST"),"^",4)
. W !?5," TOTAL RX's > ",$P(^XTMP($$NAMSP,0,"LAST"),"^",5),!
. E D
. I ^XTMP($$NAMSP,0,"LAST")["COMPLETED" D
. . W !,"COMPLETED ON ",$$FMTE^XLFDT($P($G(^XTMP($$NAMSP,0,"LAST")),"^",2)),!
Q
;
STOP ;stop job command
I $$ST S ^XTMP($$NAMSP,0,"STOP")="" D
. W !,"Outpatient RX Copay Correction Job - set to STOP Soon"
. W !!,"Check Status to be sure it has stopped and is not running..."
. W !," (D STATUS^PSOCIDC1)"
Q
ST() ;status
L +^XTMP($$NAMSP):3 I $T D Q 0
. L -^XTMP($$NAMSP)
. W !,"*** NOT CURRENTLY RUNNING! ***",!
Q 1
INITXTMP(NAMSP,TITLE,LIFE) ;create ^Xtmp according to SAC std
N BEGDT,PURGDT
S BEGDT=$$NOW^XLFDT()
S PURGDT=$$FMADD^XLFDT(BEGDT,LIFE)
S ^XTMP(NAMSP,0)=PURGDT_"^"_BEGDT_"^"_TITLE
Q
NAMSP() ;
Q $T(+0)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOCIDC1 6657 printed Sep 23, 2025@20:01:32 Page 2
PSOCIDC1 ;BIR/LE-Copay Correction of erroneous billed copays ;11/8/05 12:50pm
+1 ;;7.0;OUTPATIENT PHARMACY;**226**;DEC 1997
+2 ;External reference to ^XUSEC supported by DBIA 10076
+3 ;External reference to IBARX supported by DBIA 125
+4 ;External reference to $$PROD^XUPROD(1) supported by DBIA 4440
+5 ;
+6 NEW NAMSP,DTOUT,DUOUT,ZTSK,ZTRTN,ZTIO,ZTDTH,ZTDESC,QUIT,RUNOPT,JOBN,Y
+7 SET NAMSP=$$NAMSP
+8 SET JOBN="CANCEL COPAY"
+9 ;
+10 LOCK +^XTMP(NAMSP):0
IF '$TEST
Begin DoDot:1
+11 DO BMES^XPDUTL(JOBN_" job is already running. Halting...")
+12 DO MES^XPDUTL("")
+13 DO QUIT
End DoDot:1
QUIT
+14 ;
+15 ;90 day life
IF '$DATA(^XTMP(NAMSP))
DO INITXTMP(NAMSP,"Correct erroneously billed copays, PSO*7*226",90)
+16 SET QUIT=0
+17 ;
+18 ;ques 1, if running from mumps prompt
+19 IF '$DATA(XPDQUES("POS1"))
Begin DoDot:1
+20 ;selected cancel run at last install, dont allow to run manually
+21 IF $GET(^XTMP(NAMSP,0,"LAST"))["CANCEL"
Begin DoDot:2
+22 SET QUIT=1
+23 WRITE !!,*7,"The last install of this patch you selected to NOT Run the Copay Correction process."
+24 WRITE !,"If you have changed your mind, you must re-install the patch to run",!!
End DoDot:2
QUIT
+25 KILL DIR
+26 SET DIR("A",1)="****************** SELECT RUN OPTION ******************"
+27 SET DIR("A")="Do you want to run the Copay Correction process? Y or N//"
+28 SET DIR(0)="YA^^"
+29 DO ^DIR
IF $DATA(DTOUT)!($DATA(DUOUT))
WRITE !,"Halting..."
SET QUIT=1
QUIT
+30 SET RUNOPT=Y
+31 if 'RUNOPT
SET QUIT=1
End DoDot:1
IF QUIT
DO QUIT
QUIT
+32 ;
+33 ;ques 1, if running from kids install
+34 IF $DATA(XPDQUES("POS1"))
Begin DoDot:1
+35 SET RUNOPT=XPDQUES("POS1")
+36 if 'RUNOPT
SET ^XTMP(NAMSP,0,"LAST")="CANCEL RUN^"_$$NOW^XLFDT_"^^^"
+37 DO BMES^XPDUTL("***** SELECTED "_$SELECT('RUNOPT:"NOT ",1:"")_"TO RUN THE COPAY CORRECTION PROCESS *****")
End DoDot:1
IF 'RUNOPT
DO QUIT
QUIT
+38 ;
+39 IF $GET(^XTMP(NAMSP,0,"LAST"))["COMPLETED"
Begin DoDot:1
+40 WRITE !!,*7,"This job has been run before to completion on "
+41 WRITE $$FMTE^XLFDT($PIECE($GET(^XTMP(NAMSP,0,"LAST")),"^",2)),!!
+42 DO QUIT
End DoDot:1
QUIT
+43 ;
+44 ;ques 2, if running from mumps prompt
+45 IF '$DATA(XPDQUES("POS2"))
Begin DoDot:1
+46 KILL DIR
+47 SET DIR("A")="Enter when to Queue the "_JOBN_" job to run in date@time format "
+48 SET DIR("B")="NOW"
+49 SET DIR(0)="D^::%DT"
+50 SET DIR("?")="Enter when to start the job. The default is Now. You can enter a date and time in the format like this: 081505@3:30p"
+51 DO ^DIR
IF $DATA(DUOUT)
WRITE !,"Halting..."
SET ZTDTH=""
QUIT
+52 if $DATA(DTOUT)
SET Y=$$NOW^XLFDT
SET ZTDTH=$$FMTH^XLFDT(Y)
End DoDot:1
IF 'ZTDTH
DO QUIT
QUIT
+53 ;
+54 ;ques 2, if running from kids install
+55 IF $DATA(XPDQUES("POS2"))
SET ZTDTH=$$FMTH^XLFDT(XPDQUES("POS2"))
+56 ;
+57 DO BMES^XPDUTL("===================================================")
+58 DO MES^XPDUTL("Queuing background job to "_JOBN_" erroneous billed copays...")
+59 DO MES^XPDUTL("Start time: "_$$HTE^XLFDT(ZTDTH))
+60 DO MES^XPDUTL("===================================================")
+61 IF ZTDTH=""
DO BMES^XPDUTL(JOBN_" NOT QUEUED")
DO QUIT
QUIT
+62 ;
+63 if $DATA(^XTMP(NAMSP,0,"LAST"))
SET ^XTMP(NAMSP,0,"ZAUDIT",$HOROLOG)="RE-STARTED ON"_"^"_$$NOW^XLFDT_"^"_$P(^XTMP(NAMSP,0,"LAST"),"^",2,5)
+64 ;
+65 IF $PIECE($GET(^XTMP(NAMSP,0,"LAST")),"^")="STOP"
Begin DoDot:1
+66 SET $PIECE(^XTMP(NAMSP,0,"LAST"),"^",1,2)="RUN^"_$$NOW^XLFDT
End DoDot:1
+67 IF '$TEST
Begin DoDot:1
+68 SET ^XTMP(NAMSP,0,"LAST")="RUN^"_$$NOW^XLFDT_"^^^"
End DoDot:1
+69 ;
+70 SET ZTRTN="EN^PSOCIDC1"
SET ZTIO=""
+71 SET ZTDESC="Background job to "_JOBN_" for erroneously billed copays via PSO*7*143"
+72 SET ZTSAVE("JOBN")=""
+73 LOCK -^XTMP(NAMSP)
+74 DO ^%ZTLOAD
+75 if $DATA(ZTSK)
Begin DoDot:1
+76 DO MES^XPDUTL("*** Task #"_ZTSK_" Queued! ***")
+77 DO BMES^XPDUTL("")
End DoDot:1
+78 DO BMES^XPDUTL("")
+79 KILL XPDQUES
+80 QUIT
QUIT ;
+1 LOCK -^XTMP(NAMSP)
+2 QUIT
EN ;
+1 NEW NAMSP
SET NAMSP=$$NAMSP
+2 ;if can't get Lock, then already running.
+3 LOCK +^XTMP(NAMSP):3
IF '$TEST
Begin DoDot:1
+4 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+5 SET $PIECE(^XTMP(NAMSP,0,"LAST"),"^",1,2)="LOCKED^"_$$NOW^XLFDT
End DoDot:1
QUIT
+6 ;
+7 NEW DFN,PSODT,RXP,PSOTEXT,XX,YY,PSOCNT,PSOUCNT,PSOCCNT,PSOSTART,PSOEND,PSOVETS,PSOCVETS,PSOUVETS,PSOTRX,XIEN
+8 NEW PSOSCMX,PSODFN,PSOUDFN,PSOREL,PSOAMT,PSOCAMT,PSOUAMT,FOUND,PSOTRF,PSOEND2,PSOSTRT2,CC
+9 NEW PSOTIME,PSOSTNM,PSOS1,PSOINST,I,PSOTC,PSOCNTS,PSOUCNTS,PSOCCNTS,LIN,%,X1,XMY,STO,PSOSCP
+10 DO NOW^%DTC
SET (Y,PSOS1)=%
DO DD^%DT
SET PSOSTART=Y
+11 SET PSOSTRT2=$$FMTE^XLFDT(%,"1PS")
+12 IF '$GET(DT)
SET DT=$$DT^XLFDT
+13 SET PSODT=+$PIECE($GET(^XTMP(NAMSP,0,"LAST")),"^",3)
+14 SET RXP=+$PIECE($GET(^XTMP(NAMSP,0,"LAST")),"^",4)
+15 ;
+16 ;get 1st occurence of install date of patch PSO*7*143 (CIDC)
+17 SET XIEN=+$ORDER(^XPD(9.7,"B","PSO*7.0*156",0))
+18 if 'PSODT
SET PSODT=+$PIECE($GET(^XPD(9.7,XIEN,1)),"^",3)
+19 IF 'PSODT
Begin DoDot:1
+20 SET ^XTMP(NAMSP,0,.1)="CIDC PATCH PSO*7*143 IS NOT INSTALLED"
+21 SET $PIECE(^XTMP(NAMSP,0,"LAST"),"^",1,2)="COMPLETED^"_$$NOW^XLFDT
+22 DO MAIL3^PSOCIDC3(^XTMP(NAMSP,0,.1))
End DoDot:1
QUIT
+23 ;
+24 SET (PSOTRX,PSOTRF)=1
+25 ;init stop flag to 0
NEW STOP
KILL ^XTMP(NAMSP,0,"STOP")
SET STOP=0
+26 ;FINISH DATE
FOR CC=1:1
SET PSODT=$ORDER(^PSRX("AD",PSODT))
if 'PSODT
QUIT
Begin DoDot:1
+27 IF $DATA(^XTMP(NAMSP,0,"STOP"))
Begin DoDot:2
+28 SET $PIECE(^XTMP(NAMSP,0,"LAST"),"^",1,2)="STOP^"_$$NOW^XLFDT
SET STOP=1
End DoDot:2
QUIT
+29 FOR PSOTRX=PSOTRX+1:1
SET RXP=$ORDER(^PSRX("AD",PSODT,RXP))
if 'RXP
QUIT
Begin DoDot:2
+30 if '$DATA(^PSRX(RXP,"ICD",0))
QUIT
+31 ;save last date & fill info
+32 SET $PIECE(^XTMP(NAMSP,0,"LAST"),"^",3,5)=PSODT_"^"_RXP_"^"_PSOTRX
+33 SET (DFN,PSODFN)=$PIECE($GET(^PSRX(RXP,0)),"^",2)
+34 ;quit, no valid DFN info
if ('PSODFN)!('$DATA(^DPT(PSODFN,0)))
QUIT
+35 ;SC percentage
DO ELIG^VADPT
SET PSOSCP=""
SET PSOSCP=$PIECE(VAEL(3),U,2)
KILL VAEL
+36 ;search all fills
+37 SET YY=""
FOR
SET YY=$ORDER(^PSRX("AD",PSODT,RXP,YY))
if YY=""
QUIT
if PSOSCP<50
DO CHECK^PSOCIDC2
End DoDot:2
End DoDot:1
if STOP
QUIT
+38 if STOP
GOTO STP
+39 ;
+40 SET (PSOUCNT,PSOCNT,PSOCCNT)=0
+41 DO CANCEL^PSOCIDC2
if STOP
GOTO STP
+42 DO TOTAL^PSOCIDC2
+43 SET $PIECE(^XTMP(NAMSP,0,"LAST"),"^",1,2)="COMPLETED^"_$$NOW^XLFDT
+44 DO MAIL^PSOCIDC4
+45 DO MAIL2^PSOCIDC4
STP ;
+1 LOCK -^XTMP(NAMSP)
+2 IF $DATA(^XTMP(NAMSP,0,"STOP"))
SET ^XTMP(NAMSP,0,"ZAUDIT",$HOROLOG)="STOPPED ON"_"^"_$PIECE(^XTMP(NAMSP,0,"LAST"),"^",2,5)
+3 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+4 KILL JOBN
+5 QUIT
+6 ;
STATUS ;show status of job running
+1 IF $$ST
Begin DoDot:1
+2 WRITE !,"Currently processing:"
+3 IF ^XTMP($$NAMSP,0,"LAST")["COMPLETED"
Begin DoDot:2
+4 WRITE !,"COMPLETED ON ",$$FMTE^XLFDT($PIECE($GET(^XTMP($$NAMSP,0,"LAST")),"^",2)),!
End DoDot:2
+5 WRITE !?5,"Released Date > ",$PIECE(^XTMP($$NAMSP,0,"LAST"),"^",3)
+6 WRITE !?5," RX # > ",$PIECE(^XTMP($$NAMSP,0,"LAST"),"^",4)
+7 WRITE !?5," TOTAL RX's > ",$PIECE(^XTMP($$NAMSP,0,"LAST"),"^",5),!
+8 IF '$TEST
Begin DoDot:2
End DoDot:2
+9 IF ^XTMP($$NAMSP,0,"LAST")["COMPLETED"
Begin DoDot:2
+10 WRITE !,"COMPLETED ON ",$$FMTE^XLFDT($PIECE($GET(^XTMP($$NAMSP,0,"LAST")),"^",2)),!
End DoDot:2
End DoDot:1
+11 QUIT
+12 ;
STOP ;stop job command
+1 IF $$ST
SET ^XTMP($$NAMSP,0,"STOP")=""
Begin DoDot:1
+2 WRITE !,"Outpatient RX Copay Correction Job - set to STOP Soon"
+3 WRITE !!,"Check Status to be sure it has stopped and is not running..."
+4 WRITE !," (D STATUS^PSOCIDC1)"
End DoDot:1
+5 QUIT
ST() ;status
+1 LOCK +^XTMP($$NAMSP):3
IF $TEST
Begin DoDot:1
+2 LOCK -^XTMP($$NAMSP)
+3 WRITE !,"*** NOT CURRENTLY RUNNING! ***",!
End DoDot:1
QUIT 0
+4 QUIT 1
INITXTMP(NAMSP,TITLE,LIFE) ;create ^Xtmp according to SAC std
+1 NEW BEGDT,PURGDT
+2 SET BEGDT=$$NOW^XLFDT()
+3 SET PURGDT=$$FMADD^XLFDT(BEGDT,LIFE)
+4 SET ^XTMP(NAMSP,0)=PURGDT_"^"_BEGDT_"^"_TITLE
+5 QUIT
NAMSP() ;
+1 QUIT $TEXT(+0)
