- 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 ;
