BMXADOF2 ; IHS/CIHA/GIS - RPC CALL FOR EXTENDED FUNCTIONALITY OF BMXNet UTILITIES ;
;;4.0;BMX;;JUN 28, 2010
; THIS ROUTINE CONTAINS SPECIAL ENTRY POINTS FOR UPDATING RPMS
;
;
;
VVAR(DATA) ; EP-CHECK SPECIAL VARIABLES REQUIRED FOR UPDATING THE VISIT FILE
I '$L(DATA) S OUT="Update cancelled. Missing data string" Q 0
N X,I,Y,VDATE,%DT
K AUPNPAT,AUPNDOB,AUPNDOD,AUPNVSIT ; THE VARS ARE NOT NEW'D SINCE THEY WILL BE USED BY THE CALLING ROUTINE
S AUPNTALK=1,AUPNOVRR=1
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
S X=$P(DATA,"|",2),X=$P(X,$C(30)),VDATE=-1
I $E(X,1,7)?7N S VDATE=X
E S %DT="T" D ^%DT S VDATE=Y
I VDATE=-1 S OUT="Update cancelled. Visit timestamp misssing/invalid" Q 0
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
S AUPNPAT=Y
S AUPNDOB=$P($G(^DPT(AUPNPAT,0)),U,3) I 'AUPNDOB S OUT="Update cancelled. Missing DOB" Q 0
I AUPNDOB>VDATE S OUT="Update cancelled. Patient born afer visit date???" Q 0
S AUPNDOD=$P($G(^DPT(AUPNPAT,.35)),U)
I AUPNDOD,AUPNDOD<VDATE S OUT="Update cancelled. Patient died before this visit date" Q
Q 1
;
NARR() ;EP - GET IEN OF PROVIDER NARR & UPDATE DATA STG FOR PROBLEM FILE
N PCE,NARR,NIEN,IPCE,%,I,NN,DIC,X,Y,FLD,FIEN
S PCE=0,FIEN=+SCHEMA,NIEN=""
F I=3:1:$L(SCHEMA,U) D I PCE Q
. S %=$P(SCHEMA,U,I)
. S FLD=$P(%,"|",2)
. I 'FLD Q
. I $P($G(^DD(FIEN,FLD,0)),U,2)["P9999999.27" S PCE=I
. Q
I 'PCE Q ""
S NARR=$P(DATA,U,PCE) I NARR="" Q ""
S NIEN=$$XMATCH(NARR)
I 'NIEN D ; CREATE A NEW ENTRY IN THE PROVIDER NARRATIVE FILE
. S DIC=9999999.27
. S DIC(0)="L"
. S X=""""_NARR_""""
. D ^DIC I Y=-1 Q
. S NIEN=+Y
. Q
I 'NIEN Q ""
S $P(DATA,U,PCE)="`"_NIEN ; STUFF THE NARRATIVE LOOKUP VALUE INTO THE DATA STRING
Q NIEN
;
XMATCH(NARR) ; IF THERE IS AN EXACT MATCH IN THE PROVIDER NARRATIVE FILE, RETURN THE IEN
N IX,X,Y,%
S IX=$E(NARR,1,30)
S %=$O(^AUTNPOV("B",IX,0))
I '% Q ""
I %,'$O(^AUTNPOV("B",IX,%)) Q %
S Y=""
S %=0 F S %=$O(^AUTNPOV("B",IX,%)) Q:'% S X=$P($G(^AUTNPOV(%,0)),U) I X=NARR S Y=% Q
Q Y
;
BMXADOF2 ; IHS/CIHA/GIS - RPC CALL FOR EXTENDED FUNCTIONALITY OF BMXNet UTILITIES ;
+1 ;;4.0;BMX;;JUN 28, 2010
+2 ; THIS ROUTINE CONTAINS SPECIAL ENTRY POINTS FOR UPDATING RPMS
+3 ;
+4 ;
+5 ;
VVAR(DATA) ; EP-CHECK SPECIAL VARIABLES REQUIRED FOR UPDATING THE VISIT FILE
+1 IF '$LENGTH(DATA)
SET OUT="Update cancelled. Missing data string"
QUIT 0
+2 NEW X,I,Y,VDATE,%DT
+3 ; THE VARS ARE NOT NEW'D SINCE THEY WILL BE USED BY THE CALLING ROUTINE
KILL AUPNPAT,AUPNDOB,AUPNDOD,AUPNVSIT
+4 SET AUPNTALK=1
SET AUPNOVRR=1
+5 ; STRIP OFF TRANSACTION FLAGS FROM FIELD NUMBERS
SET X=DATA
SET X=$TRANSLATE(X,($CHAR(30)_"+"),$CHAR(30))
SET X=$TRANSLATE(X,($CHAR(30)_"-"),$CHAR(30))
SET X=$TRANSLATE(X,($CHAR(30)_"`"),$CHAR(30))
SET DATA=X
+6 SET X=$PIECE(DATA,"|",2)
SET X=$PIECE(X,$CHAR(30))
SET VDATE=-1
+7 IF $EXTRACT(X,1,7)?7N
SET VDATE=X
+8 IF '$TEST
SET %DT="T"
DO ^%DT
SET VDATE=Y
+9 IF VDATE=-1
SET OUT="Update cancelled. Visit timestamp misssing/invalid"
QUIT 0
+10 ; FAILED TO FIND THE PATIENT IEN
SET Y=+$PIECE(DATA,($CHAR(30)_".05|"),2)
IF 'Y
SET OUT="Update cancelled. Patient data missing"
QUIT 0
+11 SET AUPNPAT=Y
+12 SET AUPNDOB=$PIECE($GET(^DPT(AUPNPAT,0)),U,3)
IF 'AUPNDOB
SET OUT="Update cancelled. Missing DOB"
QUIT 0
+13 IF AUPNDOB>VDATE
SET OUT="Update cancelled. Patient born afer visit date???"
QUIT 0
+14 SET AUPNDOD=$PIECE($GET(^DPT(AUPNPAT,.35)),U)
+15 IF AUPNDOD
IF AUPNDOD<VDATE
SET OUT="Update cancelled. Patient died before this visit date"
QUIT
+16 QUIT 1
+17 ;
NARR() ;EP - GET IEN OF PROVIDER NARR & UPDATE DATA STG FOR PROBLEM FILE
+1 NEW PCE,NARR,NIEN,IPCE,%,I,NN,DIC,X,Y,FLD,FIEN
+2 SET PCE=0
SET FIEN=+SCHEMA
SET NIEN=""
+3 FOR I=3:1:$LENGTH(SCHEMA,U)
Begin DoDot:1
+4 SET %=$PIECE(SCHEMA,U,I)
+5 SET FLD=$PIECE(%,"|",2)
+6 IF 'FLD
QUIT
+7 IF $PIECE($GET(^DD(FIEN,FLD,0)),U,2)["P9999999.27"
SET PCE=I
+8 QUIT
End DoDot:1
IF PCE
QUIT
+9 IF 'PCE
QUIT ""
+10 SET NARR=$PIECE(DATA,U,PCE)
IF NARR=""
QUIT ""
+11 SET NIEN=$$XMATCH(NARR)
+12 ; CREATE A NEW ENTRY IN THE PROVIDER NARRATIVE FILE
IF 'NIEN
Begin DoDot:1
+13 SET DIC=9999999.27
+14 SET DIC(0)="L"
+15 SET X=""""_NARR_""""
+16 DO ^DIC
IF Y=-1
QUIT
+17 SET NIEN=+Y
+18 QUIT
End DoDot:1
+19 IF 'NIEN
QUIT ""
+20 ; STUFF THE NARRATIVE LOOKUP VALUE INTO THE DATA STRING
SET $PIECE(DATA,U,PCE)="`"_NIEN
+21 QUIT NIEN
+22 ;
XMATCH(NARR) ; IF THERE IS AN EXACT MATCH IN THE PROVIDER NARRATIVE FILE, RETURN THE IEN
+1 NEW IX,X,Y,%
+2 SET IX=$EXTRACT(NARR,1,30)
+3 SET %=$ORDER(^AUTNPOV("B",IX,0))
+4 IF '%
QUIT ""
+5 IF %
IF '$ORDER(^AUTNPOV("B",IX,%))
QUIT %
+6 SET Y=""
+7 SET %=0
FOR
SET %=$ORDER(^AUTNPOV("B",IX,%))
IF '%
QUIT
SET X=$PIECE($GET(^AUTNPOV(%,0)),U)
IF X=NARR
SET Y=%
QUIT
+8 QUIT Y
+9 ;
