Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRCSEB

PRCSEB.m

Go to the documentation of this file.
  1. PRCSEB ;SF-ISC/LJP/SAW/DXH/DAP - CPA EDITS CON'T ; 3/15/21@2:24pm
  1. V ;;5.1;IFCAP;**81,174,184,196,204,209,223**;Oct 20, 2000;Build 16
  1. ;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ;PRC*5.1*184 Check for error message indicating no 2237 seq nos.
  1. ; remaining to be used out of the max 9999 available
  1. ; for FCP FY-FQ.
  1. ;
  1. ;PRC*5.1*196 Check to move Date Required to Committed Date (MOP= 2,3 or 4)
  1. ; to insure a later date is used for FMS document. Also
  1. ; added date check called from templates PRCSENR&NR1,
  1. ; PRCSEN2237B & PRCSENPR to insure dates are in same
  1. ; FY/FQ defined.
  1. ;
  1. ;PRC*5.1*223 Use DIE set to save IP in file 410, field #4 in lieu of
  1. ; direct set that did not create the file index 'AO for field.
  1. ;
  1. ENRB ;ENTER CP CLERK REQUEST FROM OPTION PRCSENRB
  1. K PRCBBMY
  1. D ENF^PRCSUT(1) G W2:'$D(PRC("SITE")) G EXIT:'$D(PRC("QTR"))!(Y<0)
  1. S MSG="" D EN1^PRCSUT3 Q:'X I MSG'="" W !!,MSG,! S DIR(0)="EAO",DIR("A")="Press <Enter> to exit processing..." D ^DIR K DIR,MSG Q ;PRC*5.1*184
  1. K MSG ;PRC*5.1*184
  1. 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
  1. ;
  1. ;*81 Check site parameter to see if issue books should be allowed
  1. D CKPRM
  1. W !!,PRCVY,!!
  1. TYPE ;
  1. S PRCDAA=DA,DIC="^PRCS(410.5,",DIC(0)="AEQZ",DIC("A")="FORM TYPE: ",DIC("S")=PRCVX D ^DIC S TYPE=+Y,DA=PRCDAA
  1. I TYPE<2 W "?? EXIT NOT ALLOWED" G TYPE
  1. K PRCVX,PRCVY,PRCSIPT,PRCPPRIV ;PRC*5.1*223
  1. S $P(^PRCS(410,DA,0),"^",4)=TYPE ;PRC*5.1*223
  1. I $G(PRCSIP) D ;PRC*5.1*223
  1. . S PRCSIPT=$P(^PRCP(445,PRCSIP,0),U),PRCPPRIV=1 ;PRC*5.1*223
  1. . S DIE="^PRCS(410,",DR="4///^S X=PRCSIPT" D ^DIE ;PRC*5.1*223
  1. . K PRCSIPT
  1. S (DIE,DIC)="^PRCS(410,",X=TYPE
  1. ;NOTE THAT THE FOLLOWING LINE OVERWRITES THE USER'S SELECTION OF FORM
  1. ;TYPE IF THE FUND CONTROL POINT IS NOT 'AUTOMATED'
  1. S:'$D(PRCS2)&(X>2) $P(^PRCS(410,DA,0),"^",4)=2,X=2
  1. S PRCSTYP=X ;PRC*5.1*196
  1. S (PRCSDR,DR)="["_$S(X=2:"PRCSEN2237B",X=3:"PRCSENPR",X=4:"PRCSENR&NR",1:"PRCSENIB")_"]"
  1. 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
  1. S DA=PRCSDAA D RL^PRCSUT1
  1. 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
  1. . S PRCOMDT=$S($P(^PRCS(410,DA,1),U,4)'=DT:$P(^PRCS(410,DA,1),U,4),1:DT)
  1. . S DR="21///^S X=PRCOMDT",DIE="^PRCS(410," D ^DIE
  1. . S DR=$G(PRCSDR) ;reset DR to template value, PRC*5.1*204
  1. D ^PRCSCK I $D(PRCSERR),PRCSERR G EN1
  1. K PRCSERR
  1. I PRCSDR="[PRCSENCOD]" D W7^PRCSEB0 D:$D(PRCSOB) ENOD1^PRCSEB1 K PRCSOB
  1. S:$P($G(^PRCS(410,DA,7)),"^")="" $P(^PRCS(410,DA,7),"^")=DUZ
  1. D:PRCSDR'="[PRCSENCOD]" W1 I $D(PRCS2),+^PRCS(410,DA,0) D W6
  1. S DA=PRCSDAA L -^PRCS(410,DA) D W3 G EXIT:%'=1 W !! K PRCS,PRCS2
  1. G ENRB
  1. W W !!,"This transaction is assigned transaction number: ",X Q
  1. 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
  1. W2 W !!,"You are not an authorized control point user.",!,"Contact your control point official." R X:5 G EXIT
  1. W3 W !!,"Would you like to enter another request" S %=1 D YN^DICN G W3:%=0 Q
  1. 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
  1. 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
  1. W6 N JUMP,SKIPRNT,OK,TEST,TEST1,CURQTR,CURQTR1
  1. W61 ;
  1. N REPORT2 I $P($G(^PRC(420,PRC("SITE"),1,+PRC("CP"),1,DUZ,0)),"^",2)'=1 S REPORT2=1 D T1^PRCSAPP1
  1. ;*****PRC*5.1*174 start*****
  1. ;if Level of Access is not Control Point Official DO block
  1. I $P($G(^PRC(420,PRC("SITE"),1,+PRC("CP"),1,DUZ,0)),"^",2)'=1 D Q
  1. . N PRCFTYPE S PRCFTYPE=+$$GET1^DIQ(410,$G(DA)_",",3,"I") ;Form Type
  1. . S %=1
  1. . ;if request is a 2237 (Form Type IEN 2,3, or 4)
  1. . I $G(PRCFTYPE)>1&($G(PRCFTYPE)<5) D
  1. . . ;don't allow approval of 2237 if Requesting Service OR any line item description is missing
  1. . . I '$$REQCHECK^PRCHJUTL($G(DA),,1) S %=2
  1. . I $G(%)'=2 S %=1 W !,"Is this request ready for approval" D YN^DICN
  1. . D:%=1 W51
  1. . D:%=0 W61
  1. . D:%=2 W5
  1. ;*****PRC*5.1*174 end******
  1. S PRCSN=^PRCS(410,DA,0),PRCHQ=$P(PRCSN,"^",4),PRC("FY")=$P(PRCSN,"-",2),PRC("QTR")=$P(PRCSN,"-",3)
  1. S (CURQTR,CURQTR1)=PRC("QTR"),(JUMP,TEST,TEST1,OK)=0
  1. D T1^PRCSAPP1 I OK=1 S SKIPRNT=1 D FINAL^PRCSAPP2
  1. Q
  1. ;*81 Site Parameter Check
  1. 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."
  1. 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"
  1. Q
  1. ;
  1. CHKREQ ;Check Date to insure it is within the FY/FQ range during option entry for 'NEW 2237' ;PRC*5.1*196
  1. N PRCDT,PRCDT1,PRCTAPPR
  1. 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
  1. I $D(PRCBBMY) S PRCCKERR=0 Q
  1. S PRCDTT=1700+$E(DT,1,3)
  1. 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
  1. 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"
  1. I PRCSTDT<PRCDT!(PRCSTDT>PRCDT1) D
  1. . S PRCCKERR=1
  1. . W !!," ** Date must be specified for time **",!," ** period covered by fiscal year ",PRC("BBFY")," **",!
  1. Q
  1. 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