close Warning: Can't use blame annotator: 
svn blame failed on WorldVistAEHR/trunk/r/PHARMACY_BENEFITS_MANAGEMENT-PSU/PSUDEM2.m: 'GenericSWIGWrapper' object has no attribute '_wrap'

source: WorldVistAEHR/trunk/r/PHARMACY_BENEFITS_MANAGEMENT-PSU/PSUDEM2.m@ 691

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

initial load of WorldVistAEHR
File size: 4.3 KB
RevLine 
1PSUDEM2 ;BIR/DAM - Outpatient Visits Extract ;20 DEC 2001
2 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
3 ;
4 ;DBIA's
5 ; Reference to file 2 supported by DBIA 10035
6 ; Reference to file 9000010.07 supported by DBIA 3094
7 ; Reference to file 9000010 supported by DBIA 3512
8 ; Reference to file 4.3 supported by DBIA 2496
9 ; Reference to file 80 supported by DBIA 10082
10 ; Reference to file 9000010.18 supported by DBIA 3560
11 ; Reference to file 81 supported by DBIA 2815
12EN ;EN Called from PSUCP
13 K ^XTMP("PSU_"_PSUJOB,"PSUOPV"),^XTMP("PSU_"_PSUJOB,"PSUTMP")
14 K NONE
15 NEW CPTDA,CPTNM,ICD9DA,ICD9NM,PSUICN,PSUSSN,PSUSUB,PSUTEDT
16 NEW PSUVSTDT,PSUX,PSUY,PTSTAT,SEG,VCPTDA,XX,J
17 D DAT1
18 I '$D(^XTMP("PSU_"_PSUJOB,"PSUTMP")) D NODATA
19 D XMD
20EX K ^XTMP("PSU_"_PSUJOB,"PSUPDFLAG")
21 K ^XTMP("PSU_"_PSUJOB,"PSUOPV")
22 K ^XTMP("PSU_"_PSUJOB,"PSUXMD")
23 K ^XTMP("PSU_"_PSUJOB,"PSUTMP")
24 Q
25 ;
26 ;
27DAT1 ;Find visits from V POV file that fall within the date range
28 S PSUTEDT=PSUEDT
29 S PSUDT=PSUSDT-1,PSUX=9999999-PSUDT,PSUY=9999999-PSUEDT N PSUEDT
30 S PSUY=PSUSDT-.0001
31 F S PSUY=$O(^AUPNVSIT("B",PSUY)) Q:PSUY'>0 Q:((PSUY\1)>PSUTEDT) D
32 . S PSUVIEN=0 F S PSUVIEN=$O(^AUPNVSIT("B",PSUY,PSUVIEN)) Q:$G(PSUVIEN)'>0 D
33 .. S PSUPT=$$VALI^PSUTL(9000010,PSUVIEN,.05)
34 .. D DAT2
35 Q
36DAT2 ;
37 S PSUPOV=0 F S PSUPOV=$O(^AUPNVPOV("AD",PSUVIEN,PSUPOV)) Q:PSUPOV'>0 D
38 .N PSUVIEN
39 .S PSUVIEN=$P($G(^AUPNVPOV(PSUPOV,0)),U,3)
40 .Q:PSUVIEN=""
41 .Q:$D(^XTMP("PSU"_PSUJOB,"PSUOPV",PSUVIEN)) ; quit if visit psuvien already stored
42 . D POVS
43 .S PSUVSTDT=$P($G(^AUPNVSIT(PSUVIEN,0)),U)\1
44 .S PSUSSN=$P(^DPT(PSUPT,0),U,9)
45 .S PSUICN=$$GETICN^MPIF001(PSUPT)
46 .I PSUICN[-1 S PSUICN=""
47 .S PTSTAT=$P(^AUPNVSIT(PSUVIEN,150),U,2),PTSTAT=$S(+PTSTAT:"I",1:"O")
48 . D SET
49 Q
50POVS ;severl POVs can have same visit, work all when the first is found
51 N PSUPOV
52 S PSUPOV=0 F S PSUPOV=$O(^AUPNVPOV("AD",PSUVIEN,PSUPOV)) Q:PSUPOV'>0 D
53 . K ALLICD9,ALLCPT
54 .;LOOP CPTs linked by visit
55 . S VCPTDA=0 F S VCPTDA=$O(^AUPNVCPT("AD",PSUVIEN,VCPTDA)) Q:VCPTDA'>0 D
56 .. ; get/gather cpts
57 ..S CPTDA=$P($G(^AUPNVCPT(VCPTDA,0)),U),CPTNM=$P($G(^ICPT(CPTDA,0)),U) S:$L(CPTNM) ALLCPT(CPTNM)=""
58 .. ;get/gather icd9s
59 ..S ICD9DA=$P($G(^AUPNVCPT(VCPTDA,0)),U,5) I ICD9DA S ICD9NM=$P($G(^ICD9(ICD9DA,0)),U) S:$L(ICD9NM) ALLICD9(ICD9NM)=""
60 . ;get orig ICD9
61 .S ICD9DA=$P($G(^AUPNVPOV(PSUPOV,0)),U) I ICD9DA S ICD9NM=$P($G(^ICD9(ICD9DA,0)),U) S:$L(ICD9NM) ALLICD9(ICD9NM)=""
62 Q
63SET ; Set segment
64 I '$D(ALLICD9),'$D(ALLCPT) Q ;insure visit has either CPT or ICD9
65 ;assemble elements and set
66 S SEG=U_PSUSNDR_U_PTSTAT_U_PSUVSTDT_U_PSUSSN_U_PSUICN_U
67 I $D(ALLICD9) S ICD9NM="" F I=7:1:16 S ICD9NM=$O(ALLICD9(ICD9NM)) Q:ICD9NM="" S $P(SEG,U,I)=ICD9NM
68 I $D(ALLCPT) S CPTNM="" F J=17:1:26 S CPTNM=$O(ALLCPT(CPTNM)) Q:CPTNM="" S $P(SEG,U,J)=CPTNM
69 S $P(SEG,U,27)=""
70 S ^XTMP("PSU_"_PSUJOB,"PSUTMP",PSUVIEN)=SEG
71 Q
72 ;
73XMD ;Format mailman message and send.
74 S PSUAB=0
75 F PSUPL=1:1 S PSUAB=$O(^XTMP("PSU_"_PSUJOB,"PSUTMP",PSUAB)) Q:PSUAB'>0 S XX=^(PSUAB) D
76 . S ^XTMP("PSU_"_PSUJOB,"PSUOPV",PSUPL)=XX
77 NEW PSUMAX,PSULC,PSUTMC,PSUTLC,PSUMC
78 S PSUMAX=$$VAL^PSUTL(4.3,1,8.3)
79 S PSUMAX=$S(PSUMAX="":10000,PSUMAX>10000:10000,1:PSUMAX)
80 S PSUMC=1,PSUMLC=0
81 F PSULC=1:1 S X=$G(^XTMP("PSU_"_PSUJOB,"PSUOPV",PSULC)) Q:X="" D
82 .S PSUMLC=PSUMLC+1
83 .I PSUMLC>PSUMAX S PSUMC=PSUMC+1,PSUMLC=0,PSULC=PSULC-1 Q ; + message
84 .I $L(X)<235 S ^XTMP("PSU_"_PSUJOB,"PSUXMD",PSUMC,PSUMLC)=X Q
85 .F I=235:-1:1 S Z=$E(X,I) Q:Z="^"
86 .S ^XTMP("PSU_"_PSUJOB,"PSUXMD",PSUMC,PSUMLC)=$E(X,1,I)
87 .S PSUMLC=PSUMLC+1
88 .S ^XTMP("PSU_"_PSUJOB,"PSUXMD",PSUMC,PSUMLC)="*"_$E(X,I+1,999)
89 ;
90TLC ; Count Lines sent
91 S PSUTLC=0
92 F PSUM=1:1:PSUMC S X=$O(^XTMP("PSU_"_PSUJOB,"PSUXMD",PSUM,""),-1),PSUTLC=PSUTLC+X
93 ;
94 F PSUM=1:1:PSUMC D OPV^PSUDEM5
95 D CONF
96 Q
97CONF ;Construct globals for confirmation message
98 ;
99 I $G(NONE) S PSUTLC=0
100 N PSUDIVIS
101 S PSUDIVIS=$P(^XTMP("PSU_"_PSUJOB,"PSUSITE"),U,1)
102 S PSUSUB="PSU_"_PSUJOB
103 S ^XTMP(PSUSUB,"CONFIRM",PSUDIVIS,8,"M")=PSUMC
104 S ^XTMP(PSUSUB,"CONFIRM",PSUDIVIS,8,"L")=PSUTLC
105 Q
106 ;
107NODATA ;Generate a 'No data' message if there is no data in the extract
108 ;
109 S NONE=1
110 M PSUXMYH=PSUXMYS1
111 S PSUM=1
112 S ^XTMP("PSU_"_PSUJOB,"PSUXMD",PSUM,1)="No data to report"
113 Q
114REC ;EN If "^" is contained in any record, replace it with "'"
115 ;
116 I PSUREC["^" S PSUREC=$TR(PSUREC,"^","'")
117 Q
Note: See TracBrowser for help on using the repository browser.