RCMSDD1 ;WASH-ISC@ALTOONA,PA/RGY-Process DD site fields ;5/17/94 1:56 PM
V ;;4.5;Accounts Receivable;;Mar 20, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
GRPTYP ;Input transform for AR GROUP TYPE (342.1,.02)
I '$P($G(^RC(342.2,X,0)),"^",2)&$O(^RC(342.1,"AC",X,0)) K X W !,"*** You already have this type of group defined ***",!
Q
IRSL ;Input transform for IRS OFFSET letters
S Y=X X ^DD("DD") W " (",$P(Y,","),")"
I $E(X,4,7)>1007!($E(X,4,7)<901) K X W !!,"*** Recommended date must be between 9/1 and 9/20! ***",! Q
I $E(X,4,7)>920 W *7,!!,"WARNING: You have selected a date outside the recommended",!,"date range of 9/1 and 9/20!",!
Q
IRSM ;Input transform for IRS MASTER codesheets
S Y=X X ^DD("DD") W " (",$P(Y,","),")"
I $E(X,4,7)>1205!($E(X,4,7)<1122) K X W !!,"*** IRS Master update must be generated",!,"between NOV 22 and DEC 05!",! K X
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCMSDD1 907 printed Dec 13, 2024@01:47:10 Page 2
RCMSDD1 ;WASH-ISC@ALTOONA,PA/RGY-Process DD site fields ;5/17/94 1:56 PM
V ;;4.5;Accounts Receivable;;Mar 20, 1995
+1 ;;Per VHA Directive 10-93-142, this routine should not be modified.
GRPTYP ;Input transform for AR GROUP TYPE (342.1,.02)
+1 IF '$PIECE($GET(^RC(342.2,X,0)),"^",2)&$ORDER(^RC(342.1,"AC",X,0))
KILL X
WRITE !,"*** You already have this type of group defined ***",!
+2 QUIT
IRSL ;Input transform for IRS OFFSET letters
+1 SET Y=X
XECUTE ^DD("DD")
WRITE " (",$PIECE(Y,","),")"
+2 IF $EXTRACT(X,4,7)>1007!($EXTRACT(X,4,7)<901)
KILL X
WRITE !!,"*** Recommended date must be between 9/1 and 9/20! ***",!
QUIT
+3 IF $EXTRACT(X,4,7)>920
WRITE *7,!!,"WARNING: You have selected a date outside the recommended",!,"date range of 9/1 and 9/20!",!
+4 QUIT
IRSM ;Input transform for IRS MASTER codesheets
+1 SET Y=X
XECUTE ^DD("DD")
WRITE " (",$PIECE(Y,","),")"
+2 IF $EXTRACT(X,4,7)>1205!($EXTRACT(X,4,7)<1122)
KILL X
WRITE !!,"*** IRS Master update must be generated",!,"between NOV 22 and DEC 05!",!
KILL X
+3 QUIT
