Produced by Araxis Merge on 11/9/2018 12:34:15 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 | CHOCRPOP.m | Mon Nov 5 16:45:17 2018 UTC |
2 | CPEE_Build9_Sprint27.zip\HAC_CPE_CH | CHOCRPOP.m | Mon Nov 5 17:54:32 2018 UTC |
Description | Between Files 1 and 2 |
|
---|---|---|
Text Blocks | Lines | |
Unchanged | 2 | 374 |
Changed | 1 | 2 |
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 | CHOCRPOP ; JPN ROUTIN E USED TO CREATE REC ORDS IN TE ST FOR OCR TESTING ; 11/12/08 2 :51 PM | |
2 | ; V1.0 | |
3 | ; | |
4 | START; | |
5 | K ^CHMZHO LD("OCR") | |
6 | S (PDI,JD ATE)="",NU M=200 | |
7 | D INIT | |
8 | R !,"WHAT IS THE JU LIAN DATE FOR THE PD I'S? ",JD ATE | |
9 | S PDI=200 8_JDATE_94 000001 | |
10 | F S PDI= $O(^CHMIMA GE(PDI)) Q :PDI="" D | |
11 | . Q:'$D(^ CHMIMAGE(P DI)) | |
12 | . I $E(PD I,8,9)'=94 Q | |
13 | . Q:$E(PD I,5,7)'=JD ATE | |
14 | . Q:$E(PD I,1,4)'=20 08 | |
15 | . S NUM=N UM+1 | |
16 | . Q:'$D(^ CHMIMAGE(P DI,1,1,2,1 ,0)) | |
17 | . S TYPE= $P(^CHMIMA GE(PDI,1,1 ,2,1,0),"^ ",5) | |
18 | . I TYPE= 1 D INPAT | |
19 | . I TYPE= 2 D OUTPAT | |
20 | . ;Q:(TYP E'=1)!(TYP E'=2) | |
21 | . ;I (TYP E'=1)!(TYP E'=2) Q | |
22 | . D PIECE | |
23 | . D INIT | |
24 | D OUTPUT | |
25 | Q | |
26 | INIT ;INIT IALIZES VA RIABLES | |
27 | S (DATE,T YPE,VEN,PV EN)="",(RC NT,PCNT,IC NT,UCNT,TC NT,DCNT)=0 ,UNIT="",T OTCHG="" | |
28 | S (UB3A,U B4,UB5,UB6 F,UB6T,UB1 0,UB17,DOB ,SSN)="" | |
29 | S (DFN,BF N,PATCTR,T OB,VSSN,UB 45(1),UB45 (1),DOB,ST AT)="" | |
30 | S (UB42(1 ),UB42(2), UB42(3),UB 42(4),UB42 (5),UB42(6 ),UB42(7), UB42(8),UB 42(9),UB42 (10),UB42( 11),UB42(1 2),UB42(13 ),UB42(14) ,UB42(15), UB42(16),U B42(17),UB 42(18),UB4 2(19),UB42 (20),UB42( 21),UB42(2 2),UB42(23 ))="" | |
31 | S (UB44(1 ),UB44(2), UB44(3),UB 44(4),UB44 (5),UB44(6 ),UB44(7), UB44(8),UB 44(9),UB44 (10),UB44( 11),UB44(1 2),UB44(13 ),UB44(14) ,UB44(15), UB44(16),U B44(17),UB 44(18),UB4 4(19),UB44 (20),UB44( 21),UB44(2 2),UB44(23 ))="" | |
32 | S (UB45(1 ),UB45(2), UB45(3),UB 45(4),UB45 (5),UB45(6 ),UB45(7), UB45(8),UB 45(9),UB45 (10),UB45( 11),UB45(1 2),UB45(13 ),UB45(14) ,UB45(15), UB45(16),U B45(17),UB 45(18),UB4 5(19),UB45 (20),UB45( 21),UB45(2 2),UB45(23 ))="" | |
33 | S (UB46(2 ),UB46(3), UB46(4),UB 46(5),UB46 (6),UB46(7 ),UB46(8), UB46(9),UB 46(10),UB4 6(11),UB46 (12),UB46( 13),UB46(1 4),UB46(15 ),UB46(16) ,UB46(17), UB46(18),U B46(19),UB 46(20),UB4 6(21),UB46 (22),UB46( 23))="" | |
34 | S (UB47(1 ),UB47(2), UB47(3),UB 47(4),UB47 (5),UB47(6 ),UB47(7), UB47(8),UB 47(9),UB47 (10),UB47( 11),UB47(1 2),UB47(13 ),UB47(14) ,UB47(15), UB47(16),U B47(17),UB 47(18),UB4 7(19),UB47 (20),UB47( 21),UB47(2 2),UB47(23 ))="" | |
35 | S (UB601, UB602,UB60 3)="" | |
36 | S (UB66(2 ),UB66(3), UB66(4),UB 66(5),UB66 (6),UB66(7 ),UB66(8), UB66(9),UB 66(10),UB6 6(11),UB66 (12),UB66( 13),UB66(1 4),UB66(15 ),UB66(16) ,UB66(17), UB66(18))= "" | |
37 | S (UB74(1 ),UB74(2), UB74(3),UB 74(4),UB74 (5),UB74(6 ))="" | |
38 | S UB47(23 )=0 | |
39 | Q | |
40 | OUTPAT ;GA TERS OUTPA TIENT INFO RMATION | |
41 | S STAT="0 1" | |
42 | S VEN=$G( ^CHMIMAGE( PDI,1,1,2, 1,"VEN")) | |
43 | S PATCTR= $P(VEN,"^" ,17),TOB=$ P(VEN,"^", 7) | |
44 | S PVEN=$G (^CHMIMAGE (PDI,"P-VE N",1,0)) | |
45 | S VSSN=$P (PVEN,"^", 5) | |
46 | S DFN=$P( ^CHMIMAGE( PDI,1,1,2, 1,10),"^", 1),BFN=$P( ^CHMIMAGE( PDI,1,1,2, 1,10),"^", 2) | |
47 | S AHCHVA= $G(^AHCHVA (DFN,0)) | |
48 | I $D(AHCH VA) D | |
49 | . S DOB=$ P(AHCHVA," ^",3),SSN= $P(AHCHVA, "^",9) | |
50 | S CNTR=0 | |
51 | F S CNTR =$O(^CHMIM AGE(PDI,1, 1,2,1,"OPT -NS",CNTR) ) Q:CNTR=" " D | |
52 | . S OPT=$ G(^CHMIMAG E(PDI,1,1, 2,1,"OPT-N S",CNTR,0) ) | |
53 | . S UB42( CNTR)=$P(O PT,"^",14) | |
54 | . D REVC | |
55 | . S UB44( CNTR)=$P(O PT,"^",7) | |
56 | . D PXCOD E | |
57 | . S UB45( CNTR)=$P(O PT,"^",1) | |
58 | . I CNTR= 1 S UB45(2 3)=$P(^CHM IMAGE(PDI, 0),"^",4), UB45(23)=2 0_$E(UB45( 23),2,7) | |
59 | . D DATE | |
60 | . S UB46( CNTR)=$P(O PT,"^",17) | |
61 | . D UNIT | |
62 | . S UB47( CNTR)=$P(O PT,"^",8) | |
63 | . D TOTCH G | |
64 | . S UB66( CNTR)=$P(O PT,"^",10) | |
65 | . D ICD9 | |
66 | Q | |
67 | INPAT ;GAT HERS ALL I NPATIENT I NFORMATION | |
68 | S VEN=$G( ^CHMIMAGE( PDI,1,1,2, 1,"VEN")) | |
69 | S PATCTR= $P(VEN,"^" ,17),TOB=$ P(VEN,"^", 7) | |
70 | S PVEN=$G (^CHMIMAGE (PDI,"P-VE N",1,0)) | |
71 | S VSSN=$P (PVEN,"^", 5) | |
72 | S DFN=$P( ^CHMIMAGE( PDI,1,1,2, 1,10),"^", 1),BFN=$P( ^CHMIMAGE( PDI,1,1,2, 1,10),"^", 2) | |
73 | S AHCHVA= $G(^AHCHVA (DFN,0)) | |
74 | I $D(AHCH VA) S AHCH VA=$G(^AHC HVA(DFN,10 0,BFN,0)) D | |
75 | . S DOB=$ P(AHCHVA," ^",3),SSN= $P(AHCHVA, "^",9) | |
76 | . I $E(DO B,1)=2 S D OB=19_$E(D OB,2,7) | |
77 | . I $E(DO B,1)=3 S D OB=20_$E(D OB,2,7) | |
78 | S NODE0=$ G(^CHMIMAG E(PDI,1,1, 2,1,"INP-N S",1,0)) | |
79 | S UB6F=$P (NODE0,"^" ,4),UB6F=2 0_$E(UB6F, 2,7),UB6T= $P(NODE0," ^",5),UB6T =20_$E(UB6 T,2,7) | |
80 | S STAT=$P (NODE0,"^" ,6),STAT=$ P(^CHMDIC( 741002.12, STAT,0),"^ ",1) | |
81 | S CNTR=0, CNTR2=0 | |
82 | F S CNTR 2=$O(^CHMI MAGE(PDI,1 ,1,2,1,"IN P-NS",1,CN TR2)) Q:CN TR2="" D | |
83 | . F S C NTR=$O(^CH MIMAGE(PDI ,1,1,2,1," INP-NS",1, CNTR2,CNTR )) Q:CNTR= "" D | |
84 | .. S LINE =$G(^CHMIM AGE(PDI,1, 1,2,1,"INP -NS",1,CNT R2,CNTR,0) ) | |
85 | .. I CNTR 2=100 S UB 66(CNTR)=$ P(LINE,"^" ,1) D | |
86 | ... D ICD 9 | |
87 | .. I CNTR 2=101 S UB 44(CNTR)=$ P(LINE,"^" ,1) D | |
88 | ... Q:UB4 4(CNTR)="" | |
89 | ... S PXC ODE="",PXC ODE=$P(^CH MSERV(UB44 (CNTR),0), "^",1),UB4 4(CNTR)=PX CODE | |
90 | .. I CNTR 2=102 S NO DE102=$G(^ CHMIMAGE(P DI,1,1,2,1 ,"INP-NS", 1,CNTR2,CN TR,0)) D | |
91 | ... S UB4 2(CNTR)=$P (NODE102," ^",1) | |
92 | ... D REV C | |
93 | ... S UB4 7(RCNT)=$P (NODE102," ^",2) | |
94 | ... S UB4 6(RCNT)=$P (NODE102," ^",4) | |
95 | Q | |
96 | PIECE ; PI ECE STRING TOGETHER | |
97 | Q:TYPE=3 | |
98 | Q:TYPE=4 | |
99 | Q:TYPE=5 | |
100 | Q:TYPE=6 | |
101 | I TYPE=1 S ^CHMZHOL D("OCR",PD I)=NUM_"^" _PDI_"^"_D FN_"^"_BFN _"^"_PATCT R_"^"_TOB_ "^"_VSSN_" ^"_UB6F_"^ "_UB6T_"^" _DOB_"^"_S TAT ;p ieces 1=11 | |
102 | I TYPE=2 S ^CHMZHOL D("OCR",PD I)=NUM_"^" _PDI_"^"_D FN_"^"_BFN _"^"_PATCT R_"^"_TOB_ "^"_VSSN_" ^"_UB45(1) _"^"_UB45( 1)_"^"_DOB _"^"_STAT ;pie ces 1=11 | |
103 | S ^CHMZHO LD("OCR",P DI)=^CHMZH OLD("OCR", PDI)_"^"_U B42(1)_"^" _UB42(2)_" ^"_UB42(3) _"^"_UB42( 4)_"^"_UB4 2(5)_"^"_U B42(6)_"^" _UB42(7)_" ^"_UB42(8) _"^"_UB42( 9)_"^"_UB4 2(10)_"^"_ UB42(11)_" ^"_UB42(12 )_"^"_UB42 (13)_"^"_U B42(14)_"^ "_UB42(15) _"^"_UB42( 16)_"^"_UB 42(17)_"^" _UB42(18)_ "^"_UB42(1 9)_"^"_UB4 2(20)_"^"_ UB42(21)_" ^"_UB42(22 )_"^"_UB42 (23) ;pie ces 12-34 | |
104 | S ^CHMZHO LD("OCR",P DI)=^CHMZH OLD("OCR", PDI)_"^"_U B44(1)_"^" _UB44(2)_" ^"_UB44(3) _"^"_UB44( 4)_"^"_UB4 4(5)_"^"_U B44(6)_"^" _UB44(7)_" ^"_UB44(8) _"^"_UB44( 9)_"^"_UB4 4(10)_"^"_ UB44(11)_" ^"_UB44(12 )_"^"_UB44 (13)_"^"_U B44(14)_"^ "_UB44(15) _"^"_UB44( 16)_"^"_UB 44(17)_"^" _UB44(18)_ "^"_UB44(1 9)_"^"_UB4 4(20)_"^"_ UB44(21)_" ^"_UB44(22 )_"^"_UB44 (23) ;pie ces 35-57 | |
105 | S ^CHMZHO LD("OCR",P DI)=^CHMZH OLD("OCR", PDI)_"^"_U B45(1)_"^" _UB45(2)_" ^"_UB45(3) _"^"_UB45( 4)_"^"_UB4 5(5)_"^"_U B45(6)_"^" _UB45(7)_" ^"_UB45(8) _"^"_UB45( 9)_"^"_UB4 5(10)_"^"_ UB45(11)_" ^"_UB45(12 )_"^"_UB45 (13)_"^"_U B45(14)_"^ "_UB45(15) _"^"_UB45( 16)_"^"_UB 45(17)_"^" _UB45(18)_ "^"_UB45(1 9)_"^"_UB4 5(20)_"^"_ UB45(21)_" ^"_UB45(22 )_"^"_UB45 (23) ;pie ces 58-80 | |
106 | S ^CHMZHO LD("OCR",P DI)=^CHMZH OLD("OCR", PDI)_"^"_U B46(1)_"^" _UB46(2)_" ^"_UB46(3) _"^"_UB46( 4)_"^"_UB4 6(5)_"^"_U B46(6)_"^" _UB46(7)_" ^"_UB46(8) _"^"_UB46( 9)_"^"_UB4 6(10)_"^"_ UB46(11)_" ^"_UB46(12 )_"^"_UB46 (13)_"^"_U B46(14)_"^ "_UB46(15) _"^"_UB46( 16)_"^"_UB 46(17)_"^" _UB46(18)_ "^"_UB46(1 9)_"^"_UB4 6(20)_"^"_ UB46(21)_" ^"_UB46(22 )_"^"_UB46 (23) ;pie ces 81-103 | |
107 | S ^CHMZHO LD("OCR",P DI)=^CHMZH OLD("OCR", PDI)_"^"_U B47(1)_"^" _UB47(2)_" ^"_UB47(3) _"^"_UB47( 4)_"^"_UB4 7(5)_"^"_U B47(6)_"^" _UB47(7)_" ^"_UB47(8) _"^"_UB47( 9)_"^"_UB4 7(10)_"^"_ UB47(11)_" ^"_UB47(12 )_"^"_UB47 (13)_"^"_U B47(14)_"^ "_UB47(15) _"^"_UB47( 16)_"^"_UB 47(17)_"^" _UB47(18)_ "^"_UB47(1 9)_"^"_UB4 7(20)_"^"_ UB47(21)_" ^"_UB47(22 )_"^"_UB47 (23) ;pie ces 103-12 6 | |
108 | S ^CHMZHO LD("OCR",P DI)=^CHMZH OLD("OCR", PDI)_"^"_U B601_"^"_U B602_"^"_U B603_"^"_" " ;pieces 127-130 | |
109 | S ^CHMZHO LD("OCR",P DI)=^CHMZH OLD("OCR", PDI)_"^"_U B66(1)_"^" _UB66(2)_" ^"_UB66(3) _"^"_UB66( 4)_"^"_UB6 6(5)_"^"_U B66(6)_"^" _UB66(7)_" ^"_UB66(8) _"^"_UB66( 9)_"^"_UB6 6(10)_"^"_ UB66(11)_" ^"_UB66(12 )_"^"_UB66 (13)_"^"_U B66(14)_"^ "_UB66(15) _"^"_UB66( 16)_"^"_UB 66(17)_"^" _UB66(18) ;pieces 131-148 | |
110 | S ^CHMZHO LD("OCR",P DI)=^CHMZH OLD("OCR", PDI)_"^"_U B74(1)_"^" _UB74(2)_" ^"_UB74(3) _"^"_UB74( 4)_"^"_UB7 4(5)_"^"_U B74(6) ;pieces 14 9-154 | |
111 | Q | |
112 | OUTPUT ;WR ITES FILE OUT TO FS3 BIG | |
113 | S DEVICE ="HACFS3"" DNS decnet HAC dec741!"": :D:[FS3BIG ]OCRPOPULA TE.TXT" | |
114 | O DEVICE C DEVICE:" D" | |
115 | O DEVICE: "NWV" ;sta rt at fron t of file | |
116 | S PDI=0,N AME="S FIL E=",X="""" | |
117 | F S PDI= $O(^CHMZHO LD("OCR",P DI)) Q:PDI ="" D | |
118 | . S FILE= $G(^CHMZHO LD("OCR",P DI)) | |
119 | . U DEVIC E W !,FILE | |
120 | C DEVICE | |
121 | Q | |
122 | REVC ;GETS REVENUE C ENTER CODE S | |
123 | S REVC="" | |
124 | Q:UB42(CN TR)="" | |
125 | Q:'$D(^CH MXDIC(7412 01.39,UB42 (CNTR))) | |
126 | S REVC=$P (^CHMXDIC( 741201.39, UB42(CNTR) ,0),"^",1) | |
127 | D UB42 | |
128 | I RCNT'=0 S UB42(RC NT)=REVC,R CNT=RCNT+1 ,UB42(CNTR )="" | |
129 | I RCNT=0 S UB42(CNT R)=REVC | |
130 | Q | |
131 | UB42 ; SET S TO FIRST NODE | |
132 | I UB42(1) ="" S RCNT =1 | |
133 | Q | |
134 | PXCODE ;GE TS CHAMPVA SERVICES CODES | |
135 | S PXCODE= "" | |
136 | Q:UB44(CN TR)="" | |
137 | Q:'$D(^CH MSERV(UB44 (CNTR))) | |
138 | S PXCODE= $P(^CHMSER V(UB44(CNT R),0),"^", 1) | |
139 | ;D UB44 | |
140 | ;S UB44(P CNT)=PXCOD E,PCNT=PCN T+1,UB44(C NTR)="" | |
141 | S UB44(TC NT)=PXCODE ,UB44(CNTR )="" | |
142 | Q | |
143 | UB44 ;SETS TO FIRST NODE | |
144 | I UB44(1) ="" S PCNT =1 | |
145 | Q | |
146 | DATE ;GETS THE CORRE CT DATE FO RMAT | |
147 | Q:UB45(CN TR)="" | |
148 | S DATE=20 _$E(UB45(C NTR),2,7) | |
149 | S UB45(CN TR)=DATE | |
150 | I DCNT=1 S UB45(CNT R)="" | |
151 | Q | |
152 | UNIT ; | |
153 | Q:UB46(CN TR)="" | |
154 | S UNIT=UB 46(CNTR) | |
155 | D UB46 | |
156 | S UB46(UC NT)=UNIT,U CNT=UCNT+1 ,UB46(CNTR )="" | |
157 | Q | |
158 | UB46 ;SETS THE FIRST NODE | |
159 | I UB46(1) ="" S UCNT =1 | |
160 | Q | |
161 | TOTCHG ; | |
162 | Q:UB47(CN TR)="" | |
163 | S TOTCHG= UB47(CNTR) | |
164 | D UB47 | |
165 | D PXCODE | |
166 | S UB47(TC NT)=TOTCHG | |
167 | I UB47(TC NT)'="" S UB47(23)=U B47(23)+UB 47(TCNT),U B47(23)=$J USTIFY(UB4 7(23),4,2) | |
168 | S TCNT=TC NT+1,UB47( CNTR)="" | |
169 | Q | |
170 | UB47 ;GET THE FIRST NODE | |
171 | I UB47(1) ="" S TCNT =1 | |
172 | Q | |
173 | ICD9 ;GETS THE CHAMP VA ICD9 DI AGNOSIS CO DES | |
174 | S ICD9="" | |
175 | I UB66(CN TR)="" S D CNT=1 Q | |
176 | Q:UB66(CN TR)="" | |
177 | Q:'$D(^CH MICDX(UB66 (CNTR))) | |
178 | S ICD9=$P (^CHMICDX( UB66(CNTR) ,0),"^",2) | |
179 | D UB66 | |
180 | S ICD9=$T R(ICD9,"." ,"") | |
181 | I ICNT'=0 S UB66(IC NT)=ICD9,I CNT=ICNT+1 ,UB66(CNTR )="" | |
182 | I ICNT=0 S UB66(CNT R)=ICD9 | |
183 | Q | |
184 | UB66 ; SET S TO FIRST NODE | |
185 | I UB66(1) ="" S ICNT =1 | |
186 | Q | |
187 | ||
188 |
Araxis Merge (but not the data content of this report) is Copyright © 1993-2016 Araxis Ltd (www.araxis.com). All rights reserved.