- PSOCPBK3 ;BIR/GN-Copay Back Bill for Automated-release refills ;10/6/05 4:57pm
- ;;7.0;OUTPATIENT PHARMACY;**217**;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="Back Bill"
- ;
- 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,"BACK BILLING of unbilled copays for refills via OPAI, PSO*7*217",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 Back-Billing"
- . . 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 Back-Billing process? "
- . 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 BACK-BILLING *****")
- ;
- 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(DTOUT)!($D(DUOUT)) W !,"Halting..." S ZTDTH="" Q
- . 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_" unbilled refills...")
- D MES^XPDUTL("Start time: "_$$HTE^XLFDT(ZTDTH))
- D MES^XPDUTL("===================================================")
- I ZTDTH="" D BMES^XPDUTL(JOBN_" NOT QUEUED") D QUIT Q
- ;
- 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^PSOCPBK3",ZTIO=""
- S ZTDESC="Background job to "_JOBN_" unbilled copays for refills via OPAI"
- 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 PSODT,RXP,PSOTEXT,XX,YY,PSOCNT,PSOSTART,PSOEND,PSOVETS,PSOTRX,XIEN
- N PSOSCMX,PSODFN,PSOREL,PSOAMT,FOUND,V24,PSOTRF,PSOEND2,PSOSTRT2,CC
- N PSOTIME,PSOSTNM,PSOS1,PSOINST,I,PSOTC,PSOCNTS,LIN,%,X1,XMY,STO
- 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*156 (OPAI)
- 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)="OPAI PATCH PSO*7*156 IS NOT INSTALLED"
- . S $P(^XTMP(NAMSP,0,"LAST"),"^",1,2)="COMPLETED^"_$$NOW^XLFDT
- . D MAIL3^PSOCPBK5(^XTMP(NAMSP,0,.1))
- ;
- ;check if any division is on v2.4 (OPAI interface)
- S V24=0
- F XX=0:0 S XX=$O(^PS(59,XX)) Q:'XX D Q:V24
- . S:+$G(^PS(59,XX,"DISP"))=2.4 V24=1
- I 'V24 D Q
- . S ^XTMP(NAMSP,0,.2)="OPAI IS INSTALLED BUT IS NOT TURNED ON"
- . S $P(^XTMP(NAMSP,0,"LAST"),"^",1,2)="COMPLETED^"_$$NOW^XLFDT
- . D MAIL3^PSOCPBK5(^XTMP(NAMSP,0,.2))
- ;
- 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("AL",PSODT)) Q:'PSODT D Q:STOP
- . I CC#100=0,$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("AL",PSODT,RXP)) Q:'RXP D
- .. ;save last date & fill info
- .. S $P(^XTMP(NAMSP,0,"LAST"),"^",3,5)=PSODT_"^"_RXP_"^"_PSOTRX
- .. S PSODFN=$P($G(^PSRX(RXP,0)),"^",2)
- .. Q:('PSODFN)!('$D(^DPT(PSODFN,0))) ;quit, no valid DFN info
- .. D XTYPE^PSOCPBK4
- .. Q:+PSOSCMX=0 ;quit, Exempt or deceased
- .. ;search refills only, ignore 0=orig fill
- .. F YY=0:0 S YY=$O(^PSRX("AL",PSODT,RXP,YY)) Q:'YY D ADDBILL^PSOCPBK4
- Q:STOP
- ;
- S PSOCNT=0
- D BILLIT^PSOCPBK4 Q:STOP
- D TOTAL^PSOCPBK4
- S $P(^XTMP(NAMSP,0,"LAST"),"^",1,2)="COMPLETED^"_$$NOW^XLFDT
- D MAIL^PSOCPBK5
- D MAIL2^PSOCPBK5
- D MAILAAC^PSOCPBK5
- L -^XTMP(NAMSP)
- 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 Tally Job - set to STOP Soon"
- . W !!,"Check Status to be sure it has stopped and is not running..."
- . W !," (D STATUS^PSOCPBK3)"
- 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[HPSOCPBK3 6584 printed Mar 13, 2025@21:30:40 Page 2
- PSOCPBK3 ;BIR/GN-Copay Back Bill for Automated-release refills ;10/6/05 4:57pm
- +1 ;;7.0;OUTPATIENT PHARMACY;**217**;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="Back Bill"
- +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,"BACK BILLING of unbilled copays for refills via OPAI, PSO*7*217",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 Back-Billing"
- +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 Back-Billing process? "
- +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 BACK-BILLING *****")
- 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(DTOUT)!($DATA(DUOUT))
- WRITE !,"Halting..."
- SET ZTDTH=""
- QUIT
- +52 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_" unbilled refills...")
- +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 $PIECE($GET(^XTMP(NAMSP,0,"LAST")),"^")="STOP"
- Begin DoDot:1
- +64 SET $PIECE(^XTMP(NAMSP,0,"LAST"),"^",1,2)="RUN^"_$$NOW^XLFDT
- End DoDot:1
- +65 IF '$TEST
- Begin DoDot:1
- +66 SET ^XTMP(NAMSP,0,"LAST")="RUN^"_$$NOW^XLFDT_"^^^"
- End DoDot:1
- +67 ;
- +68 SET ZTRTN="EN^PSOCPBK3"
- SET ZTIO=""
- +69 SET ZTDESC="Background job to "_JOBN_" unbilled copays for refills via OPAI"
- +70 SET ZTSAVE("JOBN")=""
- +71 LOCK -^XTMP(NAMSP)
- +72 DO ^%ZTLOAD
- +73 if $DATA(ZTSK)
- Begin DoDot:1
- +74 DO MES^XPDUTL("*** Task #"_ZTSK_" Queued! ***")
- +75 DO BMES^XPDUTL("")
- End DoDot:1
- +76 DO BMES^XPDUTL("")
- +77 KILL XPDQUES
- +78 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 PSODT,RXP,PSOTEXT,XX,YY,PSOCNT,PSOSTART,PSOEND,PSOVETS,PSOTRX,XIEN
- +8 NEW PSOSCMX,PSODFN,PSOREL,PSOAMT,FOUND,V24,PSOTRF,PSOEND2,PSOSTRT2,CC
- +9 NEW PSOTIME,PSOSTNM,PSOS1,PSOINST,I,PSOTC,PSOCNTS,LIN,%,X1,XMY,STO
- +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*156 (OPAI)
- +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)="OPAI PATCH PSO*7*156 IS NOT INSTALLED"
- +21 SET $PIECE(^XTMP(NAMSP,0,"LAST"),"^",1,2)="COMPLETED^"_$$NOW^XLFDT
- +22 DO MAIL3^PSOCPBK5(^XTMP(NAMSP,0,.1))
- End DoDot:1
- QUIT
- +23 ;
- +24 ;check if any division is on v2.4 (OPAI interface)
- +25 SET V24=0
- +26 FOR XX=0:0
- SET XX=$ORDER(^PS(59,XX))
- if 'XX
- QUIT
- Begin DoDot:1
- +27 if +$GET(^PS(59,XX,"DISP"))=2.4
- SET V24=1
- End DoDot:1
- if V24
- QUIT
- +28 IF 'V24
- Begin DoDot:1
- +29 SET ^XTMP(NAMSP,0,.2)="OPAI IS INSTALLED BUT IS NOT TURNED ON"
- +30 SET $PIECE(^XTMP(NAMSP,0,"LAST"),"^",1,2)="COMPLETED^"_$$NOW^XLFDT
- +31 DO MAIL3^PSOCPBK5(^XTMP(NAMSP,0,.2))
- End DoDot:1
- QUIT
- +32 ;
- +33 SET (PSOTRX,PSOTRF)=1
- +34 ;init stop flag to 0
- NEW STOP
- KILL ^XTMP(NAMSP,0,"STOP")
- SET STOP=0
- +35 FOR CC=1:1
- SET PSODT=$ORDER(^PSRX("AL",PSODT))
- if 'PSODT
- QUIT
- Begin DoDot:1
- +36 IF CC#100=0
- IF $DATA(^XTMP(NAMSP,0,"STOP"))
- Begin DoDot:2
- +37 SET $PIECE(^XTMP(NAMSP,0,"LAST"),"^",1,2)="STOP^"_$$NOW^XLFDT
- SET STOP=1
- End DoDot:2
- QUIT
- +38 FOR PSOTRX=PSOTRX+1:1
- SET RXP=$ORDER(^PSRX("AL",PSODT,RXP))
- if 'RXP
- QUIT
- Begin DoDot:2
- +39 ;save last date & fill info
- +40 SET $PIECE(^XTMP(NAMSP,0,"LAST"),"^",3,5)=PSODT_"^"_RXP_"^"_PSOTRX
- +41 SET PSODFN=$PIECE($GET(^PSRX(RXP,0)),"^",2)
- +42 ;quit, no valid DFN info
- if ('PSODFN)!('$DATA(^DPT(PSODFN,0)))
- QUIT
- +43 DO XTYPE^PSOCPBK4
- +44 ;quit, Exempt or deceased
- if +PSOSCMX=0
- QUIT
- +45 ;search refills only, ignore 0=orig fill
- +46 FOR YY=0:0
- SET YY=$ORDER(^PSRX("AL",PSODT,RXP,YY))
- if 'YY
- QUIT
- DO ADDBILL^PSOCPBK4
- End DoDot:2
- End DoDot:1
- if STOP
- QUIT
- +47 if STOP
- QUIT
- +48 ;
- +49 SET PSOCNT=0
- +50 DO BILLIT^PSOCPBK4
- if STOP
- QUIT
- +51 DO TOTAL^PSOCPBK4
- +52 SET $PIECE(^XTMP(NAMSP,0,"LAST"),"^",1,2)="COMPLETED^"_$$NOW^XLFDT
- +53 DO MAIL^PSOCPBK5
- +54 DO MAIL2^PSOCPBK5
- +55 DO MAILAAC^PSOCPBK5
- +56 LOCK -^XTMP(NAMSP)
- +57 if $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +58 KILL JOBN
- +59 QUIT
- +60 ;
- 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 Tally Job - set to STOP Soon"
- +3 WRITE !!,"Check Status to be sure it has stopped and is not running..."
- +4 WRITE !," (D STATUS^PSOCPBK3)"
- 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)