PSXCST ;BIR/JMB-Queues cost data compilation ;[ 04/08/97 2:06 PM ]
;;2.0;CMOP;;11 Apr 97
INIT ;Entry point for Initialize Nightly Compile Job
I '$D(^XUSEC("PSXCOST",DUZ)) W !,"You are not authorized to use this option!" Q
W !!?3,"A job will be tasked every night which compiles yesterday's cost",!?3,"statistics. This job should be run during off hours. The suggested",!?3,"time is 1 o'clock in the morning."
W !!?3,"** CAUTION: Check with IRM to make sure the",!?15,"job has not already been queued.",!!
S DIR(0)="Y",DIR("A")="Continue ",DIR("B")="N" D ^DIR K DIR G:$G(DIRUT)!('Y) END^PSXCSUTL S X1=DT,X2=1 D C^%DTC S Y=X_".0100" X ^DD("DD") S PSXEDTR=Y
TIME W ! D NOW^%DTC S %DT(0)=%,%DT="EFATX",%DT("A")="Enter date/time: ",%DT("B")=PSXEDTR D ^%DT G:$G(DTOUT)!($G(Y)<0) END^PSXCSUTL
W ! S X=Y D H^%DTC S ZTDTH=%H_","_$S($G(%T):%T,1:"3600"),X1=$P(Y,"."),X2=-1 D C^%DTC S (PSXBDT,PSXEDT)=X
G NQUE
NIGHT ;Entry point for nightly job
S ZTDTH=$H+1_","_$P(ZTDTH,",",2),PSXHOLD=PSXSTART,(PSXBDT,PSXEDT)=DT D NQUE
S PSXSTART=PSXHOLD S X1=DT,X2=-1 D C^%DTC S (PSXBDT,PSXEDT)=X D ^PSXCSDA K PSXHOLD
I $E(DT,6,7)="01" S PSXJOB="C",PSXSTART=9999999.999999-$E($$HTFM^XLFDT($H),1,14) D QUE^PSXCSLG1 D
.S PSXMON=$E(DT,4,5),PSXMON=$P("10^11^12^01^02^03^04^05^06^07^08^09","^",PSXMON),PSXYR=$S(+PSXMON>10:($E(DT,1,3)-1),1:$E(DT,1,3)),(PSXBDT,PSXEDT)=PSXYR_PSXMON_"00" D ^PSXCSCMN
K PSXLOC S PSXCNT=0 F PSXIEN=0:0 S PSXIEN=$O(^PSX(554,1,2,PSXIEN)) Q:'PSXIEN S PSXCNT=PSXCNT+1 S:PSXCNT>30 PSXLOC(PSXIEN)=""
I PSXCNT>30 S DIK="^PSX(554,1,2,",DA(1)=1 F DA=0:0 S DA=$O(PSXLOC(DA)) Q:'DA D ^DIK
G END^PSXCSUTL
NQUE ;Queues nightly job.
S PSXJOB="C",PSXSTART=9999999.999999-$E($$HTFM^XLFDT($H),1,14)
S ZTIO="",ZTRTN="NIGHT^PSXCST",ZTDESC="CMOP Daily Compile of Cost Data",ZTIO="",ZTSAVE("PSXSTART")="" D ^%ZTLOAD W:$D(ZTSK)&('$D(ZTQUEUED)) !,"Task Queued!",! S:$D(ZTQUEUED) ZTREQ="@"
D QUE^PSXCSLG1 G END^PSXCSUTL
RECOM ;Entry point for Date Range Compile/Recompile Cost Data
I '$D(^XUSEC("PSXCOST",DUZ)) W !,"You are not authorized to use this option!" D END^PSXCSUTL Q
W ! S %DT(0)=-DT,%DT("A")="Beginning date: " S %DT="EPA" D ^%DT G:"^"[X END^PSXCSUTL G:'Y RECOM S PSXBEG=Y K %DT(0)
REDT W ! S %DT(0)=PSXBEG,%DT("A")=" Ending date: " D ^%DT G:"^"[X END^PSXCSUTL G:Y<0 REDT S PSXEND=Y
W ! S DIR("A")="Are you sure",DIR(0)="Y",DIR("B")="N" D ^DIR K DIR I $G(DIRUT)!('Y) W !!,"No data has been compiled/recompiled." G RECOM
D ^PSXCST1 I $G(PSXERR) D END^PSXCSUTL G RECOM
G END^PSXCSUTL
QUE ;Queues One Day & Date Range Compile/Recompile Cost Data
D CHECK^PSXCSLOG I $G(PSXERR) N PSXERR D END^PSXCSUTL Q
W !!,$S($G(PSXCOM)=1:"One Day",$G(PSXCOM)=2:"Daily",1:"Monthly")_" data compilation queued from "_$$FMTE^XLFDT(PSXBDT)_" to "_$$FMTE^XLFDT(PSXEDT)_"."
S PSXJOB="C",PSXSTART=9999999.999999-$E($$HTFM^XLFDT($H),1,14)
S ZTDTH="",ZTRTN=$S($G(PSXCOM):"^PSXCSDA",1:"^PSXCSCMN"),ZTDESC="CMOP Cost Data - Recompile "_$S($G(PSXCOM)=1:"One Day",$G(PSXCOM)=2:"Daily Data",1:"Monthly Data"),ZTIO=""
F PSXG="PSXBDT","PSXEDT","PSXEND","PSXSTART" S:$D(@PSXG) ZTSAVE(PSXG)=""
D ^%ZTLOAD I $D(ZTSK) W !!,"Task Queued!",! D QUE^PSXCSLG1
S:$D(ZTQUEUED) ZTREQ="@"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSXCST 3202 printed Sep 23, 2025@19:19:53 Page 2
PSXCST ;BIR/JMB-Queues cost data compilation ;[ 04/08/97 2:06 PM ]
+1 ;;2.0;CMOP;;11 Apr 97
INIT ;Entry point for Initialize Nightly Compile Job
+1 IF '$DATA(^XUSEC("PSXCOST",DUZ))
WRITE !,"You are not authorized to use this option!"
QUIT
+2 WRITE !!?3,"A job will be tasked every night which compiles yesterday's cost",!?3,"statistics. This job should be run during off hours. The suggested",!?3,"time is 1 o'clock in the morning."
+3 WRITE !!?3,"** CAUTION: Check with IRM to make sure the",!?15,"job has not already been queued.",!!
+4 SET DIR(0)="Y"
SET DIR("A")="Continue "
SET DIR("B")="N"
DO ^DIR
KILL DIR
if $GET(DIRUT)!('Y)
GOTO END^PSXCSUTL
SET X1=DT
SET X2=1
DO C^%DTC
SET Y=X_".0100"
XECUTE ^DD("DD")
SET PSXEDTR=Y
TIME WRITE !
DO NOW^%DTC
SET %DT(0)=%
SET %DT="EFATX"
SET %DT("A")="Enter date/time: "
SET %DT("B")=PSXEDTR
DO ^%DT
if $GET(DTOUT)!($GET(Y)<0)
GOTO END^PSXCSUTL
+1 WRITE !
SET X=Y
DO H^%DTC
SET ZTDTH=%H_","_$SELECT($GET(%T):%T,1:"3600")
SET X1=$PIECE(Y,".")
SET X2=-1
DO C^%DTC
SET (PSXBDT,PSXEDT)=X
+2 GOTO NQUE
NIGHT ;Entry point for nightly job
+1 SET ZTDTH=$HOROLOG+1_","_$PIECE(ZTDTH,",",2)
SET PSXHOLD=PSXSTART
SET (PSXBDT,PSXEDT)=DT
DO NQUE
+2 SET PSXSTART=PSXHOLD
SET X1=DT
SET X2=-1
DO C^%DTC
SET (PSXBDT,PSXEDT)=X
DO ^PSXCSDA
KILL PSXHOLD
+3 IF $EXTRACT(DT,6,7)="01"
SET PSXJOB="C"
SET PSXSTART=9999999.999999-$EXTRACT($$HTFM^XLFDT($HOROLOG),1,14)
DO QUE^PSXCSLG1
Begin DoDot:1
+4 SET PSXMON=$EXTRACT(DT,4,5)
SET PSXMON=$PIECE("10^11^12^01^02^03^04^05^06^07^08^09","^",PSXMON)
SET PSXYR=$SELECT(+PSXMON>10:($EXTRACT(DT,1,3)-1),1:$EXTRACT(DT,1,3))
SET (PSXBDT,PSXEDT)=PSXYR_PSXMON_"00"
DO ^PSXCSCMN
End DoDot:1
+5 KILL PSXLOC
SET PSXCNT=0
FOR PSXIEN=0:0
SET PSXIEN=$ORDER(^PSX(554,1,2,PSXIEN))
if 'PSXIEN
QUIT
SET PSXCNT=PSXCNT+1
if PSXCNT>30
SET PSXLOC(PSXIEN)=""
+6 IF PSXCNT>30
SET DIK="^PSX(554,1,2,"
SET DA(1)=1
FOR DA=0:0
SET DA=$ORDER(PSXLOC(DA))
if 'DA
QUIT
DO ^DIK
+7 GOTO END^PSXCSUTL
NQUE ;Queues nightly job.
+1 SET PSXJOB="C"
SET PSXSTART=9999999.999999-$EXTRACT($$HTFM^XLFDT($HOROLOG),1,14)
+2 SET ZTIO=""
SET ZTRTN="NIGHT^PSXCST"
SET ZTDESC="CMOP Daily Compile of Cost Data"
SET ZTIO=""
SET ZTSAVE("PSXSTART")=""
DO ^%ZTLOAD
if $DATA(ZTSK)&('$DATA(ZTQUEUED))
WRITE !,"Task Queued!",!
if $DATA(ZTQUEUED)
SET ZTREQ="@"
+3 DO QUE^PSXCSLG1
GOTO END^PSXCSUTL
RECOM ;Entry point for Date Range Compile/Recompile Cost Data
+1 IF '$DATA(^XUSEC("PSXCOST",DUZ))
WRITE !,"You are not authorized to use this option!"
DO END^PSXCSUTL
QUIT
+2 WRITE !
SET %DT(0)=-DT
SET %DT("A")="Beginning date: "
SET %DT="EPA"
DO ^%DT
if "^"[X
GOTO END^PSXCSUTL
if 'Y
GOTO RECOM
SET PSXBEG=Y
KILL %DT(0)
REDT WRITE !
SET %DT(0)=PSXBEG
SET %DT("A")=" Ending date: "
DO ^%DT
if "^"[X
GOTO END^PSXCSUTL
if Y<0
GOTO REDT
SET PSXEND=Y
+1 WRITE !
SET DIR("A")="Are you sure"
SET DIR(0)="Y"
SET DIR("B")="N"
DO ^DIR
KILL DIR
IF $GET(DIRUT)!('Y)
WRITE !!,"No data has been compiled/recompiled."
GOTO RECOM
+2 DO ^PSXCST1
IF $GET(PSXERR)
DO END^PSXCSUTL
GOTO RECOM
+3 GOTO END^PSXCSUTL
QUE ;Queues One Day & Date Range Compile/Recompile Cost Data
+1 DO CHECK^PSXCSLOG
IF $GET(PSXERR)
NEW PSXERR
DO END^PSXCSUTL
QUIT
+2 WRITE !!,$SELECT($GET(PSXCOM)=1:"One Day",$GET(PSXCOM)=2:"Daily",1:"Monthly")_" data compilation queued from "_$$FMTE^XLFDT(PSXBDT)_" to "_$$FMTE^XLFDT(PSXEDT)_"."
+3 SET PSXJOB="C"
SET PSXSTART=9999999.999999-$EXTRACT($$HTFM^XLFDT($HOROLOG),1,14)
+4 SET ZTDTH=""
SET ZTRTN=$SELECT($GET(PSXCOM):"^PSXCSDA",1:"^PSXCSCMN")
SET ZTDESC="CMOP Cost Data - Recompile "_$SELECT($GET(PSXCOM)=1:"One Day",$GET(PSXCOM)=2:"Daily Data",1:"Monthly Data")
SET ZTIO=""
+5 FOR PSXG="PSXBDT","PSXEDT","PSXEND","PSXSTART"
if $DATA(@PSXG)
SET ZTSAVE(PSXG)=""
+6 DO ^%ZTLOAD
IF $DATA(ZTSK)
WRITE !!,"Task Queued!",!
DO QUE^PSXCSLG1
+7 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+8 QUIT
