source: BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXADOF2.m@ 1087

Last change on this file since 1087 was 1087, checked in by Sam Habiel, 14 years ago

BMX updated to v2.3. No actual routine changes from 2.21
File size: 2.1 KB
Line 
1BMXADOF2 ; IHS/CIHA/GIS - RPC CALL FOR EXTENDED FUNCTIONALITY OF BMXNet UTILITIES ;
2 ;;2.3;BMX;;Jan 25, 2011
3 ; THIS ROUTINE CONTAINS SPECIAL ENTRY POINTS FOR UPDATING RPMS
4 ;
5 ;
6 ;
7VVAR(DATA) ; EP-CHECK SPECIAL VARIABLES REQUIRED FOR UPDATING THE VISIT FILE
8 I '$L(DATA) S OUT="Update cancelled. Missing data string" Q 0
9 N X,I,Y,VDATE,%DT
10 K AUPNPAT,AUPNDOB,AUPNDOD,AUPNVSIT ; THE VARS ARE NOT NEW'D SINCE THEY WILL BE USED BY THE CALLING ROUTINE
11 S AUPNTALK=1,AUPNOVRR=1
12 S X=DATA S X=$TR(X,($C(30)_"+"),$C(30)) S X=$TR(X,($C(30)_"-"),$C(30)) S X=$TR(X,($C(30)_"`"),$C(30)) S DATA=X ; STRIP OFF TRANSACTION FLAGS FROM FIELD NUMBERS
13 S X=$P(DATA,"|",2),X=$P(X,$C(30)),VDATE=-1
14 I $E(X,1,7)?7N S VDATE=X
15 E S %DT="T" D ^%DT S VDATE=Y
16 I VDATE=-1 S OUT="Update cancelled. Visit timestamp misssing/invalid" Q 0
17 S Y=+$P(DATA,($C(30)_".05|"),2) I 'Y S OUT="Update cancelled. Patient data missing" Q 0 ; FAILED TO FIND THE PATIENT IEN
18 S AUPNPAT=Y
19 S AUPNDOB=$P($G(^DPT(AUPNPAT,0)),U,3) I 'AUPNDOB S OUT="Update cancelled. Missing DOB" Q 0
20 I AUPNDOB>VDATE S OUT="Update cancelled. Patient born afer visit date???" Q 0
21 S AUPNDOD=$P($G(^DPT(AUPNPAT,.35)),U)
22 I AUPNDOD,AUPNDOD<VDATE S OUT="Update cancelled. Patient died before this visit date" Q
23 Q 1
24 ;
25NARR() ;EP - GET IEN OF PROVIDER NARR & UPDATE DATA STG FOR PROBLEM FILE
26 N PCE,NARR,NIEN,IPCE,%,I,NN,DIC,X,Y,FLD,FIEN
27 S PCE=0,FIEN=+SCHEMA,NIEN=""
28 F I=3:1:$L(SCHEMA,U) D I PCE Q
29 . S %=$P(SCHEMA,U,I)
30 . S FLD=$P(%,"|",2)
31 . I 'FLD Q
32 . I $P($G(^DD(FIEN,FLD,0)),U,2)["P9999999.27" S PCE=I
33 . Q
34 I 'PCE Q ""
35 S NARR=$P(DATA,U,PCE) I NARR="" Q ""
36 S NIEN=$$XMATCH(NARR)
37 I 'NIEN D ; CREATE A NEW ENTRY IN THE PROVIDER NARRATIVE FILE
38 . S DIC=9999999.27
39 . S DIC(0)="L"
40 . S X=""""_NARR_""""
41 . D ^DIC I Y=-1 Q
42 . S NIEN=+Y
43 . Q
44 I 'NIEN Q ""
45 S $P(DATA,U,PCE)="`"_NIEN ; STUFF THE NARRATIVE LOOKUP VALUE INTO THE DATA STRING
46 Q NIEN
47 ;
48XMATCH(NARR) ; IF THERE IS AN EXACT MATCH IN THE PROVIDER NARRATIVE FILE, RETURN THE IEN
49 N IX,X,Y,%
50 S IX=$E(NARR,1,30)
51 S %=$O(^AUTNPOV("B",IX,0))
52 I '% Q ""
53 I %,'$O(^AUTNPOV("B",IX,%)) Q %
54 S Y=""
55 S %=0 F S %=$O(^AUTNPOV("B",IX,%)) Q:'% S X=$P($G(^AUTNPOV(%,0)),U) I X=NARR S Y=% Q
56 Q Y
57 ;
Note: See TracBrowser for help on using the repository browser.