- 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 Feb 18, 2025@23:44:43 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