source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCOVTST.m@ 1800

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

initial load of WorldVistAEHR

File size: 5.7 KB
RevLine 
[613]1PRCOVTST ;WISC/DJM/BGJ-IFCAP VRQ TO-DO ROUTINE ; [10/19/98 11:20am]
2V ;;5.1;IFCAP;**30**;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4NEW(VEN1,SITE,FLAG) ;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 FLAGN=$G(^PRC(440.3,VEN1,0))
7 S PRCOVN=$G(^PRC(440,VEN1,0))
8 S PRCOVN3=$G(^PRC(440,VEN1,3))
9 S PAY=$G(^PRC(440,VEN1,7))
10 I FLAGN]"" D
11 .S PRCOVA=FLAGN
12 .S PRCOVA3=$G(^PRC(440.3,VEN1,3))
13 .S PAY1=$G(^PRC(440.3,VEN1,7))
14 G:PRCOVN3="" EXIT ;THERE IS NO DATA IN NODE 3 FOR THIS VENDOR--THIS USUALLY WILL NOT HAPPEN. CAN ONLY QUIT WITHOUT CREATING 'VRQ'
15 ;
16 G:$P(PRCOVN3,U,6)="N" EXIT ;NON-RECURRING VENDOR "N"=ONE-TIME VENDOR--DON'T NEED TO 'ADD'
17 ;
18 I FLAG=1,$P(PRCOVN3,U,4)]"" G EXIT ;'ADD' VRQ & FMS VENDOR CODE??? VENDOR UPDATED--DON'T NEED TO 'ADD' AGAIN (SHOULD NOT SEE THIS)
19 ;
20 I FLAG=1,(($P(PRCOVN3,U,9)="")!($P(PRCOVN3,U,8)="")) G EXIT ;NO TAX ID/SSN OR SSN/TAX ID INDICATOR--DON'T HAVE ALL INFORMATION TO SEND 'VRQ'
21 ;
22 G:PAY="" EXIT ;DON'T HAVE ANY PAYMENT ADDRESS INFORMATION--DON'T SEND 'VRQ'
23 ;
24 I FLAGN="" G DOIT ;THIS IS A NEW IFCAP VENDOR ENTRY--SEND IT
25 I FLAG=1,$P(PRCOVN3,U,4)="",$P(PRCOVN3,U,12)="" G DOIT ;THIS ENTRY NEEDS TO BE SENT BECAUSE IT WASEN'T EVER DONE BEFORE
26 ;
27 I $P(PRCOVN,U)'=$P(PRCOVA,U) G DOIT
28 I $P(PRCOVN3,U,11)'=$P(PRCOVA3,U,11) G DOIT
29 I $P(PRCOVN3,U,13)'=$P(PRCOVA3,U,13) G DOIT
30 I $P(PRCOVN3,U,14)'=$P(PRCOVA3,U,14) G DOIT
31 I $P(PAY,U,3)'=$P(PAY1,U,3) G DOIT
32 I $P(PAY,U,4)'=$P(PAY1,U,4) G DOIT
33 I $P(PAY,U,7)'=$P(PAY1,U,7) G DOIT
34 I $P(PAY,U,8)'=$P(PAY1,U,8) G DOIT
35 I $P(PAY,U,9)'=$P(PAY1,U,9) G DOIT
36 G EXIT ;USER DIDN'T CHANGE ANYTHING USED TO CREAT A VENDOR REQUEST
37 ;
38DOIT ;COME HERE IF A VRQ SHOULD BE CREATED.
39 S NOVRQ=0
40 Q NOVRQ
41 ;
42EXIT ;USE THIS EXIT ONLY IF NO VRQ SHOULD BE CREATED.
43 ;DON'T FORGET TO REMOVE UN-EDITED COPY OF VENDOR RECORD (IN 440.3).
44 K ^PRC(440.3,VEN1)
45 S NOVRQ=1
46 Q NOVRQ
47 ;
48CHECK(DA,SITE,FLAG) ; CALL TO SEE IF VENDOR IS PROPERLY SET UP FROM AR
49 ; VENDOR LOOKUP CALL -- VENSEL^PRCHUTL().
50 ; COME HERE TO DECIDE WHAT NEEDS TO BE DONE WITH THE SELECTED
51 ; VENDOR.
52 ;
53 ; RETURNED VALUE MEANING
54 ; 0 NEED TO CREATE A VRQ - ALL DATA TO
55 ; CREATE A VRQ IS HERE.
56 ; 1 NEED TO EDIT VENDOR RECORD BEFORE A
57 ; VRQ CAN BE CREATED.
58 ; 2 THE VENDOR IS PROPERLY SET UP. NO
59 ; VRQ NEEDS TO BE CREATED.
60 ;
61 S PRCOVN3=$G(^PRC(440,DA,3))
62 I FLAG=1,$P(PRCOVN3,U,4)]"" G EXIT2 ;ADD VRQ WITH FMS VENDOR CODE
63 ; PRESENT??? VENDOR UPDATED--DON'T NEED TO 'ADD' AGAIN.
64 ;
65 S (I,J)=0
66 F S I=$O(^PRC(411,I)) Q:I'>0 S J=J+1
67 I J>1 S PS=$O(^PRC(411,"AC","Y",0)) G:PS="" EXIT1
68 ; 'PRIMARY STATION' NEEDS TO BE FILLED IN.
69 ;
70 S PAY=$G(^PRC(440,DA,7))
71 G:PRCOVN3="" EXIT1 ; THIS RECORD NEEDS TO BE EDITED.
72 ;
73 G:$P(PRCOVN3,U,6)="N" EXIT1 ; NON-RECURRING VENDOR THIS RECORD
74 ; NEEDS TO BE EDITED.
75 ;
76 G:$P(PRCOVN3,U,14)="" EXIT1 ; VENDOR TYPE UNDEFINED.
77 G:PAY="" EXIT1
78 ; DON'T HAVE ANY PAYMENT ADDRESS INFORMATION--EDIT THIS RECORD.
79 ;
80 G:$P(PAY,U,3)=""!($P(PAY,U,7)="")!($P(PAY,U,8)="")!($P(PAY,U,9)="") EXIT1 ; PAYMENT FIELDS AREN'T FILLED IN.
81 S ST=$P(PAY,U,8)
82 S ST=$E($P($G(^DIC(5,ST,0)),U,2),1,2)
83 G:ST="" EXIT1 ; FOR SOME REASON THIS STATE IS MISSING FROM THE
84 ; STATE FILE.
85 ;
86 I FLAG=1,(($P(PRCOVN3,U,9)="")!($P(PRCOVN3,U,8)="")) G EXIT1
87 ; NO TAX ID/SSN OR SSN/TAX ID INDICATOR--DON'T HAVE ALL INFORMATION
88 ; TO SEND 'VRQ'. EDIT THIS RECORD.
89 ;
90DOIT1 ; COME HERE IF A VRQ SHOULD BE CREATED.
91 S NOVRQ=0
92 Q NOVRQ
93 ;
94EXIT1 ; COME HERE IF THE VENDOR RECORD NEEDS TO BE EDITED.
95 S NOVRQ=1
96 Q NOVRQ
97 ;
98EXIT2 ; USE THIS EXIT ONLY IF NO VRQ SHOULD BE CREATED.
99 ; IF THERE IS NO "AR" NODE PRESENT REMOVE UN-EDITED COPY OF VENDOR
100 ; RECORD (IN 440.3).
101 S NODE=$D(^PRC(440.3,DA,"AR"))
102 I NODE]"" S NODE=1
103 K:NODE=0 ^PRC(440.3,DA)
104 S NOVRQ=2
105 Q NOVRQ
106 ;
107VRQ(DA,SITE) ; COME HERE TO SEND A VRQ FOR THE VENDOR RECORD SELECTED
108 ; BY THE AR USER. THIS ENTRY POINT IS CALLED FROM VENSEL^PRCHUTL().
109 S PRCXDA=DA
110 K ^PRC(440.3,DA)
111VRQ1 S PRCOVN3=$G(^PRC(440,DA,3))
112 D NOW^%DTC
113 S DATE=$P(%,".")
114 S DATE=$E(DATE,2,7)
115 S TIME=$P(%,".",2)_"000000"
116 S TIME=$E(TIME,1,6)
117 S FY=$E($P(%,"."),2,3)
118 S MO=$E($P(%,U),4,5)
119 S FY=$E(100+$S(+MO>9:FY+1,1:FY),2,3)
120 K PRCFLN
121 S X=SITE_"-"_FY_"-"_MO
122 D COUNTER^PRCFACP
123 S SEQ="000"_Y
124 S SEQ=$E(SEQ,$L(SEQ)-3,99)
125 S TRANS=SITE_FY_MO_SEQ
126 S DA=PRCXDA
127 S B="VRQ^"_DATE_"^"_TIME_"^"_SITE_"^"_DA_"^"_$P(PRCOVN3,U,8)_"^"
128 S B=B_$S($P(PRCOVN3,U,5)]"":$P(PRCOVN3,U,5),1:"")
129 S NAME=$P($G(^PRC(440,DA,0)),"^")
130 S NAME=$E(NAME,1,30)
131 S B=B_"^"_NAME_"^"
132 S PAY=$G(^PRC(440,DA,7))
133 S B=B_$E($P(PAY,U,3),1,30)_"^"
134 S B=B_$S($P(PAY,U,4)]"":$E($P(PAY,U,4),1,30),1:"")_"^"
135 S B=B_$E($P(PAY,U,7),1,19)_"^"
136 S ST=$P(PAY,U,8)
137 S ST=$E($P($G(^DIC(5,ST,0)),U,2),1,2)
138 S B=B_ST_"^"_$TR($P(PAY,U,9),"-")_"^"
139 S VEND=$S($P(PRCOVN3,U,11)]"":$P(PRCOVN3,U,11),1:"N")
140 S SSNT=$S($P(PRCOVN3,U,9)]"":$P(PRCOVN3,U,9),1:"T")
141 S:VEND="N" SSNT=""
142 S B=B_SSNT_"^"_VEND_"^"_$P(PRCOVN3,U,14)_"^N^A^~"
143 ;
144 ; REQUEST GENERIC CODE SHEET PACKAGE SET UP AN ENTRY IN FILE 2100.1.
145 ;
146 D CONTROL^GECSUFMS("I",SITE,TRANS,"VR","","","","Vendor Request")
147 ;
148 ; ENTER THE 'VRQ' SEGMENT INTO FILE 2100.1 RECORD CREATED IN
149 ; PREVIOUS CALL.
150 ;
151 D SETCS^GECSSTAA(GECSFMS("DA"),B)
152 ;
153 ; TELL GCS PACKAGE WHAT TO DO WITH THIS RECORD--'QUEUE' IT TO SEND
154 ; THE NEXT TIME ANY FMS TRANSACTIONS ARE SENT TO AUSTIN.
155 ;
156 Q
157 ;
158VRQS(DA,SITE) ; COME HERE TO SEND A VRQ FROM THE 'SEND VRQ' PROTOCOL.
159 ;
160 S PRCXDA=DA
161 ;
162 ; NOW LETS GO OVER TO SEND THIS VRQ TO AUSTIN, WITHOUT KILLING THE
163 ; RECORD IN FILE 440.3. THAT RECORD IS USED WITHIN THE AR EDIT
164 ; LIST TEMPLATE UNTIL 'DELETE EDIT REQUEST' REMOVES THE RECORD.
165 ;
166 G VRQ1
Note: See TracBrowser for help on using the repository browser.