| [645] | 1 | BMXADOF2 ; IHS/CIHA/GIS - RPC CALL FOR EXTENDED FUNCTIONALITY OF BMXNet UTILITIES ;
|
|---|
| 2 | ;;2.1;BMX;;Jul 26, 2009
|
|---|
| 3 | ; THIS ROUTINE CONTAINS SPECIAL ENTRY POINTS FOR UPDATING RPMS
|
|---|
| 4 | ;
|
|---|
| 5 | ;
|
|---|
| 6 | ;
|
|---|
| 7 | VVAR(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 | ;
|
|---|
| 25 | NARR() ;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 | ;
|
|---|
| 48 | XMATCH(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 | ;
|
|---|
