65 lines
4.0 KiB
Mathematica
65 lines
4.0 KiB
Mathematica
PRCSP1D ;WISC/SAW/TKW-CPA REPORTS CON'T & RECALCULATE CP BALANCES IN FILE 420 ;12/1/94 9:07 AM
|
|
V ;;5.1;IFCAP;;Oct 20, 2000
|
|
;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
Q
|
|
ONECP ; RECAL one fcp
|
|
N PRCSST
|
|
S PRCSST=1 D EN1^PRCSUT Q:Y<0
|
|
D YN^PRC0A(.X,.Y,"Submit RECALCULATE CONTROL POINT BALANCES to the TASK MANAGER","O","YES")
|
|
QUIT:X["^"!(X="")!(Y<0)
|
|
N PRCDUZ
|
|
S PRCDUZ=DUZ
|
|
I Y=0 D ENCP QUIT
|
|
S A=$$TASK^PRC0B2("ENCP^PRCSP1D~RECALCULATE CONTROL POINT BALANCES","PRCDUZ~PRC*",1)
|
|
I A D EN^DDIOL("RECALCULATE CONTROL POINT BALANCES HAS TASK NUMBER "_$P(A,"^"))
|
|
QUIT
|
|
;
|
|
ENCP S PRC("CP")=$P(PRC("CP")," "),N0=PRC("SITE")_"-"_PRC("FY")
|
|
N TEMP S:$D(PRC("QTR")) TEMP=PRC("QTR")
|
|
D CPOBAL
|
|
S:$D(TEMP) PRC("QTR")=TEMP W:'$D(ZTQUEUED) " DONE",$C(7)
|
|
D:$D(ZTQUEUED) MM^PRCBRCP(PRC("SITE")_"-"_$P(PRC("CP")," "))
|
|
K Y QUIT
|
|
CPOBAL ;CALCULATE CPO BALANCES AND ENTER IN FCP FILE
|
|
;S N=N0_"-"_PRC("QTR")_"-"_PRC("CP"),X=0,Z=0,N1=""
|
|
S:'$D(^PRC(420,PRC("SITE"),1,+PRC("CP"),4,0)) ^(0)="^420.06A^0^0" S:'$D(^PRC(420,PRC("SITE"),1,+PRC("CP"),4,PRC("FY"),1)) ^(1)="^0^0^0^0" ;S PRC("BCPB")=^(1),$P(PRC("BCPB"),U,PRC("QTR")+1)=0
|
|
I '$D(^PRC(420,PRC("SITE"),1,+PRC("CP"),4,PRC("FY"),0)) S ^(0)=PRC("FY")_"^^^^^^^^",$P(^PRC(420,PRC("SITE"),1,+PRC("CP"),4,0),U,3)=PRC("FY"),$P(^(0),U,4)=$P(^(0),U,4)+1,^PRC(420,PRC("SITE"),1,+PRC("CP"),4,"B",PRC("FY"),PRC("FY"))=""
|
|
S N=$$FCP^PRCB0B(PRC("SITE"),PRC("CP"),PRC("FY"),PRC("QTR"))
|
|
S X=+N,Z=$P(N,"^",2)
|
|
;S N=$$PO^PRCB0B(PRC("SITE"),PRC("CP"),PRC("FY"),PRC("QTR"))
|
|
;S X=X+N,Z=Z+$P(N,"^",2)
|
|
S N=$$REC^PRCB0B(PRC("SITE"),+PRC("CP"),PRC("FY"),PRC("QTR"))
|
|
S X=X+N,Z=Z+$P(N,"^",2)
|
|
D ICLOCK^PRC0B("^PRC(420,"_(+PRC("SITE"))_",1,"_(+PRC("CP"))_",")
|
|
S $P(^PRC(420,PRC("SITE"),1,+PRC("CP"),4,PRC("FY"),0),U,(PRC("QTR")+1))=X,$P(^(0),U,(PRC("QTR")+5))=Z K N,N1,PRCSI,T,X,X1,Y,Z,Z1
|
|
D DCLOCK^PRC0B("^PRC(420,"_(+PRC("SITE"))_",1,"_(+PRC("CP"))_",")
|
|
QUIT
|
|
;
|
|
BAL I $P(^PRCS(410,N1,0),U,4)=1,T="A" S:'$D(^(7)) ^(7)="" S X=X+$S($P(^(7),U,6)]"":-X1,1:0),Z=Z+$S($P(^(4),U,10)]"":-Z1,1:0) G BAL1
|
|
S:T="O"!(T="A") X1=-X1,Z1=-Z1 S X=X+X1,Z=Z+Z1
|
|
BAL1 D SCP^PRCSEZZ
|
|
Q
|
|
SBAL ;1358 SERVICE BALANCE
|
|
D EN3^PRCSUT G EXIT:'$D(PRC("SITE"))!(Y<0) S DIC="^PRC(442,",DIC(0)="AEQM",DIC("A")="Select PURCHASE ORDER NUMBER: "
|
|
S DIC("S")="S PRCSZ=^(0) I +PRCSZ=PRC(""SITE""),+$P(PRCSZ,U,3)=+PRC(""CP""),$D(^PRCS(410,+$P(^(0),U,12),0)),$P(^(0),U,4)=1" D ^DIC
|
|
G:Y<0 EX W !?5,"Service's Actual 1358 Balance: ",$J($S($D(^PRC(442,+Y,8)):+^(8),1:0),9,2)
|
|
EX K DIC,Y,PRCSZ Q
|
|
RBAL ;RECALC 1358 BALANCE
|
|
D EN3^PRCSUT G EXIT:'$D(PRC("SITE"))!(Y<0) S DIC="^PRC(442,",DIC(0)="AEQM",DIC("A")="Select PURCHASE ORDER NUMBER: "
|
|
S DIC("S")="S PRCSZ=^(0) I +PRCSZ=PRC(""SITE""),+$P(PRCSZ,U,3)=+PRC(""CP""),$D(^PRCS(410,+$P(^(0),U,12),0)),$P(^(0),U,4)=1" D ^DIC Q:Y<0 S PRCSPN=+Y
|
|
S (PRCSOB,PRCSOBT,PRCSAT,PRCSATT,PRCSLQ,PRCSLQT,PRCSES,PRCSEST,PRCSAJ,PRCSAJT)=0
|
|
S PRCSDN=0 F J=0:0 S PRCSDN=$O(^PRC(424,"AD",PRCSPN,PRCSDN)) Q:PRCSDN'>0 D LP
|
|
S PRCSESB=PRCSOBT-(PRCSEST+PRCSAJT),PRCSATB=PRCSOBT-PRCSATT,PRCSOBB=PRCSOBT-PRCSLQT
|
|
W !?3,"Est Bal: ",PRCSESB,!?3,"Act Bal: ",PRCSATB,!?3,"Fis Bal: ",PRCSOBB
|
|
S ^PRC(442,PRCSPN,8)=PRCSATB_"^"_PRCSOBB_"^"_PRCSESB
|
|
K DIC,PRCSOB,PRCSOBB,PRCSOBT,PRCSAT,PRCSATB,PRCSATT,PRCSLQ,PRCSLQT,PRCSES,PRCSESB,PRCSEST,PRCSAJ,PRCSAJT,PRCSDN,PRCSPN,PRCSREC,PRCSZ Q
|
|
LP Q:'$D(^PRC(424,PRCSDN,0)) S PRCSREC=^(0),PRCSOB=$P(PRCSREC,U,5),PRCSAT=$P(PRCSREC,U,8),PRCSLQ=$P(PRCSREC,U,9),PRCSES=$P(PRCSREC,U,10),PRCSAJ=$P(PRCSREC,U,11)
|
|
S PRCSOBT=PRCSOBT+PRCSOB,PRCSATT=PRCSATT+PRCSAT,PRCSLQT=PRCSLQT+PRCSLQ,PRCSEST=PRCSEST+PRCSES,PRCSAJT=PRCSAJT+PRCSAJ
|
|
Q
|
|
TOR ;TYPE OF REQUEST REPORT
|
|
D EN1^PRCSUT G EXIT:Y<0 S PRCSAZ=PRC("SITE")_"-"_PRC("FY")_"-"_PRC("QTR")_"-"_$P(PRC("CP")," ")
|
|
S L=0,DIC="^PRCS(410,",FLDS="[PRCSTOR]",DHD="CLASSIFICATION OF REQUEST REPORT - "_PRC("CP"),BY="+8,@.01",FR="?,"_PRCSAZ_"-0001",TO="?,"_PRCSAZ_"-9999" D EN1^DIP K BY,DIC,FR,TO,PRCSAZ Q ;
|
|
W2 W !!,"Enter information for another report or an uparrow to return to the menu.",! Q
|
|
I (IO'=IO(0))!($D(ZTQUEUED)) D ^%ZISC
|
|
EXIT K %,BY,DA,D0,DHD,DIC,FLDS,FR,H1,H2,I,IO("Q"),J,L,N,N1,N2,P,PRCSED,PRCSSD,TO,Y,ZTRTN,ZTSAVE Q
|