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

PRCSP1D.m

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