source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCORV.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: 5.0 KB
Line 
1PRCORV ;WISC/DJM/BGJ-IFCAP VRQ REVIEW ROUTINE ;5/8/96 11:00 AM
2V ;;5.1;IFCAP;**7**;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4EN ; -- main entry point for PRCO VENDOR REVIEW
5 ;First lets check if there are any VRQs to review. IF not - exit.
6 S COUNT=$O(^PRCF(422.2,"B","123-VRQ-01",0)) I COUNT'>0 G NODO
7 S COUNT=$P($G(^PRCF(422.2,COUNT,0)),U,2) I COUNT'>0 G NODO
8 K COUNT
9 ;
10 D TERM
11 D EN^VALM("PRCO VENDOR REVIEW")
12 Q
13 ;
14HDR ; -- header code
15 S VALMHDR(1)="VENDOR REQUESTs for review"
16 Q
17 ;
18INIT ; -- init variables and list array
19 N NAME,CNT,VDA,FMS,ALT,TAX,COUNT,LINENO,LIST
20 K ^TMP("PRCORV",$J)
21 S LIST=0,NAME=""
22 I $O(^PRC(440.3,"AD",NAME))="" W !,"No VRQs to review" Q
23 D CLEAN^VALM10
24 S COUNT=0,LINENO=0,NAME=""
25 F S NAME=$O(^PRC(440.3,"AD",NAME)) Q:NAME="" D
26 . S LIST=0
27 . F S LIST=$O(^PRC(440.3,"AD",NAME,LIST)) Q:LIST="" D
28 . . S NAME=$S($G(NAME)]"":NAME,1:$G(^PRC(440,LIST,0))) Q:NAME=""
29 . . I $G(^PRC(440.3,LIST,"VRQ"))']"" D Q
30 . . . K ^PRC(440.3,LIST)
31 . . . K ^PRC(440.3,"AD",NAME,LIST,LIST)
32 . . S VDA=0
33 . . F S VDA=$O(^PRC(440.3,"AD",NAME,LIST,VDA)) Q:VDA="" D
34 . . . S COUNT=COUNT+1
35 . . . S FMS=$P($G(^PRC(440,VDA,3)),U,4)
36 . . . S ALT=$P($G(^PRC(440,VDA,3)),U,5)
37 . . . S FMS=FMS_$S(ALT]"":"-"_FMS,1:"")
38 . . . S TAX=$P($G(^PRC(440,VDA,3)),U,8)
39 . . . S X=$$SETFLD^VALM1(COUNT,"","NUMBER")
40 . . . S X=$$SETFLD^VALM1(NAME,X,"VENDOR")
41 . . . S X=$$SETFLD^VALM1(FMS,X,"FMS VENDOR")
42 . . . S X=$$SETFLD^VALM1(TAX,X,"TAX ID/SSN")
43 . . . S LINENO=LINENO+1
44 . . . D SET^VALM10(COUNT,X,LINENO)
45 . . . S ^TMP("PRCORV",$J,LINENO)=COUNT_"^"_LIST
46 . . . Q
47 . . Q
48 . Q
49 S VALMCNT=COUNT
50 S LN=$O(^PRCF(422.2,"B","123-VRQ-01",0))
51 S $P(^PRCF(422.2,LN,0),U,2)=COUNT
52 Q
53 ;
54HELP ; -- help code
55 S X="?" D DISP^XQORM1 W !!
56 Q
57 ;
58EXIT ; -- exit code
59 D CLEAR^VALM1 K ^TMP($J,"PRCORV")
60 K ^TMP("PRCORV",$J)
61 Q
62 ;
63EXPND ; -- expand code
64 Q
65 ;
66TERM ; -- get terminal attributes
67 N X
68 I '$D(IOF)!('$G(IOST(0))) S IOP="HOME" D ^%ZIS K IOP
69 S X="IORVON;IORVOFF" D ENDR^%ZISS
70 S PRCO("RV1")=$G(IORVON),PRCO("RV0")=$G(IORVOFF)
71 S PRCO("XY")="N DX,DY S (DX,DY)=0 "_$G(^%ZOSF("XY"))
72 Q
73 ;
74SET(STRING,LINE,COLUMN,CLREND,ON,OFF) ; -- set array
75 S COLUMN=$S($G(COLUMN)>0:COLUMN,1:1)
76 I STRING="" D SET^VALM10(LINE,$J("",80),COLUMN)
77 I '$D(@VALMAR@(LINE,0)) D SET^VALM10(LINE,$J("",80),COLUMN)
78 D SET^VALM10(LINE,STRING,COLUMN)
79 I $G(ON)]""!($G(OFF)]"") D CNTRL^VALM10(LINE,COLUMN,$L(STRING),ON,OFF)
80 Q
81 ;
82NODO ;COME HERE IF THERE ARE NO VRQs TO REVIEW.
83 W !!,"There are no VRQs for you to review at this time.",!!
84 S DIR(0)="E"
85 S DIR("A")="Enter RETURN to continue"
86 D ^DIR
87 K DIR
88 Q
89 ;
90PRINT ;PRINTING OF A COMPLETE REVIEW OF VENDOR ENTRY
91 N %ZIS,AA,POP
92 D EN^VALM2(XQORNOD(0),"O")
93 Q:'$D(VALMY)
94 D FULL^VALM1
95 W @IOF
96 K IO("Q")
97 S %ZIS="MQ",%ZIS("A")="Select a printer: ",%ZIS("B")=""
98 S %ZIS("S")="S AA=$G(^%ZIS(1,Y,""SUBTYPE"")) I AA>0,$E($G(^%ZIS(2,AA,0)),1)=""P"""
99 D ^%ZIS
100 I POP W !!," No printer selected -- quitting." G PRINTQ
101 I $D(IO("Q")) K IO("Q") D G PRINTQ
102 . S ZTRTN="PRINT1^PRCORV"
103 . S ZTSAVE("VALMY(")=""
104 . S ZTSAVE("^TMP(""PRCORV"",$J,")=""
105 . S ZTDESC="Complete review of vender entry"
106 . D ^%ZTLOAD
107 . Q
108 ;
109PRINT1 ;ENTER HERE TO PRINT THE REPORT
110 N DIC,DA,DIQ,SPACE,%,%H,%I,X,Y,FIELD,PN,PRCOI,PRCOIN,IEN
111 S (PRCOI,PN)=0
112 ;GET THE IEN FOR EACH ENTRY SELECTED
113 F S PRCOI=$O(VALMY(PRCOI)) Q:PRCOI'>0 D
114 . S PRCOIN=$G(^TMP("PRCORV",$J,PRCOI))
115 . S IEN=+$P(PRCOIN,U,2)
116 . S PN=PN+1
117 . D PRINT2
118 G PRINTQ
119 ;
120PRINT2 ;PRINT EACH ENTRY SELECTED HERE
121 K PRCORVP
122 S DIC="^PRC(440,",DA=IEN,DR=".01:46",DIQ="PRCORVP",DIQ(0)="E"
123 D EN^DIQ1
124 S $P(SPACE," ",24)=" "
125 U IO
126 W:$Y>0 @IOF
127 I $D(ZTQUEUED) W:PN>1 !
128 W !!,?9,"VENDOR Review"
129 W ?38
130 D NOW^%DTC
131 D YX^%DTC
132 W Y
133 W ?70,"PAGE: "_PN
134 W !!,?11,"Vendor Name: "_$$FIELD(.01)
135 W !,?6,"Ordering Address: "_$$FIELD(1)
136 W:$$FIELD(2)]"" !,SPACE_$$FIELD(2)
137 S X=SPACE
138 S:$$FIELD(4.2)]"" X=X_$$FIELD(4.2)_", "
139 S:$$FIELD(4.4)]"" X=X_$$FIELD(4.4)_" "
140 S X=X_$S($L($$FIELD(4.6))=9:$E($$FIELD(4.6),1,5)_"-"_$E($$FIELD(4.6),6,9),1:$$FIELD(4.6))
141 W !,X
142 W !!,?14,"FMS Name: "_$$FIELD(34.5)
143 W !!,?7,"Payment ADDRESS: "_$$FIELD(17.3)
144 W !,SPACE,$$FIELD(17.4)
145 W:$$FIELD(17.5)]"" !,SPACE_$$FIELD(17.5)
146 W:$$FIELD(17.6)]"" !,SPACE_$$FIELD(17.6)
147 S X=SPACE
148 S:$$FIELD(17.7)]"" X=X_$$FIELD(17.7)_", "
149 S:$$FIELD(17.8)]"" X=X_$$FIELD(17.8)_" "
150 S X=X_$S($L($$FIELD(17.9))=9:$E($$FIELD(17.9),1,5)_"-"_$E($$FIELD(17.9),6,9),1:$$FIELD(17.9))
151 W !,X
152 W !!,"PAYMENT CONTACT PERSON: "_$$FIELD(17)
153 W !," PAYMENT PHONE NUMBER: "_$$FIELD(7.2)
154 W !!,?7,"FMS VENDOR CODE: "_$$FIELD(34)
155 W !,?10,"ALT-ADDR-IND: "_$$FIELD(35)
156 W !,?12,"TAX ID/SSN: "_$$FIELD(38)
157 W !,?8,"SSN/TAX ID IND: "_$$FIELD(39)
158 W !!,?8,"NON-RECURRING/"
159 W !,?6,"RECURRING VENDOR: "_$$FIELD(36)
160 W !!," 1099 VENDOR INDICATOR: "_$$FIELD(41)
161 W !,?11,"VENDOR TYPE: "_$$FIELD(44)
162 W !,?6,"DUN & BRADSTREET: "_$$FIELD(18.3)
163 Q
164 ;
165PRINTQ S VALMBCK="R",VALMBG=1
166 S:$D(ZTQUEUED) ZTREQ="@"
167 D ^%ZISC
168PRINTQ1 Q
169 ;
170FIELD(FIELD) ;FETCH EXTERNAL VALUE OF FIELD
171 ;FOR RECORD 'IEN' FROM FILE 440
172 S FIELD=$G(PRCORVP(440,IEN,FIELD,"E"))
173 Q FIELD
Note: See TracBrowser for help on using the repository browser.