- PRCADEL ;SF-ISC/YJK-PRINT DELINQUENT REPORTS ;6/8/93 1:59 PM
- V ;;4.5;Accounts Receivable;;Mar 20, 1995
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- ;THIS PRINTS THE DELINQUENT ACCOUNTS IN A/R FILE
- EN1 ;This prints Delinquent accounts between 31 and 90 days
- S PRCAFT="31",PRCALAST="90" D DIP Q
- EN2 ;This prints Delinquent accounts between 91 and 180 days
- S PRCAFT="91",PRCALAST="180" D DIP Q
- EN3 ;This prints Delinquent accounts between 181 and 365 days
- S PRCAFT="181",PRCALAST="365" D DIP Q
- EN4 ;This prints Delinquent accounts more than 365 days
- S PRCAFT="366",PRCALAST="",PRCAHDR="OVER 365 DAYS DELINQUENT ACCOUNTS RECEIVABLE" D DIP1 Q
- EN5 ;This prints all Delinquent accounts
- S PRCAFT="31",PRCALAST="",PRCAHDR="ALL DELINQUENT ACCOUNTS RECEIVABLE" D DIP1 Q
- DIP S PRCAHDR=PRCAFT_" - "_PRCALAST_" DAYS DELINQUENT ACCOUNTS RECEIVABLE"
- DIP1 W !!,"Select a Category range to print.",!
- S FR="102,?,"_PRCAFT_",",TO="102,?,"_PRCALAST_",",DHD=PRCAHDR
- SET S L=0,DIC="^PRCA(430,",BY="@CURRENT STATUS:STATUS NUMBER,+CATEGORY;S2,DELINQUENT DAYS,BILL NO.",FLDS="[PRCAD DELINQ]" D EN1^DIP
- END K PRCA,PRCAHDR,PRCAFT,PRCALAST,DIC,DHD,BY,FR,TO,L,FLDS Q
- ACT(Y) ;Return date of last activity
- NEW BN0,X,Z,LST
- I $G(Y)="" S Y=-1 G ACTQ
- S BN0=$G(^PRCA(430,Y,0)) I BN0']"" S Y=-1 G ACTQ
- I "^220^102^110^104^112^107^113^240^230^205^"'[("^"_$P($G(^PRCA(430.3,+$P(BN0,"^",8),0)),"^",3)_"^") S Y=-1 G ACTQ
- S Z=0 F X=0:0 S X=$O(^PRCA(433,"C",Y,X)) Q:'X I $P($G(^PRCA(433,X,1)),"^",2)'=$O(^PRCA(430.3,"AC",13,0)) S Z=$S(+$P($G(^PRCA(433,X,1)),"^",9):$P(^(1),"^",9),1:+$G(^PRCA(433,X,1)))
- S LST(9999999-Z)=""
- S Z=$G(^PRCA(430,Y,6)) F X=3:-1:1 I $P(Z,"^",X) S LST(9999999-$P(Z,"^",X))="" Q
- S LST(9999999-$P(BN0,U,10))="",LST(9999999-$P(BN0,"^",14))=""
- S Z=9999999-$O(LST(0)) S:'Z Z=2910101
- S Y=Z
- ACTQ Q $P(Y,".")
- LAST ;Print last activity
- NEW DIC,FLDS,FR,TO,L,%DT,END
- S %DT("A")="Show Outstanding Bills with 'Last Activty' Before: ",%DT="EA" D ^%DT G:Y<0 Q1 S END=X_"^"_Y
- S X1=DT,X2=Y D ^%DTC I X<180 W *7,!!,"WARNING: You picked a date less than 180 days ago!",!
- S DHD="Report of AR Last Activity before "_$$SLH^RCFN01($P(END,"^",2)),DIC="^PRCA(430,",FR="?,T-10000",TO="?,"_$P(END,"^"),L=0,(BY,FLDS)="[PRCA LAST ACTIVITY]" D EN1^DIP
- Q1 Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCADEL 2292 printed Feb 18, 2025@23:05:40 Page 2
- PRCADEL ;SF-ISC/YJK-PRINT DELINQUENT REPORTS ;6/8/93 1:59 PM
- V ;;4.5;Accounts Receivable;;Mar 20, 1995
- +1 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +2 ;THIS PRINTS THE DELINQUENT ACCOUNTS IN A/R FILE
- EN1 ;This prints Delinquent accounts between 31 and 90 days
- +1 SET PRCAFT="31"
- SET PRCALAST="90"
- DO DIP
- QUIT
- EN2 ;This prints Delinquent accounts between 91 and 180 days
- +1 SET PRCAFT="91"
- SET PRCALAST="180"
- DO DIP
- QUIT
- EN3 ;This prints Delinquent accounts between 181 and 365 days
- +1 SET PRCAFT="181"
- SET PRCALAST="365"
- DO DIP
- QUIT
- EN4 ;This prints Delinquent accounts more than 365 days
- +1 SET PRCAFT="366"
- SET PRCALAST=""
- SET PRCAHDR="OVER 365 DAYS DELINQUENT ACCOUNTS RECEIVABLE"
- DO DIP1
- QUIT
- EN5 ;This prints all Delinquent accounts
- +1 SET PRCAFT="31"
- SET PRCALAST=""
- SET PRCAHDR="ALL DELINQUENT ACCOUNTS RECEIVABLE"
- DO DIP1
- QUIT
- DIP SET PRCAHDR=PRCAFT_" - "_PRCALAST_" DAYS DELINQUENT ACCOUNTS RECEIVABLE"
- DIP1 WRITE !!,"Select a Category range to print.",!
- +1 SET FR="102,?,"_PRCAFT_","
- SET TO="102,?,"_PRCALAST_","
- SET DHD=PRCAHDR
- SET SET L=0
- SET DIC="^PRCA(430,"
- SET BY="@CURRENT STATUS:STATUS NUMBER,+CATEGORY;S2,DELINQUENT DAYS,BILL NO."
- SET FLDS="[PRCAD DELINQ]"
- DO EN1^DIP
- END KILL PRCA,PRCAHDR,PRCAFT,PRCALAST,DIC,DHD,BY,FR,TO,L,FLDS
- QUIT
- ACT(Y) ;Return date of last activity
- +1 NEW BN0,X,Z,LST
- +2 IF $GET(Y)=""
- SET Y=-1
- GOTO ACTQ
- +3 SET BN0=$GET(^PRCA(430,Y,0))
- IF BN0']""
- SET Y=-1
- GOTO ACTQ
- +4 IF "^220^102^110^104^112^107^113^240^230^205^"'[("^"_$PIECE($GET(^PRCA(430.3,+$PIECE(BN0,"^",8),0)),"^",3)_"^")
- SET Y=-1
- GOTO ACTQ
- +5 SET Z=0
- FOR X=0:0
- SET X=$ORDER(^PRCA(433,"C",Y,X))
- if 'X
- QUIT
- IF $PIECE($GET(^PRCA(433,X,1)),"^",2)'=$ORDER(^PRCA(430.3,"AC",13,0))
- SET Z=$SELECT(+$PIECE($GET(^PRCA(433,X,1)),"^",9):$PIECE(^(1),"^",9),1:+$GET(^PRCA(433,X,1)))
- +6 SET LST(9999999-Z)=""
- +7 SET Z=$GET(^PRCA(430,Y,6))
- FOR X=3:-1:1
- IF $PIECE(Z,"^",X)
- SET LST(9999999-$PIECE(Z,"^",X))=""
- QUIT
- +8 SET LST(9999999-$PIECE(BN0,U,10))=""
- SET LST(9999999-$PIECE(BN0,"^",14))=""
- +9 SET Z=9999999-$ORDER(LST(0))
- if 'Z
- SET Z=2910101
- +10 SET Y=Z
- ACTQ QUIT $PIECE(Y,".")
- LAST ;Print last activity
- +1 NEW DIC,FLDS,FR,TO,L,%DT,END
- +2 SET %DT("A")="Show Outstanding Bills with 'Last Activty' Before: "
- SET %DT="EA"
- DO ^%DT
- if Y<0
- GOTO Q1
- SET END=X_"^"_Y
- +3 SET X1=DT
- SET X2=Y
- DO ^%DTC
- IF X<180
- WRITE *7,!!,"WARNING: You picked a date less than 180 days ago!",!
- +4 SET DHD="Report of AR Last Activity before "_$$SLH^RCFN01($PIECE(END,"^",2))
- SET DIC="^PRCA(430,"
- SET FR="?,T-10000"
- SET TO="?,"_$PIECE(END,"^")
- SET L=0
- SET (BY,FLDS)="[PRCA LAST ACTIVITY]"
- DO EN1^DIP
- Q1 QUIT