Produced by Araxis Merge on 11/9/2018 12:34:08 AM Central Standard Time. See www.araxis.com for information about Merge. This report uses XHTML and CSS2, and is best viewed with a modern standards-compliant browser. For optimum results when printing this report, use landscape orientation and enable printing of background images and colours in your browser.
# | Location | File | Last Modified |
---|---|---|---|
1 | CPEE_Build9_Sprint27.zip\HAC_CPE_CH | CHMVCC05.m | Mon Nov 5 16:45:19 2018 UTC |
2 | CPEE_Build9_Sprint27.zip\HAC_CPE_CH | CHMVCC05.m | Mon Nov 5 17:51:44 2018 UTC |
Description | Between Files 1 and 2 |
|
---|---|---|
Text Blocks | Lines | |
Unchanged | 3 | 440 |
Changed | 2 | 4 |
Inserted | 0 | 0 |
Removed | 0 | 0 |
Whitespace | |
---|---|
Character case | Differences in character case are significant |
Line endings | Differences in line endings (CR and LF characters) are ignored |
CR/LF characters | Not shown in the comparison detail |
No regular expressions were active.
1 | CHMVCC05 ; HAC/JSG;VE NDOR CLEAN UP CONTROL (PRINT QU EUES);07/1 4/08 10:10 AM | |
2 | ; DEV002109- 06;VENDOR FILE CLEAN -UP;Print (any devic e) or expo rt | |
3 | ; (Fs3big) a ll entries for the c urrently A ctive clea n-up queue : | |
4 | ; DEV021753 - JEH - 10 /8/2014 - CG Vendor File Updat e {SKIP CG VENDORS} | |
5 | ; DEV012893 - DPT - RM V DECNET | |
6 | PRINT(QT,Q TN) ;(Queu e Type,Que ue Type Na me) | |
7 | I QT'>0 D D ERR("Activ ated queue required. ") Q | |
8 | N OQ,OQS,Q, QE,QED,TAB ,TYPE,DEL, TODAY,IOFI LE,CHUCI,X DUZ | |
9 | S Q=$$OPEN( QT-1),OQS= $P(^CHMVCC (Q,0),U,10 ) ; Queue stat us | |
10 | I OQS=3 D D ERR("Print ing in pro gress.") Q | |
11 | I OQS'>1 D DERR("Queu e must be built.") Q | |
12 | S QE=$P(^CH MVCC(Q,100 ,0),U,4) ;Numbe r of entri es | |
13 | I QT=6 S X= "Preparing to Print entries fr om Exempti ons Queue. " | |
14 | E S X="Pre paring to Print "_QE _" entries for "_QTN _" Queue." | |
15 | W :$$PXY(5,0 ) !,?80 | |
16 | W :$$PXY(6,4 0-($L(X)\2 )+1) @CHBO N,X,@CHBOF F,!,CHL | |
17 | D SCROLL("B ") ;Blank scroll ar ea | |
18 | S QED=0,XDU Z=DUZ G:"^ ^@"[$$PARA M PEND ;G et run tim e paramete rs | |
19 | I $D(IO("Q" ))!(TYPE=" E") S QED= 1 ;2Q!' 2Q | |
20 | S TAB=$S(DE L'="":DEL, 1:U) | |
21 | S :QT=6 Q=+E SQ,ET=$P(E SQ,U,2),QE =$P(^CHMVC C(Q,100,0) ,U,4) | |
22 | I F 'QED { D PRINTQ } ;If not queuei ng | |
23 | E LSE { S CH FIO=$G(ION ),ZTIO="" ;If queuei ng | |
24 | I TYPE ="E" S IOP =0 | |
25 | E S % ZIS="Q",IO P="Q;"_CHF IO D ^%ZIS K ZTIO | |
26 | S ZTRT N="PRINTQ^ CHMVCC05" D VARSAVE D ^%ZTLOAD | |
27 | S IOP= "HOME" D H OME^%ZIS | |
28 | W !,"Y our Task N umber is: ",$G(ZTSK) | |
29 | R !!," Press <Ent er> to con tinue: ",X :300 } | |
30 | PEND D SCROLL("R ") Q ;Re-di splay scre en | |
31 | DERR(T) ;( Text) Disp lay error message: | |
32 | W " ?? ",$ C(7),T,?50 ," " H 3 Q | |
33 | OPEN(T) ;( Type of qu eue);Get c urrent ope n queue: | |
34 | Q $O(^CHMVCC ("C",T,999 9999),-1) | |
35 | PXY(R,C) ; Position c urser | |
36 | S DY=R,(DX, $X)=C X XY Q 1 | |
37 | SCROLL(A) ;(Action); Blank, Re- display; | |
38 | IF A="B" { S DTM=9,D BM=21 X CH MAR | |
39 | D RNGECLR ^CHSC1(8,2 1,XY,CHEOL ) | |
40 | W:$$PXY(8 ,1) ?0 } | |
41 | ELSEIF A=" R" { | |
42 | F EP="HEA DER","FOOT ER","COLUM NS","LQUEU ES" D @(EP _"^CHMVCC0 2") | |
43 | D DETAIL^ CHMVCC02(Q ) } | |
44 | Q | |
45 | VARSAVE ;S ave variab les for qu eued job: ; | |
46 | S PAR=$$VPAC K,(ZTSAVE( "CHFIO"),Z TSAVE("U") ,ZTSAVE("P AR"))="" | |
47 | S ZTDESC="Ve ndor Clean -up "_$S(T YPE="P":"R eport",1:" File Extra ct") | |
48 | Q ;--------- ---------- ---------- ---------- ---------- ---------- ; | |
49 | VPACK() Q $LB(TYPE,Q ,DEL,QTN,Q E,QED,TAB, TODAY,IOFI LE,CHUCI,X DUZ,QT,$G( ET)) | |
50 | ;R eturn all variables needed for next job packed --- ---------- ; | |
51 | VSET(P) S TYPE=$LI(P ,1),Q=$LI( P,2),DEL=$ LI(P,3),QT N=$LI(P,4) ,QE=$LI(P, 5) | |
52 | S QED=$LI(P, 6),TAB=$LI (P,7),TODA Y=$LI(P,8) ,IOFILE=$L I(P,9) | |
53 | S CHUCI=$LI( P,10),XDUZ =$LI(P,11) ,QT=$LI(P, 12),ET=$LI (P,13) Q | |
54 | PRINTQ ;No claims qu eue proces sing: ; | |
55 | D:' $D(QED) VS ET(PAR) | |
56 | S O QS=$P(^CHM VCC(Q,0),U ,10),$P(^( 0),U,10)=3 ;Mark Q "Printing " | |
57 | D C HGSTA^CHMV CC07(Q,OQS ,3) ;Update s tatus inde x | |
58 | S $ Y=80 H 2 | |
59 | IF TYPE="E" { | |
60 | ;S XFILE=" HACFS3"" DNS decnet HAC dec741!"": :D:" | |
61 | N FOLDER ,CNTR | |
62 | S IOF="# ,*27,*91,* 50,*74,*27 ,*91,*72" | |
63 | X ^%ZOSF ("UCI") S UCI=$P(Y," ,",1) ;DEV 016554 DPT | |
64 | S FOLDER ="HAC_HFS$ :[SCR.TEMP _FILES]" ; DEV016554 DPT | |
65 | I UCI'=" HAC" S FOL DER="HAC_H FS$:[DSMMA NAG.CHAMPV A]" ;DEV01 6554 DPT | |
66 | S XFILE= FOLDER_IOF ILE | |
67 | ;S XFILE ="HACFS3"" ::D:" | |
68 | ; S XFILE=XF ILE_"[Fs3b ig.Vendor_ Cleanup_Co ntrol]" | |
69 | ; S XFILE=XF ILE_IOFILE | |
70 | S FLDR="/FS 3BIG/Vendo r_Cleanup_ Control" | |
71 | O XFILE:"NW S":1 D INI T(1),HEADE R(1),DETAI L | |
72 | C XFILE | |
73 | D FTPFILE^ CHTFLIB9(X FILE," DNS fs3. DNS ",FLDR,"PU T") | |
74 | } | |
75 | ELSE { S SQ=Q D INIT(0) S Q=SQ D DET AIL W !!," End of Rep ort" } | |
76 | S OQS= $P(^CHMVCC (Q,0),U,10 ),CF=$P(^( 0),U,6) | |
77 | IF CF= "" { S $P( ^CHMVCC(Q, 0),U,10)=4 ;Mark Q " Printed" | |
78 | D N OW^%DTC D CHGSTA^CHM VCC07(Q,OQ S,4) } ;U pdate stat us index | |
79 | ELSE { S $P(^CHM VCC(Q,0),U ,10)=6 ;Mark Q " Cleaned" | |
80 | D N OW^%DTC D CHGSTA^CHM VCC07(Q,OQ S,6) } ;U pdate stat us index | |
81 | S $P(^ CHMVCC(Q,0 ),U,4,5)=% _U_XDUZ ;Da te.Time^us er stamp | |
82 | IF QT= 6,ET'=11 { S $P(^CHM VCC($$OPEN F(11),0),U ,10)=4 | |
83 | S $P(^(0) ,U,4,5)=%_ U_XDUZ } | |
84 | Q ; ---------- ---------- ---------- ---------- ---------- ---------- ; | |
85 | DETAIL ;Pa ss through queue, ge t item, se nd for pri nting | |
86 | S I =0 | |
87 | IF QT=5 { S R 2N="" ;Exc eptions ar e differen t | |
88 | WHILE $O(^ CHMVCC(Q,1 00,"B",R2N ))'="" { | |
89 | S R2N=$ O(^(R2N)) S J=0 | |
90 | WHILE $ O(^CHMVCC( Q,100,"B", R2N,J))>0 { | |
91 | S:$I (I) J=$O(^ CHMVCC(Q,1 00,"B",R2N ,J)) | |
92 | S V= $P(^CHMVCC (Q,100,J,0 ),U,2) D L INE }}} | |
93 | ELS E { WHILE I<QE { | |
94 | S V =^CHMVCC(Q ,100,$I(I) ,0),V=$P(V ,U,2) D LI NE }} | |
95 | Q ; ---------- ---------- ---------- ---------- ---------- ---------- ; | |
96 | LINE ;Ge t data to go out | |
97 | D:T YPE="P"&($ Y>57) HEAD ER(0) | |
98 | S V N=$P(^CHMV EN(V,0),U) ,TIN=$P(^( 0),U,3) | |
99 | S T IN2=$P(^CH MVEN(V,0), U,23),TIN3 =$P($G(^CH MVEN(V,14) ),U) | |
100 | IF QT=4 { N M BD,MSA S M SA=$$DAUTH | |
101 | IF $E(MSA)?1N { S MBD=$ $TRIM^XLFS TR(MSA,"R" ),MSA="" } | |
102 | ELS E { S MBD= "",MSA=$$T RIM^XLFSTR (MSA,"L") } | |
103 | D O UTPUT(I_TA B_VN_TAB_M BD_TAB_MSA _TAB_TIN_" "_TIN2_" "_TIN3,TYP E,V) } | |
104 | ELS E { D OUTP UT(I_TAB_V N_TAB_TIN_ " "_TIN2_" "_TIN3,TY PE,V) } | |
105 | Q | |
106 | OUTPUT(X,T ,V) ;Put a row out t o printer or file: | |
107 | IF T=" E" { U XFI LE W X_TAB _V,! } | |
108 | ELSE { | |
109 | IF QT'=4 { W !,$J($P(X, U),5),?10, $E($P(X,U, 2),1,30) | |
110 | W ?45,$P(X,U ,3),?70,$J (V,8) } | |
111 | ELS E { W !,$J($P(X, U),5),?8,$ E($P(X,U,2 ),1,21) | |
112 | W ?31,$$DAUT H | |
113 | W ?53,$P(X,U ,3),?70,$J (V,8) } | |
114 | } | |
115 | Q ;--- ---------- ---------- ---------- ---------- ---------- ; | |
116 | DAUTH() ;G et Begin D ate or San ctioning A uthority: | |
117 | N J,D,A,X | |
118 | Q: '$D(^CHMVE N(V,30)) " " ;No san ctions nod e | |
119 | Q: '$D(^(30,0 ),J) "" S J=$P(J,U,3 ) ;Get en try pointe r | |
120 | Q: J="" "" ;Entry p ointer nul l | |
121 | Q: '$D(^CHMVE N(V,30,J,0 ),X) "" ;No entr y | |
122 | S D=$P(X,U), A=$P(X,U,2 ) ;Dat e^authorit y | |
123 | Q: D="" $J($E (A,1,20),2 0) | |
124 | Q $E(D,4,5)_ "/"_$E(D,6 ,7)_"/"_$E (D,2,3) | |
125 | HEADER(EF) ;Print or export he ader (EF=E xport Flag ): | |
126 | N ETN | |
127 | IF EF { | |
128 | IF QT= 6 { S:ET<7 ETN=$P($P ($T(X1),"; ",2),",",E T) | |
129 | S:ET'< 7 ETN=$P($ P($T(X2)," ;",2),",", ET-6) } | |
130 | U XFIL E W $S(QT= 6:ETN,1:"" )_TAB_QTN, !,HDR,! } | |
131 | ELSE { W @IOF,DUZ, ?TT,TITLE, ?70,"Page: ",$J(PG,3 ) | |
132 | W !,DATE,?S T,SUB,!,TI ME,?PT,PAR AM,! | |
133 | I F QT'=4 { | |
134 | W !,"Num ber",?10," Vendor Nam e",?45,"Ta x ID #" | |
135 | W ?73,"E IN" | |
136 | W !,"--- ---",?10," ---------- ---------- ---------- " | |
137 | W ?45,"- --------" S PG=PG+1 | |
138 | W ?70,"- --------" } | |
139 | E LSE { | |
140 | W !,"Num ber",?8,"V endor Name ",?31,"Beg Date | Au thority" | |
141 | W ?53,"T ax ID #",? 73,"EIN" | |
142 | W !,"--- ---",?8,"- ---------- ---------- " | |
143 | W ?31,"- ---------- ---------" | |
144 | W ?53,"- --------" S PG=PG+1 | |
145 | W ?70,"- --------" } | |
146 | } | |
147 | Q ;------ ---------- ---------- ---------- ---------- ---------- ; | |
148 | INIT(EF) ; Set up pri nt or expo rt header (EF=Export Flag): | |
149 | I F EF { S H DR="NUMBER "_TAB_"VEN DOR NAME"_ TAB | |
150 | IF QT=4 { S H DR=HDR_"BE G DATE"_TA B_"AUTHORI TY"_TAB } | |
151 | S H DR=HDR_"TA XID"_TAB_" EIN" } | |
152 | E LSE { S D ATE=$$FIX( $$FMTE^DIL IBF(TODAY, 6)) | |
153 | S T IME=$$HTIM ^ACKQUTL($ H,0) | |
154 | S T ITLE="HEAL TH ADMINIS TRATION CE NTER" | |
155 | S T T=40-($L(T ITLE)\2) | |
156 | S S UB="VENDOR CLEAN-UP REPORT",ST =40-($L(SU B)\2) | |
157 | S P ARAM=QTN_" Queue " | |
158 | IF QT=6 { | |
159 | I ET<7 S X=$P($P ($T(X1),"; ",2),",",E T) | |
160 | E S X =$P($P($T( X2),";",2) ,",",ET-6) | |
161 | S PARA M=PARAM_"( "_X_" Vend ors)" } | |
162 | ELS EIF QT=4 { | |
163 | S PARAM=PA RAM_"(Begi n Date or Authority Missing)" } | |
164 | S P T=40-($L(P ARAM)\2),P G=1 } | |
165 | Q ;-------- ---------- ---------- ---------- ---------- ---------- ; | |
166 | FIX(D) ;(D ate); ; | |
167 | Q $ TR(D,"-"," /") ;< Replace "- " with "/" ; | |
168 | ;Re turn date with slash es ------- ---------- ---------- ---------- ; | |
169 | PARAM() ;T YPE=P!E;DE L=delimite r ; | |
170 | S (TYPE,DEL, IOFILE,CHU CI)="" D N OW^%DTC S TODAY=X | |
171 | I QT=6 S ESQ =$$XEMPT() Q:ESQ=U U ;Exempt queue? ge t sub queu e | |
172 | S TYPE=$$Por E() Q:TYPE =U U ;Print or export ? | |
173 | X ^%ZOSF("UC I") S CHUC I=$P(Y,"," ) | |
174 | IF TYPE="P" { | |
175 | W !!,"Repo rt does NO T require a ""WIDE"" printer." ,!! | |
176 | S IOP=" Q" D ^%ZIS Q:POP U ;If printing, get devic e | |
177 | W !,"Pr inting ",Q TN," Queue to: ",IO, ION,".",! } | |
178 | EL SE { | |
179 | S DEL=$$DC har() Q:DE L="@" U S: DEL="<Tab> " DEL=$C(9 ) | |
180 | S IOFILE=" VCC_Q"_QT_ "_"_DUZ_"_ "_TODAY_"_ "_($P($H," ,",2)\60) | |
181 | S:CHUCI'=" HAC" IOFIL E=IOFILE_" _TST" S IO FILE=IOFIL E_".TXT" | |
182 | W !!,?1 0-$L(QTN), "Exporting ",QTN," d etail to:" | |
183 | W !!,?2 0,"Data sh are: Fs3bi g" | |
184 | W !,?24 ,"Folder: Vendor_Cle anup_Contr ol" | |
185 | W !,?26 ,"File: ", IOFILE,! } | |
186 | Q 1 ;Return true param eters read ; -------- ---------- ---------- ; | |
187 | PorE() ;So licit outp ut destina tion (prin t or expor t): ; | |
188 | K D IR S DIR(0 )="SAB^P:P rint to se lected dev ice;" | |
189 | S D IR(0)=DIR( 0)_"E:Expo rt to deli mited text file" | |
190 | S D IR("A")="( P)rint or (E)xport t he output: ",DIR("B" )="P" | |
191 | S D IR("PRE")= "I X="""" S X=""P"" W X" | |
192 | S D IR("?")="" "P"" uses any printe r, ""E"" c reates a . DAT file." | |
193 | D ^ DIR K DIR Q:"^^@"[X "^" | |
194 | Q Y ;Return E or P; --- ---------- ---------- ---------- ---------- ; | |
195 | DChar() ;S olicit fie ld delimit er: ; | |
196 | K DIR S DIR( 0)="FAU^" | |
197 | S DIR("A")=" Fiel d delimite r for file : ",DIR("B ")="<Tab>" | |
198 | S DIR("PRE") ="I X="""" S X=""<Ta b>"" W X" | |
199 | S DIR("?")=" Enter a ch aracter to be placed between " | |
200 | S DIR("?")=D IR("?")_"f ields in t he output data file. " | |
201 | D ^DIR K DIR Q:"@"[X " @" | |
202 | Q Y ;Return field deli miter; --- ---------- ---------- ---------; | |
203 | XEMPT() ;S olicit exe mpt queue sub queue: | |
204 | X1 ;C ITI,CMOP,M edicaid,SB -Rx,SB-Tra vel,SB-Hos pital; | |
205 | X2 ;M edical Mat rix,Chirop ractic,San ctioned,On Watch,For eign,Careg iver; ;; DEV021753 - JEH - 10 /8/2014 | |
206 | W !,"Vendor Exemptions ",?25,"(# entries)", ! | |
207 | F I=1:1:6 D | |
208 | .W !,@CHBON, $J(I,2),@C HBOFF," " ,$P($P($T( X1),";",2) ,",",I) | |
209 | .W ?25,"(",$ J($P(^CHMV CC($$OPENF (I),100,0) ,U,4),6)," )" | |
210 | .W :I<7 ?40,@ CHBON,$J(I +6,2),@CHB OFF ;;DE V021753 - JEH - 10/8 /2014 | |
211 | .W " ",$P($ P($T(X2)," ;",2),",", I) | |
212 | .W :I<7 ?65," (",$J($P(^ CHMVCC($$O PENF(I+6), 100,0),U,4 ),6),")" ;;DEV02175 3 - JEH - 10/8/2014 | |
213 | X3 W !!,"Select Exemption to print: " D CSBRS ^CHSC2 | |
214 | I $D(DQOUT) W " ?? En ter exempt ion number ." H 2 G X 2 | |
215 | Q: $D(DFOUT)! $D(DUOUT) U | |
216 | I Y'?.N W " ?? Enter the number of an exe mption." G X3 | |
217 | I Y<1!(Y>12) W " ?? E nter a num ber betwee n 1 and 12 ." G X3 ;DEV021753 - JEH - 1 0/8/2014 | |
218 | IF $P(^CHMVC C($$OPENF( Y),100,0), U,4)'>0 { | |
219 | W " ?? Q ueue has n o entries. " G X3 } | |
220 | Q $$OPENF(Y) _U_Y | |
221 | OPENF(T) ; (Type of e xemption); Get curren t open que ue: | |
222 | Q $O(^CHMVC C("F",T,99 99999),-1) |
Araxis Merge (but not the data content of this report) is Copyright © 1993-2016 Araxis Ltd (www.araxis.com). All rights reserved.