Released PRC*5.1*223 SEQ #194 Extracted from mail message **KIDS**:PRC*5.1*223^ **INSTALL NAME** PRC*5.1*223 "BLD",12108,0) PRC*5.1*223^IFCAP^0^3210427^y "BLD",12108,1,0) ^^9^9^3210301^ "BLD",12108,1,1,0) This patch will correct the following issues: "BLD",12108,1,2,0) "BLD",12108,1,3,0) 1. APAR missing due-in orders from Vista "BLD",12108,1,4,0) "BLD",12108,1,5,0) 2. Correct FMS Transaction date handling in Invoice Processing for Payment "BLD",12108,1,6,0) "BLD",12108,1,7,0) 3. Modify fiscal receipt handling/transmission "BLD",12108,1,8,0) "BLD",12108,1,9,0) 4. Add a new Sub-Authority to 1358 handling "BLD",12108,4,0) ^9.64PA^421.5^1 "BLD",12108,4,421.5,0) 421.5 "BLD",12108,4,421.5,2,0) ^9.641^421.5^1 "BLD",12108,4,421.5,2,421.5,0) INVOICE TRACKING (File-top level) "BLD",12108,4,421.5,2,421.5,1,0) ^9.6411^71^1 "BLD",12108,4,421.5,2,421.5,1,71,0) FMS TRANSACTION DATE "BLD",12108,4,421.5,222) y^y^p^^^^n^^n "BLD",12108,4,421.5,224) "BLD",12108,4,"APDD",421.5,421.5) "BLD",12108,4,"APDD",421.5,421.5,71) "BLD",12108,4,"B",421.5,421.5) "BLD",12108,6) 16 "BLD",12108,6.3) 16 "BLD",12108,"ABPKG") n "BLD",12108,"INI") "BLD",12108,"INID") ^n^ "BLD",12108,"INIT") START^PRCF223P "BLD",12108,"KRN",0) ^9.67PA^1.5^25 "BLD",12108,"KRN",.4,0) .4 "BLD",12108,"KRN",.401,0) .401 "BLD",12108,"KRN",.402,0) .402 "BLD",12108,"KRN",.403,0) .403 "BLD",12108,"KRN",.5,0) .5 "BLD",12108,"KRN",.84,0) .84 "BLD",12108,"KRN",1.5,0) 1.5 "BLD",12108,"KRN",1.6,0) 1.6 "BLD",12108,"KRN",1.61,0) 1.61 "BLD",12108,"KRN",1.62,0) 1.62 "BLD",12108,"KRN",3.6,0) 3.6 "BLD",12108,"KRN",3.8,0) 3.8 "BLD",12108,"KRN",9.2,0) 9.2 "BLD",12108,"KRN",9.8,0) 9.8 "BLD",12108,"KRN",9.8,"NM",0) ^9.68A^2^2 "BLD",12108,"KRN",9.8,"NM",1,0) PRCF223P^^0^B8084210 "BLD",12108,"KRN",9.8,"NM",2,0) PRCSEB^^0^B35174785 "BLD",12108,"KRN",9.8,"NM","B","PRCF223P",1) "BLD",12108,"KRN",9.8,"NM","B","PRCSEB",2) "BLD",12108,"KRN",19,0) 19 "BLD",12108,"KRN",19,"NM",0) ^9.68A^2^2 "BLD",12108,"KRN",19,"NM",1,0) PRCFA RR QUEUE SINGLE^^0 "BLD",12108,"KRN",19,"NM",2,0) PRCFD PROCESS PAYMENT IN ACCTG^^0 "BLD",12108,"KRN",19,"NM","B","PRCFA RR QUEUE SINGLE",1) "BLD",12108,"KRN",19,"NM","B","PRCFD PROCESS PAYMENT IN ACCTG",2) "BLD",12108,"KRN",19.1,0) 19.1 "BLD",12108,"KRN",101,0) 101 "BLD",12108,"KRN",409.61,0) 409.61 "BLD",12108,"KRN",771,0) 771 "BLD",12108,"KRN",779.2,0) 779.2 "BLD",12108,"KRN",870,0) 870 "BLD",12108,"KRN",8989.51,0) 8989.51 "BLD",12108,"KRN",8989.52,0) 8989.52 "BLD",12108,"KRN",8993,0) 8993 "BLD",12108,"KRN",8994,0) 8994 "BLD",12108,"KRN","B",.4,.4) "BLD",12108,"KRN","B",.401,.401) "BLD",12108,"KRN","B",.402,.402) "BLD",12108,"KRN","B",.403,.403) "BLD",12108,"KRN","B",.5,.5) "BLD",12108,"KRN","B",.84,.84) "BLD",12108,"KRN","B",1.5,1.5) "BLD",12108,"KRN","B",1.6,1.6) "BLD",12108,"KRN","B",1.61,1.61) "BLD",12108,"KRN","B",1.62,1.62) "BLD",12108,"KRN","B",3.6,3.6) "BLD",12108,"KRN","B",3.8,3.8) "BLD",12108,"KRN","B",9.2,9.2) "BLD",12108,"KRN","B",9.8,9.8) "BLD",12108,"KRN","B",19,19) "BLD",12108,"KRN","B",19.1,19.1) "BLD",12108,"KRN","B",101,101) "BLD",12108,"KRN","B",409.61,409.61) "BLD",12108,"KRN","B",771,771) "BLD",12108,"KRN","B",779.2,779.2) "BLD",12108,"KRN","B",870,870) "BLD",12108,"KRN","B",8989.51,8989.51) "BLD",12108,"KRN","B",8989.52,8989.52) "BLD",12108,"KRN","B",8993,8993) "BLD",12108,"KRN","B",8994,8994) "BLD",12108,"QDEF") ^^^^NO^^^^NO^^YES "BLD",12108,"QUES",0) ^9.62^^ "BLD",12108,"REQB",0) ^9.611^1^1 "BLD",12108,"REQB",1,0) PRC*5.1*209^2 "BLD",12108,"REQB","B","PRC*5.1*209",1) "FIA",421.5) INVOICE TRACKING "FIA",421.5,0) ^PRCF(421.5, "FIA",421.5,0,0) 421.5I "FIA",421.5,0,1) y^y^p^^^^n^^n "FIA",421.5,0,10) "FIA",421.5,0,11) "FIA",421.5,0,"RLRO") "FIA",421.5,0,"VR") 5.1^PRC "FIA",421.5,421.5) 1 "FIA",421.5,421.5,71) "INIT") START^PRCF223P "KRN",19,2017,-1) 0^1 "KRN",19,2017,0) PRCFA RR QUEUE SINGLE^Queue Single Receiving Report for Transmission^No longer available, partial filing non-compliant^R^^^^^^^^ "KRN",19,2017,1,0) ^^2^2^2880624^ "KRN",19,2017,1,1,0) This option allows the user to transmit an individual receiving report to "KRN",19,2017,1,2,0) Austin with delayed or immediate release. "KRN",19,2017,25) SINGLE^PRCFARRQ "KRN",19,2017,"U") QUEUE SINGLE RECEIVING REPORT "KRN",19,2081,-1) 0^2 "KRN",19,2081,0) PRCFD PROCESS PAYMENT IN ACCTG^Invoice Processing for Payment^^R^^^^^^^^ "KRN",19,2081,1,0) ^^3^3^2980806^^^^ "KRN",19,2081,1,1,0) This option allows the accounting tech to enter liquidation information onto "KRN",19,2081,1,2,0) the payment file and release the data to FMS (and eventually to CAPPS) for "KRN",19,2081,1,3,0) payment. "KRN",19,2081,25) PRCFDA "KRN",19,2081,99) 55636,50603 "KRN",19,2081,"U") INVOICE PROCESSING FOR PAYMENT "MBREQ") 0 "ORD",18,19) 19;18;;;OPT^XPDTA;OPTF1^XPDIA;OPTE1^XPDIA;OPTF2^XPDIA;;OPTDEL^XPDIA "ORD",18,19,0) OPTION "PKG",455,-1) 1^1 "PKG",455,0) IFCAP^PRC^IFCAP System Files "PKG",455,22,0) ^9.49I^1^1 "PKG",455,22,1,0) 5.1 "PKG",455,22,1,"PAH",1,0) 223^3210427 "PKG",455,22,1,"PAH",1,1,0) ^^9^9^3210427 "PKG",455,22,1,"PAH",1,1,1,0) This patch will correct the following issues: "PKG",455,22,1,"PAH",1,1,2,0) "PKG",455,22,1,"PAH",1,1,3,0) 1. APAR missing due-in orders from Vista "PKG",455,22,1,"PAH",1,1,4,0) "PKG",455,22,1,"PAH",1,1,5,0) 2. Correct FMS Transaction date handling in Invoice Processing for Payment "PKG",455,22,1,"PAH",1,1,6,0) "PKG",455,22,1,"PAH",1,1,7,0) 3. Modify fiscal receipt handling/transmission "PKG",455,22,1,"PAH",1,1,8,0) "PKG",455,22,1,"PAH",1,1,9,0) 4. Add a new Sub-Authority to 1358 handling "QUES","XPF1",0) Y "QUES","XPF1","??") ^D REP^XPDH "QUES","XPF1","A") Shall I write over your |FLAG| File "QUES","XPF1","B") YES "QUES","XPF1","M") D XPF1^XPDIQ "QUES","XPF2",0) Y "QUES","XPF2","??") ^D DTA^XPDH "QUES","XPF2","A") Want my data |FLAG| yours "QUES","XPF2","B") YES "QUES","XPF2","M") D XPF2^XPDIQ "QUES","XPI1",0) YO "QUES","XPI1","??") ^D INHIBIT^XPDH "QUES","XPI1","A") Want KIDS to INHIBIT LOGONs during the install "QUES","XPI1","B") NO "QUES","XPI1","M") D XPI1^XPDIQ "QUES","XPM1",0) PO^VA(200,:EM "QUES","XPM1","??") ^D MG^XPDH "QUES","XPM1","A") Enter the Coordinator for Mail Group '|FLAG|' "QUES","XPM1","B") "QUES","XPM1","M") D XPM1^XPDIQ "QUES","XPO1",0) Y "QUES","XPO1","??") ^D MENU^XPDH "QUES","XPO1","A") Want KIDS to Rebuild Menu Trees Upon Completion of Install "QUES","XPO1","B") NO "QUES","XPO1","M") D XPO1^XPDIQ "QUES","XPZ1",0) Y "QUES","XPZ1","??") ^D OPT^XPDH "QUES","XPZ1","A") Want to DISABLE Scheduled Options, Menu Options, and Protocols "QUES","XPZ1","B") YES "QUES","XPZ1","M") D XPZ1^XPDIQ "QUES","XPZ2",0) Y "QUES","XPZ2","??") ^D RTN^XPDH "QUES","XPZ2","A") Want to MOVE routines to other CPUs "QUES","XPZ2","B") NO "QUES","XPZ2","M") D XPZ2^XPDIQ "RTN") 2 "RTN","PRCF223P") 0^1^B8084210^n/a "RTN","PRCF223P",1,0) PRCF223P ;MNTVBB/RGB - Cleanse Receiving queue of partial sets and update Authority file (410.9) ; 01/10/21@12:05 "RTN","PRCF223P",2,0) V ;;5.1;IFCAP;**223**;Jan 10, 2021;Build 16 "RTN","PRCF223P",3,0) ;Per VA Directive 6402, this routine should not be modified. "RTN","PRCF223P",4,0) ; "RTN","PRCF223P",5,0) Q "RTN","PRCF223P",6,0) START ;PRC*5.1*223 Updating file 410.9 [Authority of Request File] with new "RTN","PRCF223P",7,0) ; sub authority 'Q', 'FRANCHISE FUND: VTP CLAIMS' "RTN","PRCF223P",8,0) D CLEAN1 ;Cleanse Receiving Report of incomplete filed transmission "RTN","PRCF223P",9,0) D SETAO ;Set missing 'AO' index in file 410, field 4 "RTN","PRCF223P",10,0) D UPDATE ;Update AUTHORITY OF REQUEST file "RTN","PRCF223P",11,0) Q "RTN","PRCF223P",12,0) UPDATE ;Update Authority file 410.9 "RTN","PRCF223P",13,0) N DIE,DA,DR,PRCI,PRCX,PRCIEN,PRCCD,PRCSUB,PRCDESC "RTN","PRCF223P",14,0) S U="^" "RTN","PRCF223P",15,0) S DIE="^PRCS(410.9," "RTN","PRCF223P",16,0) F PRCI=1:1 S PRCX=$P($T(ADD+PRCI),";",3) Q:PRCX="QUIT" D "RTN","PRCF223P",17,0) . S X=$P(PRCX,U,2),DLAYGO=410.9,DIC="^PRCS(410.9,",DIC(0)="LXZ" D ^DIC K DLAYGO G:Y<0 ERR "RTN","PRCF223P",18,0) . S (DA,PRCIEN)=+Y,PRCCD=$P(Y,U,2),PRCSUB=$P(PRCX,"^"),PRCDESC=$P(PRCX,"^",3) "RTN","PRCF223P",19,0) . S DR=".02///^S X=PRCDESC;.03///^S X=PRCSUB;.05///^S X=1;.06///^S X=1;.07///^S X=PRCSUB_PRCCD" "RTN","PRCF223P",20,0) . D ^DIE "RTN","PRCF223P",21,0) . D MES^XPDUTL("Updating Authority of Request Code "_PRCCD_PRCSUB_" - "_PRCDESC) "RTN","PRCF223P",22,0) D MES^XPDUTL(""),BMES^XPDUTL("**Update of Authority of Request File completed**") "RTN","PRCF223P",23,0) K DIC,X,Y "RTN","PRCF223P",24,0) Q "RTN","PRCF223P",25,0) ADD ;; "RTN","PRCF223P",26,0) ;;3^Q^FRANCHISE FUND: VTP Claims "RTN","PRCF223P",27,0) ;;QUIT "RTN","PRCF223P",28,0) ERR ;File add messed up!! "RTN","PRCF223P",29,0) ; "RTN","PRCF223P",30,0) CLEAN1 ;Cleanse (FILE 442) fiscal signed receipts transmitted, but not filed correctly. "RTN","PRCF223P",31,0) N PRCIEN,PRCPART,PRCRECPT,PRCTOT "RTN","PRCF223P",32,0) K ^XTMP("PRCF223P") "RTN","PRCF223P",33,0) S ^XTMP("PRCF223P",0)=$$FMADD^XLFDT(DT,90)_"^"_DT "RTN","PRCF223P",34,0) S ^XTMP("PRCF223P",$J,0)="0" "RTN","PRCF223P",35,0) S (PRCIEN,PRCTOT)=0 "RTN","PRCF223P",36,0) A S PRCIEN=$O(^PRC(442,PRCIEN)),PRCPART=0 I 'PRCIEN G ZZ "RTN","PRCF223P",37,0) A1 S PRCPART=$O(^PRC(442,PRCIEN,11,PRCPART)) I 'PRCPART G A "RTN","PRCF223P",38,0) S PRCRECPT=$G(^PRC(442,PRCIEN,11,PRCPART,0)) Q:PRCRECPT="" "RTN","PRCF223P",39,0) I $P(PRCRECPT,U,19)'["RR" G A1 "RTN","PRCF223P",40,0) I $P(PRCRECPT,U,6)'="" G A1 "RTN","PRCF223P",41,0) S ^XTMP("PRCF223P",$J,1,PRCIEN,11,PRCPART,0)=PRCRECPT,PRCTOT=PRCTOT+1 "RTN","PRCF223P",42,0) S $P(^PRC(442,PRCIEN,11,PRCPART,0),U,6)="Y" "RTN","PRCF223P",43,0) ;W !!,PRCIEN,?12,$P(^PRC(442,PRCIEN,0),U),!,PRCRECPT "RTN","PRCF223P",44,0) G A1 "RTN","PRCF223P",45,0) ZZ S ^XTMP("PRCF223P",$J,1,0)=PRCTOT "RTN","PRCF223P",46,0) D MES^XPDUTL(""),BMES^XPDUTL("**Cleansing of Receiving Report completed: "_PRCTOT_" RESETS **") "RTN","PRCF223P",47,0) Q "RTN","PRCF223P",48,0) SETAO ;Set 'AO' index for invalid sets in file 410, field 4 from routine PRCSEB "RTN","PRCF223P",49,0) N PRCSIEN,PRCTOT "RTN","PRCF223P",50,0) B S (PRCSIEN,PRCTOT)=0 "RTN","PRCF223P",51,0) B1 S PRCSIEN=$O(^PRCS(410,PRCSIEN)) G BQ:'PRCSIEN "RTN","PRCF223P",52,0) S PRCSIP=$P($G(^PRCS(410,PRCSIEN,0)),U,6) G:'PRCSIP B1 "RTN","PRCF223P",53,0) I $D(^PRCS(410,"AO",PRCSIP,PRCSIEN)) G B1 "RTN","PRCF223P",54,0) S ^PRCS(410,"AO",PRCSIP,PRCSIEN)="",^XTMP("PRCF223P",$J,2,PRCSIEN,0)=PRCSIP "RTN","PRCF223P",55,0) ;W !,PRCSIEN,?15,PRCSIP "RTN","PRCF223P",56,0) S PRCTOT=PRCTOT+1 "RTN","PRCF223P",57,0) G B1 "RTN","PRCF223P",58,0) BQ S ^XTMP("PRCF223P",$J,2,0)=PRCTOT "RTN","PRCF223P",59,0) D MES^XPDUTL(""),BMES^XPDUTL("** File 410, 'AO' index reset completed: "_PRCTOT_" RESETS **") "RTN","PRCF223P",60,0) Q "RTN","PRCSEB") 0^2^B35174785^B32470054 "RTN","PRCSEB",1,0) PRCSEB ;SF-ISC/LJP/SAW/DXH/DAP - CPA EDITS CON'T ; 3/15/21@2:24pm "RTN","PRCSEB",2,0) V ;;5.1;IFCAP;**81,174,184,196,204,209,223**;Oct 20, 2000;Build 16 "RTN","PRCSEB",3,0) ;Per VA Directive 6402, this routine should not be modified. "RTN","PRCSEB",4,0) ; "RTN","PRCSEB",5,0) ;PRC*5.1*184 Check for error message indicating no 2237 seq nos. "RTN","PRCSEB",6,0) ; remaining to be used out of the max 9999 available "RTN","PRCSEB",7,0) ; for FCP FY-FQ. "RTN","PRCSEB",8,0) ; "RTN","PRCSEB",9,0) ;PRC*5.1*196 Check to move Date Required to Committed Date (MOP= 2,3 or 4) "RTN","PRCSEB",10,0) ; to insure a later date is used for FMS document. Also "RTN","PRCSEB",11,0) ; added date check called from templates PRCSENR&NR1, "RTN","PRCSEB",12,0) ; PRCSEN2237B & PRCSENPR to insure dates are in same "RTN","PRCSEB",13,0) ; FY/FQ defined. "RTN","PRCSEB",14,0) ; "RTN","PRCSEB",15,0) ;PRC*5.1*223 Use DIE set to save IP in file 410, field #4 in lieu of "RTN","PRCSEB",16,0) ; direct set that did not create the file index 'AO for field. "RTN","PRCSEB",17,0) ; "RTN","PRCSEB",18,0) ENRB ;ENTER CP CLERK REQUEST FROM OPTION PRCSENRB "RTN","PRCSEB",19,0) K PRCBBMY "RTN","PRCSEB",20,0) D ENF^PRCSUT(1) G W2:'$D(PRC("SITE")) G EXIT:'$D(PRC("QTR"))!(Y<0) "RTN","PRCSEB",21,0) S MSG="" D EN1^PRCSUT3 Q:'X I MSG'="" W !!,MSG,! S DIR(0)="EAO",DIR("A")="Press to exit processing..." D ^DIR K DIR,MSG Q ;PRC*5.1*184 "RTN","PRCSEB",22,0) K MSG ;PRC*5.1*184 "RTN","PRCSEB",23,0) S PRCSX1=X D EN2^PRCSUT3 Q:'$D(PRCSX1) S X=PRCSX1,T1=DA D W L +^PRCS(410,DA):15 G ENRB:$T=0 I $D(^PRC(420,PRC("SITE"),1,+PRC("CP"),0)) S:$P(^(0),"^",11)="Y" PRCS2=1 "RTN","PRCSEB",24,0) ; "RTN","PRCSEB",25,0) ;*81 Check site parameter to see if issue books should be allowed "RTN","PRCSEB",26,0) D CKPRM "RTN","PRCSEB",27,0) W !!,PRCVY,!! "RTN","PRCSEB",28,0) TYPE ; "RTN","PRCSEB",29,0) S PRCDAA=DA,DIC="^PRCS(410.5,",DIC(0)="AEQZ",DIC("A")="FORM TYPE: ",DIC("S")=PRCVX D ^DIC S TYPE=+Y,DA=PRCDAA "RTN","PRCSEB",30,0) I TYPE<2 W "?? EXIT NOT ALLOWED" G TYPE "RTN","PRCSEB",31,0) K PRCVX,PRCVY,PRCSIPT,PRCPPRIV ;PRC*5.1*223 "RTN","PRCSEB",32,0) S $P(^PRCS(410,DA,0),"^",4)=TYPE ;PRC*5.1*223 "RTN","PRCSEB",33,0) I $G(PRCSIP) D ;PRC*5.1*223 "RTN","PRCSEB",34,0) . S PRCSIPT=$P(^PRCP(445,PRCSIP,0),U),PRCPPRIV=1 ;PRC*5.1*223 "RTN","PRCSEB",35,0) . S DIE="^PRCS(410,",DR="4///^S X=PRCSIPT" D ^DIE ;PRC*5.1*223 "RTN","PRCSEB",36,0) . K PRCSIPT "RTN","PRCSEB",37,0) S (DIE,DIC)="^PRCS(410,",X=TYPE "RTN","PRCSEB",38,0) ;NOTE THAT THE FOLLOWING LINE OVERWRITES THE USER'S SELECTION OF FORM "RTN","PRCSEB",39,0) ;TYPE IF THE FUND CONTROL POINT IS NOT 'AUTOMATED' "RTN","PRCSEB",40,0) S:'$D(PRCS2)&(X>2) $P(^PRCS(410,DA,0),"^",4)=2,X=2 "RTN","PRCSEB",41,0) S PRCSTYP=X ;PRC*5.1*196 "RTN","PRCSEB",42,0) S (PRCSDR,DR)="["_$S(X=2:"PRCSEN2237B",X=3:"PRCSENPR",X=4:"PRCSENR&NR",1:"PRCSENIB")_"]" "RTN","PRCSEB",43,0) EN1 K DTOUT,DUOUT,PRCSIPT,Y S PRCSDAA=DA D ^DIE I $D(Y)!($D(DTOUT)) S DA=PRCSDAA L -^PRCS(410,DA) G EXIT ;PRC*5.1*223 "RTN","PRCSEB",44,0) S DA=PRCSDAA D RL^PRCSUT1 "RTN","PRCSEB",45,0) COMDT I PRCSTYP>1,PRCSTYP<5,$P($G(^PRCS(410,DA,4)),U,2)="" D ;PRC*5.1*196, PRC*5.1*204 protect global with $G "RTN","PRCSEB",46,0) . S PRCOMDT=$S($P(^PRCS(410,DA,1),U,4)'=DT:$P(^PRCS(410,DA,1),U,4),1:DT) "RTN","PRCSEB",47,0) . S DR="21///^S X=PRCOMDT",DIE="^PRCS(410," D ^DIE "RTN","PRCSEB",48,0) . S DR=$G(PRCSDR) ;reset DR to template value, PRC*5.1*204 "RTN","PRCSEB",49,0) D ^PRCSCK I $D(PRCSERR),PRCSERR G EN1 "RTN","PRCSEB",50,0) K PRCSERR "RTN","PRCSEB",51,0) I PRCSDR="[PRCSENCOD]" D W7^PRCSEB0 D:$D(PRCSOB) ENOD1^PRCSEB1 K PRCSOB "RTN","PRCSEB",52,0) S:$P($G(^PRCS(410,DA,7)),"^")="" $P(^PRCS(410,DA,7),"^")=DUZ "RTN","PRCSEB",53,0) D:PRCSDR'="[PRCSENCOD]" W1 I $D(PRCS2),+^PRCS(410,DA,0) D W6 "RTN","PRCSEB",54,0) S DA=PRCSDAA L -^PRCS(410,DA) D W3 G EXIT:%'=1 W !! K PRCS,PRCS2 "RTN","PRCSEB",55,0) G ENRB "RTN","PRCSEB",56,0) W W !!,"This transaction is assigned transaction number: ",X Q "RTN","PRCSEB",57,0) W1 W !!,"Would you like to review this request" S %=2 D YN^DICN G W1:%=0 Q:%'=1 S (N,PRCSZ)=DA,PRCSF=1 D PRF1^PRCSP1 S DA=PRCSZ K X,PRCSF,PRCSZ Q "RTN","PRCSEB",58,0) W2 W !!,"You are not an authorized control point user.",!,"Contact your control point official." R X:5 G EXIT "RTN","PRCSEB",59,0) W3 W !!,"Would you like to enter another request" S %=1 D YN^DICN G W3:%=0 Q "RTN","PRCSEB",60,0) W5 S:'$D(^PRCS(410,DA,11)) ^(11)="" S $P(^(11),U,3)="" K ^PRCS(410,"F",PRC("SITE")_"-"_+PRC("CP")_"-"_$P($P(^PRCS(410,DA,0),U),"-",5),DA),^PRCS(410,"F1",$P($P(^PRCS(410,DA,0),U),"-",5)_"-"_PRC("SITE")_"-"_+PRC("CP"),DA),^PRCS(410,"AQ",1,DA) Q "RTN","PRCSEB",61,0) W51 S:'$D(^PRCS(410,DA,11)) ^(11)="" S $P(^(11),U,3)=1,(^PRCS(410,"F",PRC("SITE")_"-"_+PRC("CP")_"-"_$P($P(^PRCS(410,DA,0),U),"-",5),DA),^PRCS(410,"F1",$P($P(^PRCS(410,DA,0),U),"-",5)_"-"_PRC("SITE")_"-"_+PRC("CP"),DA),^PRCS(410,"AQ",1,DA))="" Q "RTN","PRCSEB",62,0) W6 N JUMP,SKIPRNT,OK,TEST,TEST1,CURQTR,CURQTR1 "RTN","PRCSEB",63,0) W61 ; "RTN","PRCSEB",64,0) N REPORT2 I $P($G(^PRC(420,PRC("SITE"),1,+PRC("CP"),1,DUZ,0)),"^",2)'=1 S REPORT2=1 D T1^PRCSAPP1 "RTN","PRCSEB",65,0) ;*****PRC*5.1*174 start***** "RTN","PRCSEB",66,0) ;if Level of Access is not Control Point Official DO block "RTN","PRCSEB",67,0) I $P($G(^PRC(420,PRC("SITE"),1,+PRC("CP"),1,DUZ,0)),"^",2)'=1 D Q "RTN","PRCSEB",68,0) . N PRCFTYPE S PRCFTYPE=+$$GET1^DIQ(410,$G(DA)_",",3,"I") ;Form Type "RTN","PRCSEB",69,0) . S %=1 "RTN","PRCSEB",70,0) . ;if request is a 2237 (Form Type IEN 2,3, or 4) "RTN","PRCSEB",71,0) . I $G(PRCFTYPE)>1&($G(PRCFTYPE)<5) D "RTN","PRCSEB",72,0) . . ;don't allow approval of 2237 if Requesting Service OR any line item description is missing "RTN","PRCSEB",73,0) . . I '$$REQCHECK^PRCHJUTL($G(DA),,1) S %=2 "RTN","PRCSEB",74,0) . I $G(%)'=2 S %=1 W !,"Is this request ready for approval" D YN^DICN "RTN","PRCSEB",75,0) . D:%=1 W51 "RTN","PRCSEB",76,0) . D:%=0 W61 "RTN","PRCSEB",77,0) . D:%=2 W5 "RTN","PRCSEB",78,0) ;*****PRC*5.1*174 end****** "RTN","PRCSEB",79,0) S PRCSN=^PRCS(410,DA,0),PRCHQ=$P(PRCSN,"^",4),PRC("FY")=$P(PRCSN,"-",2),PRC("QTR")=$P(PRCSN,"-",3) "RTN","PRCSEB",80,0) S (CURQTR,CURQTR1)=PRC("QTR"),(JUMP,TEST,TEST1,OK)=0 "RTN","PRCSEB",81,0) D T1^PRCSAPP1 I OK=1 S SKIPRNT=1 D FINAL^PRCSAPP2 "RTN","PRCSEB",82,0) Q "RTN","PRCSEB",83,0) ;*81 Site Parameter Check "RTN","PRCSEB",84,0) CKPRM I $$GET^XPAR("SYS","PRCV COTS INVENTORY",1,"Q")=1 S PRCVX="I Y>1&(Y<5)",PRCVY="The form types 1358, Issue Book, and NO FORM are no longer used within this option." "RTN","PRCSEB",85,0) I $$GET^XPAR("SYS","PRCV COTS INVENTORY",1,"Q")'=1 S PRCVX="I Y>1",PRCVY="The form types 1358 and NO FORM are no longer used within this option" "RTN","PRCSEB",86,0) Q "RTN","PRCSEB",87,0) ; "RTN","PRCSEB",88,0) CHKREQ ;Check Date to insure it is within the FY/FQ range during option entry for 'NEW 2237' ;PRC*5.1*196 "RTN","PRCSEB",89,0) N PRCDT,PRCDT1,PRCTAPPR "RTN","PRCSEB",90,0) S PRCTAPPR=$P($G(^PRC(420,PRC("SITE"),1,+PRC("CP"),4,+PRC("FY"),2)),"^",9) ;PRC*5.1*209 use appropriation code from node 4, check both X and x "RTN","PRCSEB",91,0) I $D(PRCBBMY) S PRCCKERR=0 Q "RTN","PRCSEB",92,0) S PRCDTT=1700+$E(DT,1,3) "RTN","PRCSEB",93,0) I '$D(PRC("BBFY"))!(+$P(^PRC(420,PRC("SITE"),1,+PRC("CP"),0),"^",12)>0)!(PRCTAPPR["X")!(PRCTAPPR["x") S PRC("BBFY")=PRC("FY")+2000 "RTN","PRCSEB",94,0) S PRCCKERR=0,PRCDT=(PRC("BBFY")-$S(PRC("QTR")=1:1701,1:1700))_$P("10:01:04:07",":",PRC("QTR"))_"01",PRCDT1=(PRC("BBFY")-1700)_"0930" "RTN","PRCSEB",95,0) I PRCSTDTPRCDT1) D "RTN","PRCSEB",96,0) . S PRCCKERR=1 "RTN","PRCSEB",97,0) . W !!," ** Date must be specified for time **",!," ** period covered by fiscal year ",PRC("BBFY")," **",! "RTN","PRCSEB",98,0) Q "RTN","PRCSEB",99,0) EXIT K %,C,D,DA,DIC,DIE,DQ,DR,PRCS,PRCS2,PRCSDAA,PRCSDR,PRCSERR,PRCSL,PRCSTT,I,N,T,T1,T2,X,X1,PRCSX3,Y,Z,PRCOMDT,PRCCKERR,PRCSTYP Q ;PRC*5.1*196 "VER") 8.0^22.2 "^DD",421.5,421.5,71,0) FMS TRANSACTION DATE^DX^^1;19^S %DT="EX" D ^%DT S X=Y I $G(X)>DT D EN^DDIOL("Future date is NOT allowed") K X "^DD",421.5,421.5,71,3) Enter the date that Payment Voucher should be transmitted to FMS "^DD",421.5,421.5,71,21,0) ^^5^5^2950811^^ "^DD",421.5,421.5,71,21,1,0) The value in the FMS Transaction Date field determines when the Payment "^DD",421.5,421.5,71,21,2,0) Voucher will be transmitted to FMS by the Generic Code Sheet module. With "^DD",421.5,421.5,71,21,3,0) the new Hold Code Sheet functionality, Obligations may be entered to take "^DD",421.5,421.5,71,21,4,0) effect in the future. This field will enable the user to ensure that the "^DD",421.5,421.5,71,21,5,0) Payment Voucher does not arrive at FMS before its Obligation documents. "^DD",421.5,421.5,71,"DT") 3210312 "BLD",12108,6) ^194 **END** **END**