PSXCSCMN ;BIR/JMB-Date Range Compile/Recompile Cost Data-Continued ;[ 04/08/97 2:06 PM ]
;;2.0;CMOP;;11 Apr 97
;Purges date range then compiles MONTHLY data entries.
PRGDAYS ;Purges data from cost file.
S PSXBDT=$E(PSXBDT,1,5)_"00",PSXEDT=$E(PSXEDT,1,5)_"00" D RUN^PSXCSLG1 ;Updates task log
S PSXEDT=$E(PSXEDT,1,5)_$P("31^29^31^30^31^30^31^31^30^31^30^31","^",$E(PSXEDT,4,5))
K DA,DIK F DA=(PSXBDT-.1):0 S DA=$O(^PSX(552.5,"AD",DA)) Q:'DA!(DA>PSXEDT) F DA(2)=0:0 S DA(2)=$O(^PSX(552.5,"AD",DA,DA(2))) Q:'+DA(2) D
.F DA(1)=0:0 S DA(1)=$O(^PSX(552.5,"AD",DA,DA(2),DA(1))) Q:'+DA(1) S DIK="^PSX(552.5,"_DA(2)_",1,"_DA(1)_",1," D ^DIK
K ^TMP("PSXCOST",$J),DA,DIK
COMPILE ;Compiles data into ^TMP global
F PSXCDT=(PSXBDT-.1):0 S PSXCDT=$O(^PSX(552.4,"AD",PSXCDT)) Q:'PSXCDT!(PSXCDT>PSXEDT) F PSXIEN=0:0 S PSXIEN=$O(^PSX(552.4,"AD",PSXCDT,PSXIEN)) Q:'PSXIEN F PSXSUB=0:0 S PSXSUB=$O(^PSX(552.4,"AD",PSXCDT,PSXIEN,PSXSUB)) Q:'PSXSUB D
.Q:'$D(^PSX(552.4,PSXIEN,1,PSXSUB,0))!('$D(^PSX(552.4,PSXIEN,0)))!($P($G(^PSX(552.4,PSXIEN,1,PSXSUB,0)),"^",2)=2)
.S PSXFAC=+$G(^PSX(552.1,+^PSX(552.4,PSXIEN,0),0)),PSXDV=$P($G(^PSX(552.1,+^PSX(552.4,PSXIEN,0),"P")),"^") Q:'PSXFAC!($G(PSXDV)="")
.S PSXNODE=^PSX(552.4,PSXIEN,1,PSXSUB,0),PSXCID=$S($P(PSXNODE,"^",4)'="":$P(PSXNODE,"^",4),1:""),PSXCST=$S(+$P(PSXNODE,"^",11):+$P(PSXNODE,"^",11),1:"")
.S PSXFL=$S($P(PSXNODE,"^",12)'="":$P(PSXNODE,"^",12),1:""),PSXQTY=$S(+$P(PSXNODE,"^",13):+$P(PSXNODE,"^",13),1:"")
.S PSXMCDT=$E($P(PSXCDT,"."),1,5)_"00" I PSXMCDT,PSXCID'="",$D(^TMP("PSXCOST",$J,PSXFAC,PSXDV,PSXMCDT,PSXCID)) S PSXTMP=^TMP("PSXCOST",$J,PSXFAC,PSXDV,PSXMCDT,PSXCID) D
..S $P(^TMP("PSXCOST",$J,PSXFAC,PSXDV,PSXMCDT,PSXCID),"^")=$P(PSXTMP,"^")+$S('PSXFL:1,1:0),$P(^(PSXCID),"^",2)=$P(PSXTMP,"^",2)+$S(PSXFL:1,1:0),$P(^(PSXCID),"^",3)=$P(PSXTMP,"^",3)+(PSXCST*PSXQTY),$P(^(PSXCID),"^",4)=$P(PSXTMP,"^",4)+PSXQTY
.I PSXMCDT,PSXCID'="",'$D(^TMP("PSXCOST",$J,PSXFAC,PSXDV,PSXMCDT,PSXCID)) S ^TMP("PSXCOST",$J,PSXFAC,PSXDV,PSXMCDT,PSXCID)=$S('PSXFL:1,1:0)_"^"_$S(PSXFL:1,1:0)_"^"_(PSXCST*PSXQTY)_"^"_PSXQTY
ADD ;Adds data to cost file using ^TMP global
S PSXLAYGO=1 F PSXFAC=0:0 S PSXFAC=$O(^TMP("PSXCOST",$J,PSXFAC)) Q:'PSXFAC D
.I '$D(^PSX(552.5,PSXFAC,0)) S DIC="^PSX(552.5,",DIC(0)="MLZ",(DINUM,X)=PSXFAC,DLAYGO=552 K DD,DO D FILE^DICN K DIC,X,Y
.S PSXDV="" F S PSXDV=$O(^TMP("PSXCOST",$J,PSXFAC,PSXDV)) Q:PSXDV="" D
..S PSXDIV=+$O(^PSX(552.5,PSXFAC,1,"B",PSXDV,0)) I 'PSXDIV S:'$D(^PSX(552.5,PSXFAC,1,0)) ^(0)="^552.51A^^" S DA(1)=PSXFAC,X=PSXDV,DIC(0)="MLZ",DIC="^PSX(552.5,"_PSXFAC_",1,",DLAYGO=552.51 K DD,DO D FILE^DICN S PSXDIV=+Y K DIC,X,Y
..F PSXMCDT=0:0 S PSXMCDT=$O(^TMP("PSXCOST",$J,PSXFAC,PSXDV,PSXMCDT)) Q:'PSXMCDT D CDT
D END^PSXCSLG1 ;Updates cost task log
G END^PSXCSUTL
CDT ;Adds sub-file & data nodes to cost file.
S:'$D(^PSX(552.5,PSXFAC,1,PSXDIV,1,0)) ^(0)="^552.61DA^^"
I '$D(^PSX(552.5,PSXFAC,1,PSXDIV,1,PSXMCDT,0)) S DA(2)=PSXFAC,DA(1)=PSXDIV,(DINUM,X)=PSXMCDT,DIC(0)="MLZ",DIC="^PSX(552.5,"_PSXFAC_",1,"_PSXDIV_",1,",DLAYGO=552.61 K DD,DO D FILE^DICN K DIC,X,Y
S PSXCID="" F S PSXCID=$O(^TMP("PSXCOST",$J,PSXFAC,PSXDV,PSXMCDT,PSXCID)) Q:PSXCID="" S:'$D(^PSX(552.5,PSXFAC,1,PSXDIV,1,PSXMCDT,1,0)) ^(0)="^552.611A^^" S PSXFCID=+$O(^PSX(552.5,PSXFAC,1,PSXDIV,1,PSXMCDT,1,"B",PSXCID,0)) I 'PSXFCID D
.S DA(3)=PSXFAC,DA(2)=PSXDIV,DA(1)=PSXMCDT,X=PSXCID,DIC(0)="MLZ",DLAYGO=552.611
.S PSXNODE=^TMP("PSXCOST",$J,PSXFAC,PSXDV,PSXMCDT,PSXCID)
.S DIC="^PSX(552.5,"_DA(3)_",1,"_DA(2)_",1,"_DA(1)_",1,",DIC("DR")="1////"_$P(PSXNODE,"^")_";2////"_$P(PSXNODE,"^",2)_";3////"_$P(PSXNODE,"^",3)_";4////"_$P(PSXNODE,"^",4) K DD,DO D FILE^DICN K DIC,X,Y
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSXCSCMN 3681 printed Dec 13, 2024@01:43:43 Page 2
PSXCSCMN ;BIR/JMB-Date Range Compile/Recompile Cost Data-Continued ;[ 04/08/97 2:06 PM ]
+1 ;;2.0;CMOP;;11 Apr 97
+2 ;Purges date range then compiles MONTHLY data entries.
PRGDAYS ;Purges data from cost file.
+1 ;Updates task log
SET PSXBDT=$EXTRACT(PSXBDT,1,5)_"00"
SET PSXEDT=$EXTRACT(PSXEDT,1,5)_"00"
DO RUN^PSXCSLG1
+2 SET PSXEDT=$EXTRACT(PSXEDT,1,5)_$PIECE("31^29^31^30^31^30^31^31^30^31^30^31","^",$EXTRACT(PSXEDT,4,5))
+3 KILL DA,DIK
FOR DA=(PSXBDT-.1):0
SET DA=$ORDER(^PSX(552.5,"AD",DA))
if 'DA!(DA>PSXEDT)
QUIT
FOR DA(2)=0:0
SET DA(2)=$ORDER(^PSX(552.5,"AD",DA,DA(2)))
if '+DA(2)
QUIT
Begin DoDot:1
+4 FOR DA(1)=0:0
SET DA(1)=$ORDER(^PSX(552.5,"AD",DA,DA(2),DA(1)))
if '+DA(1)
QUIT
SET DIK="^PSX(552.5,"_DA(2)_",1,"_DA(1)_",1,"
DO ^DIK
End DoDot:1
+5 KILL ^TMP("PSXCOST",$JOB),DA,DIK
COMPILE ;Compiles data into ^TMP global
+1 FOR PSXCDT=(PSXBDT-.1):0
SET PSXCDT=$ORDER(^PSX(552.4,"AD",PSXCDT))
if 'PSXCDT!(PSXCDT>PSXEDT)
QUIT
FOR PSXIEN=0:0
SET PSXIEN=$ORDER(^PSX(552.4,"AD",PSXCDT,PSXIEN))
if 'PSXIEN
QUIT
FOR PSXSUB=0:0
SET PSXSUB=$ORDER(^PSX(552.4,"AD",PSXCDT,PSXIEN,PSXSUB))
if 'PSXSUB
QUIT
Begin DoDot:1
+2 if '$DATA(^PSX(552.4,PSXIEN,1,PSXSUB,0))!('$DATA(^PSX(552.4,PSXIEN,0)))!($PIECE($GET(^PSX(552.4,PSXIEN,1,PSXSUB,0)),"^",2)=2)
QUIT
+3 SET PSXFAC=+$GET(^PSX(552.1,+^PSX(552.4,PSXIEN,0),0))
SET PSXDV=$PIECE($GET(^PSX(552.1,+^PSX(552.4,PSXIEN,0),"P")),"^")
if 'PSXFAC!($GET(PSXDV)="")
QUIT
+4 SET PSXNODE=^PSX(552.4,PSXIEN,1,PSXSUB,0)
SET PSXCID=$SELECT($PIECE(PSXNODE,"^",4)'="":$PIECE(PSXNODE,"^",4),1:"")
SET PSXCST=$SELECT(+$PIECE(PSXNODE,"^",11):+$PIECE(PSXNODE,"^",11),1:"")
+5 SET PSXFL=$SELECT($PIECE(PSXNODE,"^",12)'="":$PIECE(PSXNODE,"^",12),1:"")
SET PSXQTY=$SELECT(+$PIECE(PSXNODE,"^",13):+$PIECE(PSXNODE,"^",13),1:"")
+6 SET PSXMCDT=$EXTRACT($PIECE(PSXCDT,"."),1,5)_"00"
IF PSXMCDT
IF PSXCID'=""
IF $DATA(^TMP("PSXCOST",$JOB,PSXFAC,PSXDV,PSXMCDT,PSXCID))
SET PSXTMP=^TMP("PSXCOST",$JOB,PSXFAC,PSXDV,PSXMCDT,PSXCID)
Begin DoDot:2
+7 SET $PIECE(^TMP("PSXCOST",$JOB,PSXFAC,PSXDV,PSXMCDT,PSXCID),"^")=$PIECE(PSXTMP,"^")+$SELECT('PSXFL:1,1:0)
SET $PIECE(^(PSXCID),"^",2)=$PIECE(PSXTMP,"^",2)+$SELECT(PSXFL:1,1:0)
SET $PIECE(^(PSXCID),"^",3)=$PIECE(PSXTMP,"^",3)+(PSXCST*PSXQTY)
SET $PIECE(^(PSXCID),"^",4)=$PIECE(PSXTMP,"^",4)+PSXQTY
End DoDot:2
+8 IF PSXMCDT
IF PSXCID'=""
IF '$DATA(^TMP("PSXCOST",$JOB,PSXFAC,PSXDV,PSXMCDT,PSXCID))
SET ^TMP("PSXCOST",$JOB,PSXFAC,PSXDV,PSXMCDT,PSXCID)=$SELECT('PSXFL:1,1:0)_"^"_$SELECT(PSXFL:1,1:0)_"^"_(PSXCST*PSXQTY)_"^"_PSXQTY
End DoDot:1
ADD ;Adds data to cost file using ^TMP global
+1 SET PSXLAYGO=1
FOR PSXFAC=0:0
SET PSXFAC=$ORDER(^TMP("PSXCOST",$JOB,PSXFAC))
if 'PSXFAC
QUIT
Begin DoDot:1
+2 IF '$DATA(^PSX(552.5,PSXFAC,0))
SET DIC="^PSX(552.5,"
SET DIC(0)="MLZ"
SET (DINUM,X)=PSXFAC
SET DLAYGO=552
KILL DD,DO
DO FILE^DICN
KILL DIC,X,Y
+3 SET PSXDV=""
FOR
SET PSXDV=$ORDER(^TMP("PSXCOST",$JOB,PSXFAC,PSXDV))
if PSXDV=""
QUIT
Begin DoDot:2
+4 SET PSXDIV=+$ORDER(^PSX(552.5,PSXFAC,1,"B",PSXDV,0))
IF 'PSXDIV
if '$DATA(^PSX(552.5,PSXFAC,1,0))
SET ^(0)="^552.51A^^"
SET DA(1)=PSXFAC
SET X=PSXDV
SET DIC(0)="MLZ"
SET DIC="^PSX(552.5,"_PSXFAC_",1,"
SET DLAYGO=552.51
KILL DD,DO
DO FILE^DICN
SET PSXDIV=+Y
KILL DIC,X,Y
+5 FOR PSXMCDT=0:0
SET PSXMCDT=$ORDER(^TMP("PSXCOST",$JOB,PSXFAC,PSXDV,PSXMCDT))
if 'PSXMCDT
QUIT
DO CDT
End DoDot:2
End DoDot:1
+6 ;Updates cost task log
DO END^PSXCSLG1
+7 GOTO END^PSXCSUTL
CDT ;Adds sub-file & data nodes to cost file.
+1 if '$DATA(^PSX(552.5,PSXFAC,1,PSXDIV,1,0))
SET ^(0)="^552.61DA^^"
+2 IF '$DATA(^PSX(552.5,PSXFAC,1,PSXDIV,1,PSXMCDT,0))
SET DA(2)=PSXFAC
SET DA(1)=PSXDIV
SET (DINUM,X)=PSXMCDT
SET DIC(0)="MLZ"
SET DIC="^PSX(552.5,"_PSXFAC_",1,"_PSXDIV_",1,"
SET DLAYGO=552.61
KILL DD,DO
DO FILE^DICN
KILL DIC,X,Y
+3 SET PSXCID=""
FOR
SET PSXCID=$ORDER(^TMP("PSXCOST",$JOB,PSXFAC,PSXDV,PSXMCDT,PSXCID))
if PSXCID=""
QUIT
if '$DATA(^PSX(552.5,PSXFAC,1,PSXDIV,1,PSXMCDT,1,0))
SET ^(0)="^552.611A^^"
SET PSXFCID=+$ORDER(^PSX(552.5,PSXFAC,1,PSXDIV,1,PSXMCDT,1,"B",PSXCID,0))
IF 'PSXFCID
Begin DoDot:1
+4 SET DA(3)=PSXFAC
SET DA(2)=PSXDIV
SET DA(1)=PSXMCDT
SET X=PSXCID
SET DIC(0)="MLZ"
SET DLAYGO=552.611
+5 SET PSXNODE=^TMP("PSXCOST",$JOB,PSXFAC,PSXDV,PSXMCDT,PSXCID)
+6 SET DIC="^PSX(552.5,"_DA(3)_",1,"_DA(2)_",1,"_DA(1)_",1,"
SET DIC("DR")="1////"_$PIECE(PSXNODE,"^")_";2////"_$PIECE(PSXNODE,"^",2)_";3////"_$PIECE(PSXNODE,"^",3)_";4////"_$PIECE(PSXNODE,"^",4)
KILL DD,DO
DO FILE^DICN
KILL DIC,X,Y
End DoDot:1
+7 QUIT
