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