source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCOVRQ.m@ 623

Last change on this file since 623 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.8 KB
Line 
1PRCOVRQ ;WISC/DJM/DL/BGJ-IFCAP VRQ ENTRY ROUTINE ; 1/28/98 0900
2V ;;5.1;IFCAP;**30**;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4NEW(VEN1,SITE) ;VEN1 = VENDOR INTERNAL ENTRY NUMBER
5 N %,B,DATE,GECSFMS,FLAGN,FY,I,J,PS,NAME,MO,PAY,PAY1,PRCOVA,PRCOVA3,PRCOVN,PRCOVN3,SEQ,SSNT,ST,TIME,TRANS,VEN,VEND,X,Y
6 S (I,J)=0 F S I=$O(^PRC(411,I)) Q:I'>0 S J=J+1
7 I J=1 S I=$O(^PRC(411,0)) Q:I'=SITE
8 S PS=$O(^PRC(411,"AC","Y",0))
9 I PS="" W !,"There are "_J_" entries in your IFCAP SITE PARAMETER file.",!,"You need to set one as the PRIMARY STATION." Q
10 I J>1 S SITE=PS
11 S FLAGN=$G(^PRC(440.3,VEN1,0))
12 S PRCOVN=$G(^PRC(440,VEN1,0))
13 S PRCOVN3=$G(^PRC(440,VEN1,3))
14 S PAY=$G(^PRC(440,VEN1,7))
15 I FLAGN]"" D
16 .S PRCOVA=FLAGN
17 .S PRCOVA3=$G(^PRC(440.3,VEN1,3))
18 .S PAY1=$G(^PRC(440.3,VEN1,7))
19 G:PRCOVN3="" EXIT ;THERE IS NO DATA IN NODE 3 FOR THIS VENDOR--THIS USUALLY WILL NOT HAPPEN. CAN ONLY QUIT WITHOUT CREATING 'VRQ'
20 ;
21 G:$P(PRCOVN3,U,6)="N" EXIT ;NON-RECURRING VENDOR "N"=ONE-TIME VENDOR--DON'T NEED TO 'ADD'
22 ;
23 G:$P(PRCOVN3,U,4)]"" EXIT ;FMS VENDOR CODE VENDOR UPDATED--DON'T NEED TO 'ADD' AGAIN
24 ;
25 G:$P(PRCOVN3,U,9)=""!($P(PRCOVN3,U,8)="") EXIT ;NO TAX ID/SSN OR SSN/TAX ID INDICATOR--DON'T HAVE ALL INFORMATION TO SEND 'VRQ'
26 ;
27 G:PAY="" EXIT ;DON'T HAVE ANY PAYMENT ADDRESS INFORMATION--DON'T SEND 'VRQ'
28 ;
29 I FLAGN="" G DOIT ;THIS IS A NEW IFCAP VENDOR ENTRY--SEND IT
30 I $P(PRCOVN3,U,4)="",$P(PRCOVN3,U,12)="" G DOIT ;THIS ENTRY NEEDS TO BE SENT BECAUSE IT WASEN'T EVER DONE BEFORE
31 ;
32 I $P(PRCOVN,U)'=$P(PRCOVA,U) G DOIT
33 I $P(PRCOVN3,U,11)'=$P(PRCOVA3,U,11) G DOIT
34 I $P(PRCOVN3,U,13)'=$P(PRCOVA3,U,13) G DOIT
35 I $P(PRCOVN3,U,14)'=$P(PRCOVA3,U,14) G DOIT
36 I $P(PAY,U,3)'=$P(PAY1,U,3) G DOIT
37 I $P(PAY,U,4)'=$P(PAY1,U,4) G DOIT
38 I $P(PAY,U,7)'=$P(PAY1,U,7) G DOIT
39 I $P(PAY,U,8)'=$P(PAY1,U,8) G DOIT
40 I $P(PAY,U,9)'=$P(PAY1,U,9) G DOIT
41 G EXIT ;USER DIDN'T CHANGE ANYTHING USED TO CREAT A VENDOR REQUEST
42 ;
43DOIT 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
44 ;
45 K ^PRC(440.3,VEN1)
46 D NOW^%DTC S DATE=$P(%,"."),DATE=$E(DATE,2,7),TIME=$P(%,".",2)_"000000",TIME=$E(TIME,1,6)
47 S FY=$E($P(%,"."),2,3),MO=$E($P(%,U),4,5),FY=$E(100+$S(+MO>9:FY+1,1:FY),2,3)
48 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
49 Q:$P(PRCOVN3,U,8)=""!($P(PRCOVN3,U,14)="")
50 S B="VRQ^"_DATE_"^"_TIME_"^"_SITE_"^"_VEN1_"^"_$P(PRCOVN3,U,8)_"^"_$S($P(PRCOVN3,U,5)]"":$P(PRCOVN3,U,5),1:"")
51 S NAME=$P($G(^PRC(440,VEN1,0)),"^"),NAME=$E(NAME,1,30)
52 S B=B_"^"_NAME_"^",PAY=$G(^PRC(440,VEN1,7)) Q:PAY=""
53 Q:$P(PAY,U,3)=""!($P(PAY,U,7)="")!($P(PAY,U,8)="")!($P(PAY,U,9)="")
54 S B=B_$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)_"^"
55 S ST=$P(PAY,U,8) Q:ST="" S ST=$E($P($G(^DIC(5,ST,0)),U,2),1,2) Q:ST=""
56 S B=B_ST_"^"_$TR($P(PAY,U,9),"-")_"^",VEND=$S($P(PRCOVN3,U,11)]"":$P(PRCOVN3,U,11),1:"N")
57 S SSNT=$S($P(PRCOVN3,U,9)]"":$P(PRCOVN3,U,9),1:"T") S:VEND="N" SSNT=""
58 S B=B_SSNT_"^"_VEND_"^"_$P(PRCOVN3,U,14)_"^N^A^~"
59 ;
60 W !,"Creating the FMS VENDOR REQUEST."
61 S $P(^PRC(440,VEN1,3),U,12)="P"
62 S DIR(0)="E"
63 S DIR("A")="Enter RETURN to continue"
64 D ^DIR
65 K DIR
66 W !
67 ;
68 D CONTROL^GECSUFMS("I",SITE,TRANS,"VR","","","","Vendor Request") ;REQUEST GENERIC CODE SHEET PACKAGE SET UP AN ENTRY IN FILE 2100.1
69 ;
70 D SETCS^GECSSTAA(GECSFMS("DA"),B) ;ENTER THE 'VRQ' SEGMENT INTO FILE 2100.1 RECORD CREATED IN PREVIOUS CALL
71 ;
72 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
73 ;
74 Q
75 ;
76EXIT ;USE THIS EXIT ONLY IF NO VRQ SHOULD BE CREATED
77 W !,"The system determined that no VRQ needed or could be created."
78 S DIR(0)="E"
79 S DIR("A")="Enter RETURN to continue"
80 D ^DIR
81 K DIR
82 Q
Note: See TracBrowser for help on using the repository browser.