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

ACRFDTP5.m

Go to the documentation of this file.
  1. ACRFDTP5 ;IHS/OIRM/DSD/THL,AEF - CONTINUATION OF LOOKUP AND DISPLAY ROUTINES; [ 11/01/2001 9:44 AM ]
  1. ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
  1. ;;CONTINUATION OF ACRFDTP TO LOOKUP AND DISPLAY FINANCIAL DATA
  1. DISP2 ;EP;TO DISPLAY FINANCIAL DATA
  1. S ACR10=$S(ACRGREF'["LOCB"&(ACRJ#20'=0)&(ACRJ<20):(ACRJ#20)\2+(ACRJ#2),1:10)
  1. S ACRI=$O(ACR(0))
  1. F ACRI=ACRI:1 Q:'$D(ACR(ACRI))!$D(ACRPSE) D DISP21
  1. Q
  1. DISP21 D DISP211:ACRGREF'["OBL"
  1. D DISP212:ACRGREF["OBL"
  1. X ACRFDX(5)
  1. D:$D(ACRCSIS) ^ACRFCSI
  1. K ACR(ACRI)
  1. K:ACRGREF'["LOCB"!$D(ACRFDIS) ACR(ACRI+ACR10)
  1. I ACRI#10=0 D PAUSE Q:'$D(ACRCONT)
  1. Q
  1. DISP211 I $D(ACR(ACRI)) D
  1. .S ACR=ACR(ACRI)
  1. .S ACRFD(1)=$P(ACR,U)
  1. .S ACRFD11=$P(ACR,U,2)
  1. .S ACRFD21=$P(ACR,U,3)
  1. .S ACRFD31=$P(ACR,U,4)
  1. .S ACRFDX1=$P(ACR,U,5)
  1. .S ACRFY1=$P(ACR,U,6)
  1. I $D(ACR(ACRI)),ACRGREF["LOCB" D
  1. .S ACRFDX=$P(ACR,U,5)
  1. .S ACRFD2=$P(ACR,U,3)
  1. .S ACRFD1=$P(ACR,U,2)
  1. .S ACRFD3=$P(ACR,U,7)
  1. .S ACRFY=$P(ACR,U,8)
  1. I ACRGREF'["LOCB",$D(ACR(ACRI+ACR10)) D
  1. .S ACR=ACR(ACRI+ACR10)
  1. .S ACRFD(2)=$P(ACR,U)
  1. .S ACRFD12=$P(ACR,U,2)
  1. .S ACRFD22=$P(ACR,U,3)
  1. .S ACRFD32=$P(ACR,U,4)
  1. .S ACRFDX2=$P(ACR,U,5)
  1. .S ACRFY2=$P(ACR,U,6)
  1. I ACRGREF'["LOCB",'$D(ACR(ACRI+1)),'$D(ACR(ACRI+ACR10)) S ACRPSE=""
  1. Q
  1. DISP212 I $D(ACR(ACRI)) D
  1. .S ACR=ACR(ACRI)
  1. .S ACRFD(1)=$P(ACR,U)
  1. .S ACRFD21=$S($P(ACR,U,2)]"":$P(ACR,U,2),1:$P(ACR,U,3))
  1. .S ACRID1=$E($P(ACR,U,4),1,15)
  1. .S ACRDISA1=$P(ACR,U,5)
  1. .S ACRPRR1=$P(ACR,U,7)
  1. .S ACRFY1=$P(ACR,U,8)
  1. .S:$D(ACRPRT) ACRPRTX($P(ACR,U))=""
  1. I $D(ACR(ACRI+ACR10)) D
  1. .S ACR=ACR(ACRI+ACR10)
  1. .S ACRFD(2)=$P(ACR,U)
  1. .S ACRFD22=$S($P(ACR,U,2)]"":$P(ACR,U,2),1:$P(ACR,U,3))
  1. .S ACRID2=$E($P(ACR,U,4),1,15)
  1. .S ACRDISA2=$P(ACR,U,5)
  1. .S ACRPRR2=$P(ACR,U,7)
  1. .S ACRFY2=$P(ACR,U,8)
  1. .S:$D(ACRPRT) ACRPRTX($P(ACR,U))=""
  1. I '$D(ACR(ACRI+1)),'$D(ACR(ACRI+ACR10)) S ACRPSE=""
  1. Q
  1. PAUSE K ACRPSE,ACRCONT
  1. I $D(ACRCSIS),$E(IOST,1,2)="P-" S ACRCONT="" W ! Q
  1. S DIR(0)="YO"
  1. S DIR("B")="YES"
  1. S DIR("A")=" List more "_ACRTYPS_"S"
  1. W !
  1. D DIR^ACRFDIC
  1. I Y=1 D I 1
  1. .S ACRCONT=""
  1. .S ACRI=ACRI+ACR10
  1. .W !
  1. E S ACRPSE=""
  1. Q
  1. TOT ;EP;CALCULATE TOTAL AMOUNT DISTRIBUTED
  1. N ACR,ACRG
  1. S ACRG=$S(ACRGREF["ACRAPP":"^ACRALW",ACRGREF["ACRALW":"^ACRALC",1:"^ACRLOCB")
  1. S (ACR,ACRFTOT)=0
  1. F S ACR=$O(@ACRG@("M",ACRFD,ACR)) Q:'ACR D
  1. .I $P(@ACRG@(ACR,0),U,8)="D" S ACRFTOT=ACRFTOT-$G(@ACRG@(ACR,0))
  1. .I $P(@ACRG@(ACR,0),U,8)'="D" S ACRFTOT=ACRFTOT+$G(@ACRG@(ACR,0))
  1. Q
  1. AMEND ;EP;FOR AMENDING A REQUEST
  1. N ACRAMEND,ACRAMT
  1. S ACRAMEND=0
  1. F S ACRAMEND=$O(@ACRGREF@("ORIG",ACRFD,ACRAMEND)) Q:'ACRAMEND D
  1. .I $P($G(@ACRGREF@(ACRAMEND,0)),U,22),$P(^(0),U,22)>DT Q
  1. .S ACRAMT=$S($P($G(@ACRGREF@(ACRAMEND,0)),U,8)'="D":1,1:-1)
  1. .I $G(ACRENTRY)'["OBL" S:ACRFD'=ACRAMEND ACRFDX=ACRFDX+(ACRAMT*$P(@ACRGREF@(ACRAMEND,0),U))
  1. .I $G(ACRENTRY)["OBL" S ACRFDX=ACRFDX+(ACRAMT*$P(@ACRGREF@(ACRAMEND,0),U))
  1. Q