69 lines
3.4 KiB
Mathematica
69 lines
3.4 KiB
Mathematica
|
PRCOVRQ1 ;WISC/DJM/DL/BGJ-IFCAP VRQ CHANGE ROUTINE ; 1/28/98 0900
|
||
|
|
V ;;5.1;IFCAP;**30**;Oct 20, 2000
|
||
|
|
;Per VHA Directive 10-93-142, this routine should not be modified.
|
||
|
|
UPDATE(VEN1,SITE) ;VEN1 = VENDOR INTERNAL ENTRY NUMBER
|
||
|
|
;SITE = STATION NUMBER
|
||
|
|
N %,B,DATE,FY,GECSFMS,I,J,PS,MO,PAY,PAY1,PRCOVA,PRCOVN,PRCOVA3,PRCOVN3,SEQ,SSNT,ST,TIME,TRANS,VEND,X,Y,NAME
|
||
|
|
S (I,J)=0 F S I=$O(^PRC(411,I)) Q:I'>0 S J=J+1
|
||
|
|
I J=1 S I=$O(^PRC(411,0)) Q:I'=SITE
|
||
|
|
S PS=$O(^PRC(411,"AC","Y",0))
|
||
|
|
I PS="" W !,"There are "_J_" entries in your IFCAP SITE PARAMETER file.",!,"You need to set one as the PRIMARY STATION." Q
|
||
|
|
I J>1 S SITE=PS
|
||
|
|
S PRCOVN=$G(^PRC(440,VEN1,0)),PRCOVA=$G(^PRC(440.3,VEN1,0))
|
||
|
|
S PRCOVN3=$G(^PRC(440,VEN1,3)),PAY=$G(^PRC(440,VEN1,7))
|
||
|
|
S PRCOVA3=$G(^PRC(440.3,VEN1,3)) ;ORGINAL DATA BEFORE EDIT - USE TO SEE IF ENTRY WAS CHANGED
|
||
|
|
S PAY1=$G(^PRC(440.3,VEN1,7))
|
||
|
|
;
|
||
|
|
G:PRCOVN3="" EXIT ;THERE IS NO DATA IN NODE 3 FOR THIS VENDOR--THIS USUALLY WILL NOT HAPPEN. CAN ONLY QUIT WITHOUT CREATING 'VRQ'
|
||
|
|
;
|
||
|
|
G:PAY="" EXIT ;DON'T HAVE ANY PAYMENT ADDRESS INFORMATION--DON'T SEND 'VRQ'
|
||
|
|
;
|
||
|
|
I $P(PRCOVN,U)'=$P(PRCOVA,U) G DOIT ;USER CHANGED VENDOR NAME
|
||
|
|
I $P(PRCOVN3,U,11)'=$P(PRCOVA3,U,11) G DOIT ;USER CHANGED 1099 VENDOR INDICATOR
|
||
|
|
I $P(PRCOVN3,U,13)'=$P(PRCOVA3,U,13) G DOIT ;USER CHANGED CENTERAL REMIT
|
||
|
|
I $P(PRCOVN3,U,14)'=$P(PRCOVA3,U,14) G DOIT ;USER CHANGED VENDOR TYPE
|
||
|
|
I $P(PAY,U,3)'=$P(PAY1,U,3) G DOIT ;USER CHANGED PAYMENT ADDRESS1
|
||
|
|
I $P(PAY,U,4)'=$P(PAY1,U,4) G DOIT ;USER CHANGED PAYMENT ADDRESS2
|
||
|
|
I $P(PAY,U,7)'=$P(PAY1,U,7) G DOIT ;USER CHANGED PAYMENT CITY
|
||
|
|
I $P(PAY,U,8)'=$P(PAY1,U,8) G DOIT ;USER CHANGED PAYMENT STATE
|
||
|
|
I $P(PAY,U,9)'=$P(PAY1,U,9) G DOIT ;USER CHANGED PAYMENT ZIP CODE
|
||
|
|
G EXIT ;USER DIDN'T CHANGE ANYTHING NEEDED TO CREAT A VENDOR REQUEST
|
||
|
|
;
|
||
|
|
DOIT S DIR("A")="DOES A VRQ NEED TO GO TO AUSTIN (YES/NO)",DIR("B")="NO",DIR(0)="Y" D ^DIR K DIR I $D(DIRUT)!(Y=0) Q
|
||
|
|
;
|
||
|
|
K ^PRC(440.3,VEN1)
|
||
|
|
D NOW^%DTC S DATE=$P(%,"."),DATE=$E(DATE,2,7),TIME=$P(%,".",2)_"000000",TIME=$E(TIME,1,6)
|
||
|
|
S FY=$E($P(%,"."),2,3),MO=$E($P(%,U),4,5),FY=$E(100+$S(+MO>9:FY+1,1:FY),2,3)
|
||
|
|
K PRCFLN S X=SITE_"-"_FY_"-"_MO D COUNTER^PRCFACP S SEQ="000"_Y,SEQ=$E(SEQ,$L(SEQ)-3,99),TRANS=SITE_FY_MO_SEQ
|
||
|
|
S B="VRQ^"_DATE_"^"_TIME_"^"_SITE_"^"_VEN1_"^"_$P(PRCOVN3,U,4)_"^"_$S($P(PRCOVN3,U,5)]"":$P(PRCOVN3,U,5),1:"")
|
||
|
|
S NAME=$E($P(PRCOVN,U),1,30)
|
||
|
|
S B=B_"^"_NAME_"^"_$E($P(PAY,U,3),1,30)_"^"_$S($P(PAY,U,4)]"":$E($P(PAY,U,4),1,30),1:"")_"^"_$E($P(PAY,U,7),1,19)_"^"
|
||
|
|
S ST=$P(PAY,U,8) Q:ST="" S ST=$E($P($G(^DIC(5,ST,0)),U,2),1,2)
|
||
|
|
S B=B_ST_"^"_$TR($P(PAY,U,9),"-")_"^"
|
||
|
|
S SSNT=$S($P(PRCOVN3,U,9)]"":$P(PRCOVN3,U,9),1:"T")
|
||
|
|
S VEND=$S($P(PRCOVN3,U,11)]"":$P(PRCOVN3,U,11),1:"N") S:VEND="N" SSNT=""
|
||
|
|
S B=B_SSNT_"^"_VEND_"^"_$P(PRCOVN3,U,14)_"^N^C^~"
|
||
|
|
;
|
||
|
|
W !,"Creating the FMS VENDOR REQUEST."
|
||
|
|
S $P(^PRC(440,VEN1,3),U,12)="P"
|
||
|
|
S DIR(0)="E"
|
||
|
|
S DIR("A")="Enter RETURN to continue"
|
||
|
|
D ^DIR
|
||
|
|
K DIR
|
||
|
|
W !
|
||
|
|
;
|
||
|
|
D CONTROL^GECSUFMS("I",SITE,TRANS,"VR","","","","Vendor Request") ;REQUEST GENERIC CODE SHEET PACKAGE SET UP AN ENTRY IN FILE 2100.1
|
||
|
|
;
|
||
|
|
D SETCS^GECSSTAA(GECSFMS("DA"),B) ;ENTER THE 'VRQ' SEGMENT INTO FILE 2100.1 RECORD CREATED IN PREVIOUS CALL
|
||
|
|
;
|
||
|
|
D SETSTAT^GECSSTAA(GECSFMS("DA"),"Q") ;TELL GCS PACKAGE WHAT TO DO WITH THIS RECORD--'QUEUE' IT TO SEND THE NEXT TIME ANY FMS TRANSACTIONS ARE SENT TO AUSTIN
|
||
|
|
;
|
||
|
|
Q
|
||
|
|
EXIT ;USE THIS EXIT ONLY IF NO VRQ SHOULD BE CREATED
|
||
|
|
W !,"The system determined that no VRQ needed or could be created."
|
||
|
|
S DIR(0)="E"
|
||
|
|
S DIR("A")="Enter RETURN to continue"
|
||
|
|
D ^DIR
|
||
|
|
K DIR
|
||
|
|
Q
|