PRCSREC1 ;WISC/KMB-SEND FMS 820 REPORT ;12/28/99 13:31
V ;;5.1;IFCAP;**199**;Oct 20, 2000;Build 3
;Per VA Directive 6402, this routine should not be modified.
;
;PRC*5.1*199 Modify date call for header due to new % kill in ^DICRW call
N LINE2,XMTEXT,XMDUZ,XMSUB,WHAT,YY,DELIM,TEMP,XMY
S DELIM="TRANS #: ,TRANSACTION DATE: ,AMOUNT: ,COST CENTER: ,FY: ,QUARTER: ,"
F YY=1:1:6 S WHAT(YY)=$P(DELIM,",",YY)
;
S XMSUB="FMS TRANSACTION NOTIFICATION",XMDUZ=.5
S LINE2=1 F YY=18,22,20,11,4,5 S SENDIT(LINE2+3)=WHAT(LINE2)_$P($G(^PRCF(423.6,RDA,1,LINE,0)),"^",YY),LINE2=LINE2+1
S TEMP=$P(SENDIT(5),": "),X=$P(SENDIT(5),": ",2),X=$E(X,3,4)_"/"_$E(X,5,6)_"/"_$E(X,1,2) K %DT D ^%DT,DD^%DT S SENDIT(5)=TEMP_": "_Y
S Y=RDATE D DD^%DT
S SENDIT(1)="DATE: "_Y,SENDIT(2)=" STATION: "_STATION_" CP: "_FCP
S (SENDIT(3),SENDIT(9))="" S:$D(INFORM) SENDIT(10)=INFORM
I $D(ERROR) D REGRET Q
;
S USER=0 F S USER=$O(^PRC(420,STATION,1,+FCP,1,USER)) Q:USER="" I $P($G(^(USER,2)),"^")="Y" S XMY(USER)=""
I $D(XMY) S XMTEXT="SENDIT(",XMDUZ=.5 D ^XMD
K SENDIT QUIT
REGRET ;send error message and data to app coord
S SENDIT(10)=ERROR,XMDUN="820 RECONCILIATION",XMTEXT="SENDIT("
S USER=$P($G(^PRC(411,+STATION,9)),"^") Q:USER=""
S XMY(USER)="" D ^XMD K SENDIT Q
EXCEPT ;
;this code generates a report of FMS trans. for CPs not
;activated by the site
N EXCEPT,DIC,L,LEN,FLDS,BY
S EXCEPT="" D WRITE S DIC="^PRCS(417.1,",BY="30;""FISCAL YEAR"",4,21",FLDS="[PRCSEXCE]",L=0
S DHD="W ?0 D WRITE2^PRCSREC1"
D EN1^DIP W !,"End of report" Q
FMSRPT ;
; this code generates a report of all FMS trans. for a CP
D WRITE
D EN1^PRCSUT Q:'$D(PRC("SITE")) Q:Y<0
N P,PRCSZ,Z1 S P=0,(PRCSZ,Z(0))=Z
K IO("Q") S %ZIS("B")="HOME",%ZIS="MQ" D ^%ZIS Q:POP
I $D(IO("Q")) S ZTDESC="FMS TRANSACTIONS REPORT",ZTRTN="BEGIN^PRCSFMS",ZTSAVE("Z*")="",ZTSAVE("P")="",ZTSAVE("PRCSZ")="",ZTSAVE("PRC*")="" D ^%ZTLOAD D ^%ZISC W !,"End of report." Q
U IO D BEGIN^PRCSFMS D ^%ZISC W !,"End of report" Q
WRITE ;
W !,"This report will generate a listing of FMS transactions",!
I $D(EXCEPT) W "which are for control points not activated by your site.",!
W !,"You may create the report for all entries,",!,"or for selected year and/or quarter.",!
W !,"Enter fiscal year in the format '99'.",!
Q
WRITE2 ;
D NOW^PRCFQ W !,"FMS EXCEPTIONS REPORT",?45,%X,! ;PRC*5.1*199
W !,?3,"REFERENCE",?40,"TRANS DATE",?55,"AMOUNT",!,"STATION",?9,"BFY",?15,"AO",?21,"FUND",?33,"FCP/PROJECT",?47,"PROGRAM",?58,"B. OBJ. CLASS",?74,"JOB"
S LEN="",$P(LEN,"-",IOM)="-" W !,LEN S LEN="" Q
CLEAR ;clear 417.1 entries which are earlier than a selected date
N REC,REC1,SDATE
W !!,"This option will purge all FMS Exceptions File Entries earlier",!,"than the date which you select.",!!
S DIR("A")="Enter date from which entries should be deleted",DIR("?")="To remove records earlier than a certain date, enter that date"
S DIR(0)="D^^" D ^DIR Q:+Y<1 S SDATE=+Y W " ",Y(0)
W !!,"Beginning File 417.1 cleanup.."
S REC="" F S REC=$O(^PRCS(417.1,"B",REC)) Q:REC="" D
.S REC1=$O(^PRCS(417.1,"B",REC,0)) Q:REC1=""
.I +$P($G(^PRCS(417.1,REC1,0)),"^",22)<SDATE S DIK="^PRCS(417.1,",DA=REC1 D ^DIK K DA,DIK
W !!,"End of processing"
K %X ;PRC*5.1*199
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCSREC1 3278 printed Dec 13, 2024@02:18:21 Page 2
PRCSREC1 ;WISC/KMB-SEND FMS 820 REPORT ;12/28/99 13:31
V ;;5.1;IFCAP;**199**;Oct 20, 2000;Build 3
+1 ;Per VA Directive 6402, this routine should not be modified.
+2 ;
+3 ;PRC*5.1*199 Modify date call for header due to new % kill in ^DICRW call
+4 NEW LINE2,XMTEXT,XMDUZ,XMSUB,WHAT,YY,DELIM,TEMP,XMY
+5 SET DELIM="TRANS #: ,TRANSACTION DATE: ,AMOUNT: ,COST CENTER: ,FY: ,QUARTER: ,"
+6 FOR YY=1:1:6
SET WHAT(YY)=$PIECE(DELIM,",",YY)
+7 ;
+8 SET XMSUB="FMS TRANSACTION NOTIFICATION"
SET XMDUZ=.5
+9 SET LINE2=1
FOR YY=18,22,20,11,4,5
SET SENDIT(LINE2+3)=WHAT(LINE2)_$PIECE($GET(^PRCF(423.6,RDA,1,LINE,0)),"^",YY)
SET LINE2=LINE2+1
+10 SET TEMP=$PIECE(SENDIT(5),": ")
SET X=$PIECE(SENDIT(5),": ",2)
SET X=$EXTRACT(X,3,4)_"/"_$EXTRACT(X,5,6)_"/"_$EXTRACT(X,1,2)
KILL %DT
DO ^%DT
DO DD^%DT
SET SENDIT(5)=TEMP_": "_Y
+11 SET Y=RDATE
DO DD^%DT
+12 SET SENDIT(1)="DATE: "_Y
SET SENDIT(2)=" STATION: "_STATION_" CP: "_FCP
+13 SET (SENDIT(3),SENDIT(9))=""
if $DATA(INFORM)
SET SENDIT(10)=INFORM
+14 IF $DATA(ERROR)
DO REGRET
QUIT
+15 ;
+16 SET USER=0
FOR
SET USER=$ORDER(^PRC(420,STATION,1,+FCP,1,USER))
if USER=""
QUIT
IF $PIECE($GET(^(USER,2)),"^")="Y"
SET XMY(USER)=""
+17 IF $DATA(XMY)
SET XMTEXT="SENDIT("
SET XMDUZ=.5
DO ^XMD
+18 KILL SENDIT
QUIT
REGRET ;send error message and data to app coord
+1 SET SENDIT(10)=ERROR
SET XMDUN="820 RECONCILIATION"
SET XMTEXT="SENDIT("
+2 SET USER=$PIECE($GET(^PRC(411,+STATION,9)),"^")
if USER=""
QUIT
+3 SET XMY(USER)=""
DO ^XMD
KILL SENDIT
QUIT
EXCEPT ;
+1 ;this code generates a report of FMS trans. for CPs not
+2 ;activated by the site
+3 NEW EXCEPT,DIC,L,LEN,FLDS,BY
+4 SET EXCEPT=""
DO WRITE
SET DIC="^PRCS(417.1,"
SET BY="30;""FISCAL YEAR"",4,21"
SET FLDS="[PRCSEXCE]"
SET L=0
+5 SET DHD="W ?0 D WRITE2^PRCSREC1"
+6 DO EN1^DIP
WRITE !,"End of report"
QUIT
FMSRPT ;
+1 ; this code generates a report of all FMS trans. for a CP
+2 DO WRITE
+3 DO EN1^PRCSUT
if '$DATA(PRC("SITE"))
QUIT
if Y<0
QUIT
+4 NEW P,PRCSZ,Z1
SET P=0
SET (PRCSZ,Z(0))=Z
+5 KILL IO("Q")
SET %ZIS("B")="HOME"
SET %ZIS="MQ"
DO ^%ZIS
if POP
QUIT
+6 IF $DATA(IO("Q"))
SET ZTDESC="FMS TRANSACTIONS REPORT"
SET ZTRTN="BEGIN^PRCSFMS"
SET ZTSAVE("Z*")=""
SET ZTSAVE("P")=""
SET ZTSAVE("PRCSZ")=""
SET ZTSAVE("PRC*")=""
DO ^%ZTLOAD
DO ^%ZISC
WRITE !,"End of report."
QUIT
+7 USE IO
DO BEGIN^PRCSFMS
DO ^%ZISC
WRITE !,"End of report"
QUIT
WRITE ;
+1 WRITE !,"This report will generate a listing of FMS transactions",!
+2 IF $DATA(EXCEPT)
WRITE "which are for control points not activated by your site.",!
+3 WRITE !,"You may create the report for all entries,",!,"or for selected year and/or quarter.",!
+4 WRITE !,"Enter fiscal year in the format '99'.",!
+5 QUIT
WRITE2 ;
+1 ;PRC*5.1*199
DO NOW^PRCFQ
WRITE !,"FMS EXCEPTIONS REPORT",?45,%X,!
+2 WRITE !,?3,"REFERENCE",?40,"TRANS DATE",?55,"AMOUNT",!,"STATION",?9,"BFY",?15,"AO",?21,"FUND",?33,"FCP/PROJECT",?47,"PROGRAM",?58,"B. OBJ. CLASS",?74,"JOB"
+3 SET LEN=""
SET $PIECE(LEN,"-",IOM)="-"
WRITE !,LEN
SET LEN=""
QUIT
CLEAR ;clear 417.1 entries which are earlier than a selected date
+1 NEW REC,REC1,SDATE
+2 WRITE !!,"This option will purge all FMS Exceptions File Entries earlier",!,"than the date which you select.",!!
+3 SET DIR("A")="Enter date from which entries should be deleted"
SET DIR("?")="To remove records earlier than a certain date, enter that date"
+4 SET DIR(0)="D^^"
DO ^DIR
if +Y<1
QUIT
SET SDATE=+Y
WRITE " ",Y(0)
+5 WRITE !!,"Beginning File 417.1 cleanup.."
+6 SET REC=""
FOR
SET REC=$ORDER(^PRCS(417.1,"B",REC))
if REC=""
QUIT
Begin DoDot:1
+7 SET REC1=$ORDER(^PRCS(417.1,"B",REC,0))
if REC1=""
QUIT
+8 IF +$PIECE($GET(^PRCS(417.1,REC1,0)),"^",22)<SDATE
SET DIK="^PRCS(417.1,"
SET DA=REC1
DO ^DIK
KILL DA,DIK
End DoDot:1
+9 WRITE !!,"End of processing"
+10 ;PRC*5.1*199
KILL %X
+11 QUIT
