- RCAMFN01 ;WASH-ISC@ALTOONA,PA/RGY-MISCELLANEOUS AR FUNCTIONS ;4/30/96 8:39 AM
- V ;;4.5;Accounts Receivable;**39,86**;Mar 20, 1995
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- FPS(DATE,STM) ;
- ;Get a future or past statement date
- ;P1(STM)=statement date, P2(STM)=months to add or subtract
- NEW X,Y,END,YR,MT
- S Y=-1
- I $G(DATE)'?7N G Q1
- I $G(STM)'?.1"-"1N.N G Q1
- S YR=$E(DATE,1,3),MT=$E(DATE,4,5),Y=$S(STM<0:-STM,1:STM)
- F X=1:1:Y S MT=MT+$S(STM<0:-1,1:1) S:MT>12 YR=YR+1,MT=1 S:MT<1 YR=YR-1,MT=12
- S Y=YR_$S(MT<10:0_MT,1:MT)_$E(DATE,6,7)
- Q1 Q Y
- PST(Y) ;Input: debtor variable pointer value (EX: 1;DPT(, 34;DIC(36, etc)
- ;Return: Statement day or -1
- I '$D(Y) S Y=-1
- S:Y?1N.N Y=$P($G(^RCD(340,Y,0)),"^")
- S Y=$P($G(^RCD(340,+$O(^RCD(340,"B",Y,0)),0)),"^",3) S:'Y Y=-1
- Q Y
- REC(DEB) ;Return receivable code for debtor
- NEW X
- S X=""
- I $G(DEB)="" G Q4
- S:DEB'?1N.N DEB=$O(^RCD(340,"B",DEB,0))
- S X=$G(^RCD(340,DEB,0)) G:$P(X,"^")="" Q4
- I $P(X,"^")[";DPT(" S X=2 G Q4
- I $P(X,"^")[";VA(200," S X=2 G Q4
- I $P(X,"^")[";DIC(36" S X=$S($P(X,"^",5)=3:3,$P(X,"^",5)=1:1,1:2) G Q4
- I $P(X,"^")[";DIC(4," S X=$S($P(X,"^",5)=3:3,$P(X,"^",5)=2:2,1:1) G Q4
- I $P(X,"^")[";PRC(" S X=$S($P(X,"^",5)=3:3,$P(X,"^",5)=1:1,1:2) G Q4
- Q4 Q X
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCAMFN01 1282 printed Jan 18, 2025@02:43:40 Page 2
- RCAMFN01 ;WASH-ISC@ALTOONA,PA/RGY-MISCELLANEOUS AR FUNCTIONS ;4/30/96 8:39 AM
- V ;;4.5;Accounts Receivable;**39,86**;Mar 20, 1995
- +1 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- FPS(DATE,STM) ;
- +1 ;Get a future or past statement date
- +2 ;P1(STM)=statement date, P2(STM)=months to add or subtract
- +3 NEW X,Y,END,YR,MT
- +4 SET Y=-1
- +5 IF $GET(DATE)'?7N
- GOTO Q1
- +6 IF $GET(STM)'?.1"-"1N.N
- GOTO Q1
- +7 SET YR=$EXTRACT(DATE,1,3)
- SET MT=$EXTRACT(DATE,4,5)
- SET Y=$SELECT(STM<0:-STM,1:STM)
- +8 FOR X=1:1:Y
- SET MT=MT+$SELECT(STM<0:-1,1:1)
- if MT>12
- SET YR=YR+1
- SET MT=1
- if MT<1
- SET YR=YR-1
- SET MT=12
- +9 SET Y=YR_$SELECT(MT<10:0_MT,1:MT)_$EXTRACT(DATE,6,7)
- Q1 QUIT Y
- PST(Y) ;Input: debtor variable pointer value (EX: 1;DPT(, 34;DIC(36, etc)
- +1 ;Return: Statement day or -1
- +2 IF '$DATA(Y)
- SET Y=-1
- +3 if Y?1N.N
- SET Y=$PIECE($GET(^RCD(340,Y,0)),"^")
- +4 SET Y=$PIECE($GET(^RCD(340,+$ORDER(^RCD(340,"B",Y,0)),0)),"^",3)
- if 'Y
- SET Y=-1
- +5 QUIT Y
- REC(DEB) ;Return receivable code for debtor
- +1 NEW X
- +2 SET X=""
- +3 IF $GET(DEB)=""
- GOTO Q4
- +4 if DEB'?1N.N
- SET DEB=$ORDER(^RCD(340,"B",DEB,0))
- +5 SET X=$GET(^RCD(340,DEB,0))
- if $PIECE(X,"^")=""
- GOTO Q4
- +6 IF $PIECE(X,"^")[";DPT("
- SET X=2
- GOTO Q4
- +7 IF $PIECE(X,"^")[";VA(200,"
- SET X=2
- GOTO Q4
- +8 IF $PIECE(X,"^")[";DIC(36"
- SET X=$SELECT($PIECE(X,"^",5)=3:3,$PIECE(X,"^",5)=1:1,1:2)
- GOTO Q4
- +9 IF $PIECE(X,"^")[";DIC(4,"
- SET X=$SELECT($PIECE(X,"^",5)=3:3,$PIECE(X,"^",5)=2:2,1:1)
- GOTO Q4
- +10 IF $PIECE(X,"^")[";PRC("
- SET X=$SELECT($PIECE(X,"^",5)=3:3,$PIECE(X,"^",5)=1:1,1:2)
- GOTO Q4
- Q4 QUIT X