Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSOCIDC7

PSOCIDC7.m

Go to the documentation of this file. 
  1. PSOCIDC7 ;BIR/LE-CIDC Activity logs correction ;2/28/05 12:50pm
  1.  ;;7.0;OUTPATIENT PHARMACY;**239**;DEC 1997
  1.  ;
  1.  Q  ;N NAMSP,DTOUT,DUOUT,ZTSK,ZTRTN,ZTIO,ZTDTH,ZTDESC,QUIT,RUNOPT,JOBN,Y
  1.  S NAMSP=$$NAMSP
  1.  S JOBN="CIDC ACTIVITY LOGS CORRECTION"
  1.  ;
  1.  L +^XTMP(NAMSP):0 I '$T D  Q
  1.  . D BMES^XPDUTL(JOBN_" job is already running.  Halting...")
  1.  . D MES^XPDUTL("")
  1.  . D QUIT
  1.  ;
  1.  I '$D(^XTMP(NAMSP)) D INITXTMP(NAMSP,"Correct CIDC created activity logs, PSO*7*239",90)        ;90 day life
  1.  S QUIT=0
  1.  ;
  1.  ;ques 1, if running from mumps prompt
  1.  I '$D(XPDQUES("POS1")) D  I QUIT D QUIT Q
  1.  . ;selected cancel run at last install, dont allow to run manually
  1.  . I $G(^XTMP(NAMSP,0,"LAST"))["CANCEL" D  Q
  1.  . . S QUIT=1
  1.  . . W !!,*7,"The last install of this patch you selected to NOT Run the Activity Logs Correction process."
  1.  . . W !,"If you have changed your mind, you must re-install the patch to run",!!
  1.  . K DIR
  1.  . S DIR("A",1)="****************** SELECT RUN OPTION ******************"
  1.  . S DIR("A")="Do you want to run the activity logs correction process? Y or N// "
  1.  . S DIR(0)="YA^^"
  1.  . D ^DIR I $D(DTOUT)!($D(DUOUT)) W !,"Halting..." S QUIT=1 Q
  1.  . S RUNOPT=Y
  1.  . S:'RUNOPT QUIT=1
  1.  ;
  1.  ;ques 1, if running from kids install
  1.  I $D(XPDQUES("POS1")) D  I 'RUNOPT D QUIT Q
  1.  . S RUNOPT=XPDQUES("POS1")
  1.  . S:'RUNOPT ^XTMP(NAMSP,0,"LAST")="CANCEL RUN^"_$$NOW^XLFDT_"^^^"
  1.  . D BMES^XPDUTL("***** SELECTED "_$S('RUNOPT:"NOT ",1:"")_"TO RUN THE ACTIVITY LOGS CORRECTION PROCESS *****")
  1.  ;
  1.  I $G(^XTMP(NAMSP,0,"LAST"))["COMPLETED" D  Q
  1.  . W !!,*7,"This job has been run before to completion on "
  1.  . W $$FMTE^XLFDT($P($G(^XTMP(NAMSP,0,"LAST")),"^",2)),!!
  1.  . D QUIT
  1.  ;
  1.  ;ques 2, if running from mumps prompt
  1.  I '$D(XPDQUES("POS2")) D  I 'ZTDTH D QUIT Q
  1.  . K DIR
  1.  . S DIR("A")="  Enter when to Queue the "_JOBN_" job to run in date@time   format "
  1.  . S DIR("B")="NOW"
  1.  . S DIR(0)="D^::%DT"
  1.  . S DIR("?")="Enter when to start the job. The default is Now. You can enter a date and time in the format like this: 021506@3:30p"
  1.  . D ^DIR I $D(DUOUT) W !,"Halting..." S ZTDTH="" Q
  1.  . S:$D(DTOUT) Y=$$NOW^XLFDT S ZTDTH=$$FMTH^XLFDT(Y)
  1.  ;
  1.  ;ques 2, if running from kids install
  1.  I $D(XPDQUES("POS2")) S ZTDTH=$$FMTH^XLFDT(XPDQUES("POS2"))
  1.  ;
  1.  D BMES^XPDUTL("===================================================")
  1.  D MES^XPDUTL("Queuing background job for "_JOBN_"...")
  1.  D MES^XPDUTL("Start time: "_$$HTE^XLFDT(ZTDTH))
  1.  D MES^XPDUTL("===================================================")
  1.  I ZTDTH="" D BMES^XPDUTL(JOBN_" NOT QUEUED") D QUIT Q
  1.  ;
  1.  S:$D(^XTMP(NAMSP,0,"LAST")) ^XTMP(NAMSP,0,"ZAUDIT",$H)="RE-STARTED ON"_"^"_$$NOW^XLFDT_"^"_$P(^XTMP(NAMSP,0,"LAST"),"^",2,5)
  1.  ;
  1.  I $P($G(^XTMP(NAMSP,0,"LAST")),"^")="STOP" D
  1.  . S $P(^XTMP(NAMSP,0,"LAST"),"^",1,2)="RUN^"_$$NOW^XLFDT
  1.  E  D
  1.  . S ^XTMP(NAMSP,0,"LAST")="RUN^"_$$NOW^XLFDT_"^^^"
  1.  ;
  1.  S ZTRTN="EN^PSOCIDC7",ZTIO=""
  1.  S ZTDESC="Background job for "_JOBN_" on prescriptions updated via PSO*7*239"
  1.  S ZTSAVE("JOBN")=""
  1.  L -^XTMP(NAMSP)
  1.  D ^%ZTLOAD
  1.  D:$D(ZTSK)
  1.  . D MES^XPDUTL("*** Task #"_ZTSK_" Queued! ***")
  1.  . D BMES^XPDUTL("")
  1.  D BMES^XPDUTL("")
  1.  K XPDQUES
  1.  Q
  1. QUIT ;
  1.  L -^XTMP(NAMSP)
  1.  Q
  1. EN ;
  1.  N NAMSP S NAMSP=$$NAMSP
  1.  ;if can't get Lock, then already running.
  1.  L +^XTMP(NAMSP):3 I '$T D  Q
  1.  . S:$D(ZTQUEUED) ZTREQ="@"
  1.  . S $P(^XTMP(NAMSP,0,"LAST"),"^",1,2)="LOCKED^"_$$NOW^XLFDT
  1.  ;
  1.  N DFN,PSODT,RXP,PSOTEXT,XX,YY,PSOCNT,PSOUCNT,PSOCCNT,PSOSTART,PSOEND,PSOVETS,PSOCVETS,PSOUVETS,PSOTRX,XIEN
  1.  N PSOSCMX,PSODFN,PSOUDFN,PSOREL,PSOAMT,PSOCAMT,PSOUAMT,FOUND,PSOTRF,PSOEND2,PSOSTRT2,CC
  1.  N PSOTIME,PSOSTNM,PSOS1,PSOINST,I,PSOTC,PSOCNTS,PSOUCNTS,PSOCCNTS,LIN,%,X1,XMY,STO,PSOSCP
  1.  D NOW^%DTC S (Y,PSOS1)=% D DD^%DT S PSOSTART=Y
  1.  S PSOSTRT2=$$FMTE^XLFDT(%,"1PS")
  1.  I '$G(DT) S DT=$$DT^XLFDT
  1.  S PSODT=+$P($G(^XTMP(NAMSP,0,"LAST")),"^",3)
  1.  S RXP=+$P($G(^XTMP(NAMSP,0,"LAST")),"^",4)
  1.  ;
  1.  ;get 1st occurence of install date of patch PSO*7*143 (CIDC)
  1.  S XIEN=+$O(^XPD(9.7,"B","PSO*7.0*143",0))
  1.  S:'PSODT PSODT=+$P($G(^XPD(9.7,XIEN,1)),"^",3)
  1.  I 'PSODT D  Q
  1.  . S ^XTMP(NAMSP,0,.1)="CIDC PATCH PSO*7*143 IS NOT INSTALLED"
  1.  . S $P(^XTMP(NAMSP,0,"LAST"),"^",1,2)="COMPLETED^"_$$NOW^XLFDT
  1.  . D MAIL3^PSOCIDC8(^XTMP(NAMSP,0,.1))
  1.  ;
  1.  S (PSOTRX,PSOTRF)=1
  1.  N STOP K ^XTMP(NAMSP,0,"STOP") S STOP=0          ;init stop flag to 0
  1.  F CC=1:1 S PSODT=$O(^PSRX("AD",PSODT)) Q:'PSODT  D  Q:STOP  ;FINISH DATE
  1.  . I $D(^XTMP(NAMSP,0,"STOP")) D  Q
  1.  . . S $P(^XTMP(NAMSP,0,"LAST"),"^",1,2)="STOP^"_$$NOW^XLFDT,STOP=1
  1.  . F PSOTRX=PSOTRX+1:1 S RXP=$O(^PSRX("AD",PSODT,RXP)) Q:'RXP  D  Q:STOP
  1.  .. I $D(^XTMP(NAMSP,0,"STOP")) D  Q
  1.  ... S $P(^XTMP(NAMSP,0,"LAST"),"^",1,2)="STOP^"_$$NOW^XLFDT,STOP=1
  1.  ..; S RXP=392 D  Q:RXP=392  ;FOR TESTING INDIVIDUAL
  1.  .. Q:'$D(^PSRX(RXP,"ICD",0))
  1.  .. ;save last date & fill info
  1.  .. S $P(^XTMP(NAMSP,0,"LAST"),"^",3,5)=PSODT_"^"_RXP_"^"_PSOTRX
  1.  .. S (DFN,PSODFN)=$P($G(^PSRX(RXP,0)),"^",2)
  1.  .. S PSONAM=$P($G(^DPT(PSODFN,0)),"^"),PSONAM=$P(PSONAM,",")
  1.  .. Q:('PSODFN)!('$D(^DPT(PSODFN,0)))        ;quit, no valid DFN info 
  1.  .. D:$D(^PSRX(RXP,"A",0))!($D(^PSRX(RXP,"COPAY",0))) CHECK^PSOCIDC8
  1.  G STP:STOP
  1.  ;
  1.  S (PSOUCNT,PSOCNT,PSOCCNT)=0
  1.  S $P(^XTMP(NAMSP,0,"LAST"),"^",1,2)="COMPLETED^"_$$NOW^XLFDT
  1.  D MAIL^PSOCIDC8
  1. STP ;
  1.  L -^XTMP(NAMSP)
  1.  I $D(^XTMP(NAMSP,0,"STOP")) S ^XTMP(NAMSP,0,"ZAUDIT",$H)="STOPPED ON"_"^"_$P(^XTMP(NAMSP,0,"LAST"),"^",2,5)
  1.  S:$D(ZTQUEUED) ZTREQ="@"
  1.  K JOBN
  1.  Q
  1.  ;
  1.  ;
  1. STATUS ;show status of job running
  1.  I $$ST D
  1.  . W !,"Currently processing:"
  1.  . I $G(^XTMP($$NAMSP,0,"LAST"))["COMPLETED" D
  1.  . . W !,"COMPLETED ON ",$$FMTE^XLFDT($P($G(^XTMP($$NAMSP,0,"LAST")),"^",2)),!
  1.  . W !?5,"Date being processed > ",$$FMTE^XLFDT($P(^XTMP($$NAMSP,0,"LAST"),"^",3))
  1.  . W !?5,"                RX # > ",$P(^XTMP($$NAMSP,0,"LAST"),"^",4)
  1.  . ;W !?5,"          TOTAL RX's > ",$P(^XTMP($$NAMSP,0,"LAST"),"^",5),!
  1.  E  D
  1.  .I $G(^XTMP($$NAMSP,0,"LAST"))["COMPLETED" D
  1.  .. W !,"COMPLETED ON ",$$FMTE^XLFDT($P($G(^XTMP($$NAMSP,0,"LAST")),"^",2)),!
  1.  Q
  1.  ;
  1. STOP ;stop job command
  1.  I $$ST S ^XTMP($$NAMSP,0,"STOP")="" D
  1.  . W !,"Outpatient Activity Logs Correction Job - set to STOP Soon"
  1.  . W !!,"Check Status to be sure it has stopped and is not running..."
  1.  . W !,"     (D STATUS^PSOCIDC7)"
  1.  Q
  1. ST() ;status
  1.  L +^XTMP($$NAMSP):3 I $T D  Q 0
  1.  . L -^XTMP($$NAMSP)
  1.  . W !,"*** NOT CURRENTLY RUNNING! ***",!
  1.  Q 1
  1. INITXTMP(NAMSP,TITLE,LIFE) ;create ^Xtmp according to SAC std
  1.  N BEGDT,PURGDT
  1.  S BEGDT=$$NOW^XLFDT()
  1.  S PURGDT=$$FMADD^XLFDT(BEGDT,LIFE)
  1.  S ^XTMP(NAMSP,0)=PURGDT_"^"_BEGDT_"^"_TITLE
  1.  Q
  1. NAMSP() ;
  1.  Q $T(+0)