Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BJPNPUTL

BJPNPUTL.m

Go to the documentation of this file. 
  1. BJPNPUTL ;GDIT/HS/BEE-Prenatal Care Module Utility Calls ; 08 May 2012  12:00 PM
  1.  ;;2.0;PRENATAL CARE MODULE;**1,2,6,7,8**;Feb 24, 2015;Build 25
  1.  ;
  1.  Q
  1.  ;
  1. DPOV(DATA,POVIEN,PRBIEN) ;EP - BJPN DELETE POV
  1.  ;
  1.  ;This RPC removes the V POV entry for the SNOMED problem and the PROBLEM 1401 entry
  1.  ;
  1.  ;Input:
  1.  ; POVIEN - The pointer(s) to the V POV entry or entries - POV_IEN - $C(29) delimiter
  1.  ; PRBIEN - The pointer to the IPL - PRBIEN
  1.  ;
  1.  NEW UID,II,RET,RESULT,PIEN,PPIECE
  1.  ;
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BJPNPUTL",UID))
  1.  K @DATA
  1.  I $G(DT)=""!($G(U)="") D DT^DICRW
  1.  ;
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BJPNPUTL D UNWIND^%ZTER" ; SAC 2009 2.2.3.17
  1.  ;
  1.  ;Define Header
  1.  S @DATA@(II)="T00005RESULT^T00150ERROR_MESSAGE"_$C(30)
  1.  ;
  1.  ;Input validation
  1.  I $G(POVIEN)="" S II=II+1,@DATA@(II)="-1^MISSING VPOVIEN"_$C(30) G XDPOV
  1.  I $G(PRBIEN)="" S II=II+1,@DATA@(II)="-1^MISSING PRBIEN"_$C(30) G XDPOV
  1.  ;
  1.  ;Make the API call for each IEN
  1.  F PPIECE=1:1:$L(POVIEN,$C(29)) S PIEN=$P(POVIEN,$C(29),PPIECE) I PIEN]"" D  I +$P(RET,U)<0 Q
  1.  . D DEL^BGOVPOV(.RET,PIEN,PRBIEN)
  1.  ;
  1.  ;Set up return string
  1.  I +$P(RET,U)<0 S RESULT="-1^"_$P(RET,U,2)
  1.  E  S RESULT="1^"
  1.  S II=II+1,@DATA@(II)=RESULT_$C(30)
  1.  ;
  1. XDPOV S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. PRV(DATA,VIEN,PRVIEN,PRMSEC) ;EP - BJPN SET PROVIDER
  1.  ;
  1.  ;This RPC sets a V PROVIDER entry for the visit
  1.  ;and also possibly changes the primary provider
  1.  ;
  1.  ;Input:
  1.  ; VIEN - Visit Pointer
  1.  ; PRVIEN - Provider IEN
  1.  ; PRMSEC - Primary/Secondary Provider (P/S)
  1.  ;
  1.  NEW UID,II,IN,DFN,RET
  1.  ;
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BJPNPUTL",UID))
  1.  K @DATA
  1.  I $G(DT)=""!($G(U)="") D DT^DICRW
  1.  S PRMSEC=$G(PRMSEC,"")
  1.  ;
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BJPNPUTL D UNWIND^%ZTER" ; SAC 2009 2.2.3.17
  1.  ;
  1.  ;Define Header
  1.  S @DATA@(II)="T00005RESULT^T00150ERROR_MESSAGE"_$C(30)
  1.  ;
  1.  ; Set primary provider
  1.  ;  INP = Visit IEN [1] ^ Patient IEN [2] ^ Provider IEN [3] ^ Primary/Secondary (P/S) [4] ^
  1.     ;        Force Conversion to Primary (Y/N) [5]
  1.  ;
  1.  ;Input verification
  1.  I $G(VIEN)="" S II=II+1,@DATA@(II)="-1^MISSING VIEN"_$C(30) G XPRV
  1.  S DFN=$$GET1^DIQ(9000010,VIEN_",",.05,"I")
  1.  I DFN="" S II=II+1,@DATA@(II)="-1^MISSING DFN"_$C(30) G XPRV
  1.  I $$GET1^DIQ(200,PRVIEN_",",.01,"I")="" S II=II+1,@DATA@(II)="-1^INVALID PROVIDER"_$C(30) G XPRV
  1.  ;
  1.  ;Make call to API
  1.  S IN=VIEN_U_DFN_U_PRVIEN_U_PRMSEC
  1.  D SETVPRV^BGOVPRV(.RET,IN)
  1.  ;
  1.  ;Override primary if necessary
  1.  I +RET<0,PRMSEC="P" D
  1.  . S IN=IN_U_1
  1.  . D SETVPRV^BGOVPRV(.RET,IN)
  1.  ;
  1.  I +RET<0 S II=II+1,@DATA@(II)="-1^PRV SAVE UNSUCCESSFUL"_$C(30) G XPRV
  1.  S II=II+1,@DATA@(II)="1^"_$C(30)
  1.  ;
  1. XPRV S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. CLOSE(DATA,VIEN) ;EP - BJPN CLOSE PIP
  1.  ;
  1.  ;This RPC makes each problem on the patient's PIP inactive
  1.  ;
  1.  ;Input:
  1.  ; VIEN - Visit Pointer
  1.  ;
  1.  NEW UID,II,DFN,PIPIEN,NOW,%,ERROR,TMP
  1.  ;
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BJPNPUTL",UID))
  1.  K @DATA
  1.  I $G(DT)=""!($G(U)="") D DT^DICRW
  1.  ;
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BJPNPUTL D UNWIND^%ZTER" ; SAC 2009 2.2.3.17
  1.  ;
  1.  ;Define Header
  1.  S @DATA@(II)="T00005RESULT^T00150ERROR_MESSAGE"_$C(30)
  1.  ;
  1.  ;Input verification
  1.  I $G(VIEN)="" S II=II+1,@DATA@(II)="-1^MISSING VIEN"_$C(30) G XPRV
  1.  S DFN=$$GET1^DIQ(9000010,VIEN_",",.05,"I")
  1.  I DFN="" S II=II+1,@DATA@(II)="-1^MISSING DFN"_$C(30) G XPRV
  1.  ;
  1.  ;Get current date/time
  1.  D NOW^%DTC S NOW=%
  1.  ;
  1.  ;Call EHR API and format results into usable data
  1.  D COMP^BJPNUTIL(DFN,UID,VIEN)
  1.  S TMP=$NA(^TMP("BJPNIPL",UID))  ;Define compiled data reference
  1.  ;
  1.  ;Loop through each entry on the PIP
  1.  S PIPIEN="" F  S PIPIEN=$O(^BJPNPL("D",DFN,PIPIEN)) Q:'PIPIEN  D  Q:$D(ERROR)
  1.  . ;
  1.  . NEW BJPNUP,STS,LMDT,LMBY,RSLT,PRBIEN,CSTS,ISTS,BGO,BSCO
  1.  . ;
  1.  . ;Skip deletes
  1.  . I $$GET1^DIQ(90680.01,PIPIEN_",",2.01,"I")]"" Q
  1.  . ;
  1.  . ;Status
  1.  . S STS="I"
  1.  . S CSTS=$$GET1^DIQ(90680.01,PIPIEN_",",.08,"I")
  1.  . I CSTS'="I" S BJPNUP(90680.01,PIPIEN_",",.08)=STS
  1.  . ;
  1.  . ;BJPN*2.0*8;Make Scope prior pregnancy
  1.  . S BSCO=$$GET1^DIQ(90680.01,PIPIEN_",",.07,"I")
  1.  . I BSCO'="A" S BJPNUP(90680.01,PIPIEN_",",.07)="A"
  1.  . ;
  1.  . ;Last Modified Date
  1.  . S LMDT=NOW
  1.  . S BJPNUP(90680.01,PIPIEN_",",1.03)=LMDT
  1.  . ;
  1.  . ;Last Modified By
  1.  . S LMBY=DUZ
  1.  . S BJPNUP(90680.01,PIPIEN_",",1.04)=LMBY
  1.  . ;
  1.  . ;Clear Definitive EDD
  1.  . S BJPNUP(90680.01,PIPIEN_",",.09)="@"
  1.  . ;
  1.  . ;Update IPL values
  1.  . S PRBIEN=$$GET1^DIQ(90680.01,PIPIEN_",",.1,"I")
  1.  . I PRBIEN]"" D  I $D(ERROR) G XCLOSE
  1.  .. NEW PIP,IPLUPD
  1.  .. ;
  1.  .. ;Get the current PIP value - If set, need to clear out
  1.  .. S IPLUPD(9000011,PRBIEN_",",.03)=NOW
  1.  .. S IPLUPD(9000011,PRBIEN_",",.14)=DUZ
  1.  .. S PIP=$$GET1^DIQ(9000011,PRBIEN_",",.19,"I")
  1.  .. I PIP D
  1.  ... NEW DA,IENS,DIC,DLAYGO,X,Y
  1.  ... S IPLUPD(9000011,PRBIEN_",",.19)="@"  ;Clear the PIP value
  1.  ... ;
  1.  ... ;Add the User/PIP value history entry
  1.  ... ;
  1.  ... S DIC="^BJPNPL("_PIPIEN_",5,"
  1.  ... S DA(1)=PIPIEN
  1.  ... S DLAYGO="90680.015",DIC("P")=$P(^DD(90680.01,5,0),U,2),DIC(0)="LOX"
  1.  ... S X=NOW
  1.  ... K DO,DD D FILE^DICN
  1.  ... I +Y=-1 S ERROR="Could not add PIP column history" Q
  1.  ... S DA(1)=PIPIEN,DA=+Y,IENS=$$IENS^DILF(.DA)
  1.  ... S BJPNUP(90680.015,IENS,".02")="0"
  1.  ... S BJPNUP(90680.015,IENS,".03")=DUZ
  1.  .. I '$D(ERROR) D FILE^DIE("","IPLUPD","ERROR")
  1.  . I $D(ERROR) S II=II+1,@DATA@(II)="-1^^PIP CLOSE IPL UPDATE FAILED - PIPIEN:"_PIPIEN_$C(30)
  1.  . ;
  1.  . ;Update PIP entry
  1.  . I $D(BJPNUP) D FILE^DIE("","BJPNUP","ERROR")
  1.  . I $D(ERROR) S II=II+1,@DATA@(II)="-1^^PIP CLOSE FAILED - PIPIEN:"_PIPIEN_$C(30)
  1.  . ;
  1.  . ;For IPL Episodic problems, inactivate care plans/goals
  1.  . Q:PRBIEN=""
  1.  . I $$GET1^DIQ(9000011,PRBIEN_",",.12,"I")'="E" Q
  1.  . ;
  1.  . ;Loop through Care Plans
  1.  . S BGO="" F  S BGO=$O(@TMP@("C",PRBIEN,BGO)) Q:BGO=""  D
  1.  .. ;
  1.  .. NEW APIRES,IEN,RET
  1.  .. ;
  1.  .. S APIRES=$G(@TMP@("C",PRBIEN,BGO,0)) Q:APIRES=""
  1.  .. ;
  1.  .. ;Skip Inactive Care Plans
  1.  .. I $P(APIRES,U,6)'="A" Q
  1.  .. ;
  1.  .. ;Get the pointer to 9000092
  1.  .. S IEN=$P(APIRES,U,2) Q:IEN=""
  1.  .. D UPSTAT^BGOCPLAN(.RET,IEN,PRBIEN,"I","Closed PIP - Inactivated because IPL status is Episodic")
  1.  .. I $P($G(RET),U)="-1" S ERROR=1,II=II+1,@DATA@(II)="-1^^Could not make care plan inactive"_$C(30)
  1.  . I $D(ERROR) Q
  1.  . ;
  1.  . ;Loop through Care Plans
  1.  . S BGO="" F  S BGO=$O(@TMP@("G",PRBIEN,BGO)) Q:BGO=""  D
  1.  .. ;
  1.  .. NEW APIRES,IEN,RET
  1.  .. ;
  1.  .. S APIRES=$G(@TMP@("G",PRBIEN,BGO,0)) Q:APIRES=""
  1.  .. ;
  1.  .. ;Skip Inactive Care Plans
  1.  .. I $P(APIRES,U,6)'="A" Q
  1.  .. ;
  1.  .. ;Get the pointer to 9000092
  1.  .. S IEN=$P(APIRES,U,2) Q:IEN=""
  1.  .. D UPSTAT^BGOCPLAN(.RET,IEN,PRBIEN,"I","Closed PIP - Inactivated because IPL status is Episodic")
  1.  .. I $P($G(RET),U)="-1" S II=II+1,@DATA@(II)="-1^^Could not make goal inactive"_$C(30)
  1.  . I $D(ERROR) Q
  1.  ;
  1.  ;Record success
  1.  I '$D(ERROR) S II=II+1,@DATA@(II)="1^"_$C(30)
  1.  ;
  1. XCLOSE S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. OPEN(DATA,VIEN) ;EP - BJPN OPEN PIP
  1.  ;
  1.  ;This RPC makes each 'All Pregnancies' problems on the patient's PIP active
  1.  ;
  1.  ;Input:
  1.  ; VIEN - Visit Pointer
  1.  ;
  1.  NEW UID,II,DFN,PIPIEN,NOW,%,ERROR,PIPCNT
  1.  ;
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BJPNPUTL",UID))
  1.  K @DATA
  1.  I $G(DT)=""!($G(U)="") D DT^DICRW
  1.  ;
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BJPNPUTL D UNWIND^%ZTER" ; SAC 2009 2.2.3.17
  1.  ;
  1.  ;Define Header
  1.  S @DATA@(II)="T00005RESULT^T00150ERROR_MESSAGE"_$C(30)
  1.  ;
  1.  ;Input verification
  1.  I $G(VIEN)="" S II=II+1,@DATA@(II)="-1^MISSING VIEN"_$C(30) G XPRV
  1.  S DFN=$$GET1^DIQ(9000010,VIEN_",",.05,"I")
  1.  I DFN="" S II=II+1,@DATA@(II)="-1^MISSING DFN"_$C(30) G XPRV
  1.  ;
  1.  ;Get current date/time
  1.  D NOW^%DTC S NOW=%
  1.  ;
  1.  ;Loop through each entry on the PIP
  1.  S PIPCNT=0,PIPIEN="" F  S PIPIEN=$O(^BJPNPL("D",DFN,PIPIEN)) Q:'PIPIEN  D  Q:$D(ERROR)
  1.  . ;
  1.  . NEW BJPNUP,STS,LMDT,LMBY,RSLT,IPLUPD,PRBIEN,DIC,DLAYGO,DA,IENS,X,Y
  1.  . ;
  1.  . ;Skip deletes
  1.  . I $$GET1^DIQ(90680.01,PIPIEN_",",2.01,"I")]"" Q
  1.  . ;
  1.  . ;Mark that we have an entry
  1.  . S PIPCNT=1
  1.  . ;
  1.  . S PRBIEN=$$GET1^DIQ(90680.01,PIPIEN_",",.1,"I")
  1.  . I PRBIEN="" S II=II+1,@DATA@(II)="-1^Could not find PRBIEN in PIP entry: "_PIPIEN,ERROR=1 Q
  1.  . ;
  1.  . ;Include only 'All Pregnancies'
  1.  . I $$GET1^DIQ(90680.01,PIPIEN_",",.07,"I")'="A" Q
  1.  . ;
  1.  . ;Status
  1.  . S STS="A"
  1.  . S BJPNUP(90680.01,PIPIEN_",",.08)=STS
  1.  . ;
  1.  . ;Last Modified Date
  1.  . S LMDT=NOW
  1.  . S BJPNUP(90680.01,PIPIEN_",",1.03)=LMDT
  1.  . ;
  1.  . ;Last Modified By
  1.  . S LMBY=DUZ
  1.  . S BJPNUP(90680.01,PIPIEN_",",1.04)=LMBY
  1.  . ;
  1.  . S IPLUPD(9000011,PRBIEN_",",.19)=1
  1.  . S IPLUPD(9000011,PRBIEN_",",.03)=LMDT
  1.  . S IPLUPD(9000011,PRBIEN_",",.14)=DUZ
  1.  . ;
  1.  . ;Add the IPL PIP flag
  1.  . S DIC="^BJPNPL("_PIPIEN_",5,"
  1.  . S DA(1)=PIPIEN
  1.  . S DLAYGO="90680.015",DIC("P")=$P(^DD(90680.01,5,0),U,2),DIC(0)="LOX"
  1.  . S X=NOW
  1.  . K DO,DD D FILE^DICN
  1.  . I +Y=-1 S II=II+1,@DATA@(II)="-1^Could not add PIP column history"_$C(30),ERROR=1 Q
  1.  . ;
  1.  . ;Add the User/PIP value
  1.  . S DA(1)=PIPIEN,DA=+Y,IENS=$$IENS^DILF(.DA)
  1.  . S BJPNUP(90680.015,IENS,".02")=1
  1.  . S BJPNUP(90680.015,IENS,".03")=DUZ
  1.  . ;
  1.  . ;Update entry
  1.  . I $D(BJPNUP) D FILE^DIE("","BJPNUP","ERROR")
  1.  . I $D(ERROR) S II=II+1,@DATA@(II)="-1^PIP OPEN FAILED - PIPIEN:"_PIPIEN_$C(30),ERROR=1 Q
  1.  . ;
  1.  . D FILE^DIE("","IPLUPD","ERROR")
  1.  . I $D(ERROR) S II=II+1,@DATA@(II)="-1^PIP OPEN FAILED - PRBIEN:"_PRBIEN_$C(30),ERROR=1 Q
  1.  ;
  1.  ;Record success
  1.  I '$D(ERROR) S II=II+1,@DATA@(II)="1^"_$C(30)
  1.  ;
  1.  ;Broadcast update
  1.  I $G(PIPCNT)=1 D
  1.  . ;BJPN*2.0*7;Removed PPL
  1.  . ;D FIREEV^BJPNPDET("","PCC."_DFN_".PPL")
  1.  . D FIREEV^BJPNPDET("","PCC."_DFN_".PIP")
  1.  ;
  1. XOPEN S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. DEDD(DATA,VIEN) ;EP - BJPN SET DEDD
  1.  ;
  1.  ;This RPC updates the definitive EDD for each problem
  1.  ;
  1.  ;Input:
  1.  ; VIEN - Visit Pointer
  1.  ;
  1.  NEW UID,II,DFN,PIPIEN,NOW,%,ERROR,DEDD
  1.  ;
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BJPNPUTL",UID))
  1.  K @DATA
  1.  I $G(DT)=""!($G(U)="") D DT^DICRW
  1.  ;
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BJPNPUTL D UNWIND^%ZTER" ; SAC 2009 2.2.3.17
  1.  ;
  1.  ;Define Header
  1.  S @DATA@(II)="T00005RESULT^T00150ERROR_MESSAGE"_$C(30)
  1.  ;
  1.  ;Input verification
  1.  I $G(VIEN)="" S II=II+1,@DATA@(II)="-1^MISSING VIEN"_$C(30) G XPRV
  1.  S DFN=$$GET1^DIQ(9000010,VIEN_",",.05,"I")
  1.  I DFN="" S II=II+1,@DATA@(II)="-1^MISSING DFN"_$C(30) G XPRV
  1.  ;
  1.  ;Get current date/time
  1.  D NOW^%DTC S NOW=%
  1.  ;
  1.  ;Pull DEDD
  1.  S DEDD=$$GET1^DIQ(9000017,DFN_",",1311,"I") S:DEDD="" DEDD="@"
  1.  ;
  1.  ;Loop through each entry on the PIP
  1.  S PIPIEN="" F  S PIPIEN=$O(^BJPNPL("D",DFN,PIPIEN)) Q:'PIPIEN  D  Q:$D(ERROR)
  1.  . ;
  1.  . NEW BJPNUP,STS,LMDT,LMBY,RSLT
  1.  . ;
  1.  . ;Skip deletes
  1.  . I $$GET1^DIQ(90680.01,PIPIEN_",",2.01,"I")]"" Q
  1.  . ;
  1.  . ;DEDD
  1.  . S BJPNUP(90680.01,PIPIEN_",",.09)=DEDD
  1.  . ;
  1.  . ;Last Modified Date
  1.  . S LMDT=NOW
  1.  . S BJPNUP(90680.01,PIPIEN_",",1.03)=LMDT
  1.  . ;
  1.  . ;Last Modified By
  1.  . S LMBY=DUZ
  1.  . S BJPNUP(90680.01,PIPIEN_",",1.04)=LMBY
  1.  . ;
  1.  . ;Update entry
  1.  . I $D(BJPNUP) D FILE^DIE("","BJPNUP","ERROR")
  1.  . I $D(ERROR) S II=II+1,@DATA@(II)="-1^^UPDATE DEDD FAILED - PIPIEN:"_PIPIEN_$C(30)
  1.  ;
  1.  ;Record success
  1.  I '$D(ERROR) S II=II+1,@DATA@(II)="1^"_$C(30)
  1.  ;
  1. XDEDD S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. PPRV(DATA,VIEN) ;EP - BJPN GET PRIMARY PROVIDER
  1.  ;
  1.  ;This RPC returns the primary provider for a visit
  1.  ;
  1.  ;Input:
  1.  ; VIEN - Visit Pointer
  1.  ;
  1.  NEW UID,II,IN,PRV,XPRV
  1.  ;
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BJPNPUTL",UID))
  1.  K @DATA
  1.  I $G(DT)=""!($G(U)="") D DT^DICRW
  1.  ;
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BJPNPUTL D UNWIND^%ZTER" ; SAC 2009 2.2.3.17
  1.  ;
  1.  ;Define Header
  1.  S @DATA@(II)="I00010HIDE_PRV^T00035PROVIDER"_$C(30)
  1.  ;
  1.  ;Input verification
  1.  I $G(VIEN)="" S II=II+1,@DATA@(II)="-1^MISSING VIEN"_$C(30) G XPRV
  1.  ;
  1.  ;PRV fields
  1.  S (PRV,XPRV)=""
  1.  S PRV=$$PPRV^BJPNPKL(VIEN)
  1.  S:PRV="" PRV=DUZ
  1.  S XPRV=$$GET1^DIQ(200,PRV_",",.01,"E")
  1.  ;
  1.  S II=II+1,@DATA@(II)=PRV_U_XPRV_$C(30)
  1.  ;
  1. XPPRV S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. PTED(N) ;Convert Education Topic to EHR viewable string
  1.  ;
  1.  I $G(N)="" Q ""
  1.  ;
  1.  NEW VEDIEN,TPIEN,TOPIC
  1.  ;
  1.  ;Pull the V PATIENT ED IEN
  1.  S VEDIEN=$P(N,U,6) Q:VEDIEN="" N
  1.  ;
  1.  ;Get the topic IEN
  1.  S TPIEN=$$GET1^DIQ(9000010.16,VEDIEN_",",".01","I") I TPIEN="" Q N
  1.  ;
  1.  ;If no SNOMED return what is there
  1.  I $$GET1^DIQ(9999999.09,TPIEN_",",.12,"I")="" Q N
  1.  ;
  1.  ;Get the unconverted topic
  1.  S TOPIC=$$GET1^DIQ(9999999.09,TPIEN_",",".01","I") I TOPIC="" Q N
  1.  ;
  1.  ;Strip off the SNOMED
  1.  S TOPIC=$P(TOPIC,"-",2) I TOPIC="" Q N
  1.  ;
  1.  ;See if topic can be converted
  1.  S TOPIC=$$CNVTPC(TOPIC)
  1.  S $P(N,U,2)=TOPIC
  1.  Q N
  1.  ;
  1. CNVTPC(T) ;Convert topic for EHR display
  1.  I T="DISEASE PROCESS" S T="Had Disease Process education"
  1.  I T="NUTRITION" S T="Had Nutrition education"
  1.  I T="LIFESTYLE ADAPTATION" S T="Had Lifestyle Adaptation education"
  1.  I T="PREVENTION" S T="Had Prevention education"
  1.  I T="MEDICATIONS" S T="Had Medication education"
  1.  I T="EXERCISE" S T="Had Exercise education"
  1.  Q T
  1.  ;
  1. GETABN(DATA,CONCID) ;EP - BJPN GET ABNORMAL
  1.  ;
  1.  ;This RPC determines whether to prompt for abnormal/normal findings for a concept
  1.  ;
  1.  ;Input:
  1.  ; CONCID - The Concept ID
  1.  ;
  1.  ;Output:
  1.  ; 1 - Prompt for abnormal/normal
  1.  ; 0 - Do not prompt for abnormal/normal
  1.  ;
  1.  NEW UID,II,RESULT
  1.  ;
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BJPNPUTL",UID))
  1.  K @DATA
  1.  I $G(DT)=""!($G(U)="") D DT^DICRW
  1.  ;
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BJPNPUTL D UNWIND^%ZTER" ; SAC 2009 2.2.3.17
  1.  ;
  1.  ;Define Header
  1.  S @DATA@(II)="T00001PROMPT_ABNORMAL"_$C(30)
  1.  ;
  1.  ;Input validation
  1.  I $G(CONCID)="" S II=II+1,@DATA@(II)="-1^MISSING VPOVIEN"_$C(30) G XGETABN
  1.  ;
  1.  S RESULT=$P($$CONC^BSTSAPI(CONCID),U,7)
  1.  ;
  1.  ;Set up return string
  1.  S II=II+1,@DATA@(II)=RESULT_$C(30)
  1.  ;
  1. XGETABN  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. ERR ;
  1.  D ^%ZTER
  1.  NEW Y,ERRDTM
  1.  S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q