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

BJPNPDET.m

Go to the documentation of this file. 
  1. BJPNPDET ;GDIT/HS/BEE-Prenatal Care Module Utility 2 Calls ; 08 May 2012  12:00 PM
  1.  ;;2.0;PRENATAL CARE MODULE;;Feb 24, 2015;Build 63
  1.  ;
  1.  Q
  1.  ;
  1. DET(DATA,PIP) ;EP - BJPN PROBLEM DETAIL
  1.  ;
  1.  ;This RPC returns the problem detail for a Problem entry (including paste deletes)
  1.  ;
  1.  ;Input:
  1.  ; PIP - Pointer to Prenatal Problem file entry
  1.  ;
  1.  NEW UID,II,TMP,REC,PLIEN,DFN,TERM,PIPIEN
  1.  ;
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BJPNPDET",UID))
  1.  K @DATA
  1.  I $G(DT)=""!($G(U)="") D DT^DICRW
  1.  ;
  1.  S TMP=$NA(^TMP("BJPNPDT1",UID))
  1.  K @TMP
  1.  ;
  1.  S II=0,REC=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BJPNPDET D UNWIND^%ZTER" ; SAC 2009 2.2.3.17
  1.  ;
  1.  ;Define Header
  1.  S @DATA@(II)="T01024REPORT_TEXT"_$C(30)
  1.  ;
  1.  S II=II+1,@DATA@(II)="This will eventually be filled with detail history"_$C(30)
  1.  G XDET
  1.  I $G(PIP)="" G XDET
  1.  ;
  1.  ;Retrieve Problem Pointer
  1.  S PLIEN=$$GET1^DIQ(90680.01,PIP_",",.03,"I") I PLIEN="" G XDET
  1.  ;
  1.  ;Retrieve DFN
  1.  S DFN=$$GET1^DIQ(90680.01,PIP_",",.02,"I") I DFN="" G XDET
  1.  ;
  1.  S TERM=$$GET1^DIQ(90680.02,PLIEN_",",.02,"E")
  1.  ;
  1.  ;Loop through all instances of problem (including deletes)
  1.  S PIPIEN="" F  S PIPIEN=$O(^BJPNPL("AC",DFN,PLIEN,PIPIEN)) Q:'PIPIEN  D
  1.  . ;
  1.  . NEW VDT
  1.  . ;Step through all V OB entries for PIPIEN
  1.  . S REC=0,VDT="" F  S VDT=$O(^AUPNVOB("AE",DFN,PIPIEN,VDT)) Q:VDT=""  D
  1.  .. ;
  1.  .. NEW VFIEN
  1.  .. S VFIEN="" F  S VFIEN=$O(^AUPNVOB("AE",DFN,PIPIEN,VDT,VFIEN)) Q:VFIEN=""  D
  1.  ... ;
  1.  ... NEW ALMDT,LMDT,LMBY,OEDT,OEBY,AIEN
  1.  ... ;
  1.  ... ;Pull LMDT
  1.  ... S ALMDT=$$GET1^DIQ(9000010.43,VFIEN_",",1218,"I")
  1.  ... S:ALMDT="" ALMDT=$$GET1^DIQ(9000010.43,VFIEN_",",1216,"I")
  1.  ... ;
  1.  ... ;Loop through audit history
  1.  ... S AIEN=0 F  S AIEN=$O(^AUPNVOB(VFIEN,22,AIEN)) Q:'AIEN  D
  1.  .... ;
  1.  .... NEW DA,IENS,RCNT,DA,IENS,ATYP,AVAL,VALUE,RCNT,VIEN
  1.  .... ;
  1.  .... S DA(1)=VFIEN,DA=AIEN,IENS=$$IENS^DILF(.DA)
  1.  .... S ATYP=$$GET1^DIQ(9000010.4311,IENS,".01","I")
  1.  .... S AVAL=$$GET1^DIQ(9000010.4311,IENS,".02","I")
  1.  .... ;
  1.  .... ;Define Line
  1.  .... S VALUE=$$VALUE(VFIEN,ATYP,AVAL)
  1.  .... ;
  1.  .... ;Date/User Handling
  1.  .... I AVAL=1216 S OEDT=VALUE Q
  1.  .... I AVAL=1217 S OEBY=VALUE Q
  1.  .... I AVAL=1218 S LMDT=VALUE Q
  1.  .... I AVAL=1219 S LMBY=VALUE Q
  1.  .... ;
  1.  .... ;Log entry
  1.  .... F RCNT=1:1:$L(VALUE,$C(28)) S REC=REC+1,@TMP@(ALMDT,REC)=$P(VALUE,$C(28),RCNT)
  1.  ... ;
  1.  ... ;Log Date/User
  1.  ... I $G(LMDT)]"" S REC=REC+1,@TMP@(ALMDT,REC)=LMDT
  1.  ... I $G(LMBY)]"" S REC=REC+1,@TMP@(ALMDT,REC)=LMBY
  1.  ... I $G(OEDT)]"" S REC=REC+1,@TMP@(ALMDT,REC)=OEDT
  1.  ... I $G(OEBY)]"" S REC=REC+1,@TMP@(ALMDT,REC)=OEBY
  1.  ... ;
  1.  ... ;Visit Date
  1.  ... S VIEN=$$GET1^DIQ(9000010.43,VFIEN,.03,"I")
  1.  ... S REC=REC+1,@TMP@(ALMDT,REC)="  *Visit Date: "_$$FMTE^BJPNPRL($$GET1^DIQ(9000010,VIEN_",",.01,"I"))
  1.  ... ;
  1.  ... ;Insert blank line
  1.  ... S REC=REC+1,@TMP@(ALMDT,REC)=""
  1.  ;
  1.  ;Assemble Header
  1.  S II=II+1,@DATA@(II)="SNOMED Term: "_TERM_$C(13)_$C(10)
  1.  S II=II+1,@DATA@(II)=$C(13)_$C(10)
  1.  ;
  1.  ;Current Info
  1.  S II=II+1,@DATA@(II)="CURRENT INFORMATION"_$C(13)_$C(10)
  1.  S II=II+1,@DATA@(II)=$C(13)_$C(10)
  1.  S II=II+1,@DATA@(II)="  *Provider Text: "_$$GET1^DIQ(90680.01,PIP_",",.05,"E")_$C(13)_$C(10)
  1.  S II=II+1,@DATA@(II)="  *Priority: "_$$GET1^DIQ(90680.01,PIP_",",.06,"E")_$C(13)_$C(10)
  1.  S II=II+1,@DATA@(II)="  *Scope: "_$$GET1^DIQ(90680.01,PIP_",",.07,"E")_$C(13)_$C(10)
  1.  S II=II+1,@DATA@(II)="  *Status: "_$$GET1^DIQ(90680.01,PIP_",",.08,"E")_$C(13)_$C(10)
  1.  S II=II+1,@DATA@(II)="  *Definitive EDD: "_$$FMTE^BJPNPRL($$GET1^DIQ(90680.01,PIP_",",.09,"I"))_$C(13)_$C(10)
  1.  S II=II+1,@DATA@(II)="  *Current Note: "_$$GET1^DIQ(90680.01,PIP_",",3,"E")_$C(13)_$C(10)
  1.  S II=II+1,@DATA@(II)=$C(13)_$C(10)
  1.  S II=II+1,@DATA@(II)="PROBLEM HISTORY"_$C(13)_$C(10)
  1.  S II=II+1,@DATA@(II)=$C(13)_$C(10)
  1.  ;
  1.  ;Loop through results and format
  1.  NEW VDT
  1.  S VDT="" F  S VDT=$O(@TMP@(VDT),-1) Q:VDT=""  D
  1.  . NEW REC
  1.  . S REC="" F  S REC=$O(@TMP@(VDT,REC)) Q:REC=""  D
  1.  .. S II=II+1,@DATA@(II)=@TMP@(VDT,REC)_$C(13)_$C(10)
  1.  S II=II+1,@DATA@(II)=$C(30)
  1.  ;
  1. XDET K @TMP
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. VALUE(VFIEN,ATYP,AVAL) ;EP - Retrieve field value
  1.  ;
  1.  I $G(VFIEN)="" Q ""
  1.  I $G(ATYP)="" Q ""
  1.  I $G(AVAL)="" Q ""
  1.  ;
  1.  S VALUE=""
  1.  ;
  1.  ;Audit Header
  1.  I ATYP="C" Q AVAL
  1.  ;
  1.  ;SNOMED Term
  1.  I AVAL=".12" D  Q VALUE
  1.  . NEW PKIEN,TERM
  1.  . S PKIEN=$$GET1^DIQ(9000010.43,VFIEN_",",.12,"I") Q:PKIEN=""
  1.  . S VALUE="  *Set SNOMED Term to: "_$$GET1^DIQ(90680.02,PKIEN_",",.02,"E")
  1.  ;
  1.  ;Used as POV
  1.  I AVAL=".05" D  Q VALUE
  1.  . NEW POV
  1.  . S POV=$$GET1^DIQ(9000010.43,VFIEN_",",.05,"E")
  1.  . S VALUE="  *Set As POV set to: "_$S(POV]"":POV,1:"No")
  1.  ;
  1.  ;Priority
  1.  I AVAL=".06" D  Q VALUE
  1.  . NEW PRI
  1.  . S PRI=$$GET1^DIQ(9000010.43,VFIEN_",",.06,"E")
  1.  . S VALUE="  *Priority set to: "_$S(PRI]"":PRI,1:"<Not Set>")
  1.  ;
  1.  ;Provider Text
  1.  I AVAL=".07" D  Q VALUE
  1.  . NEW PTX
  1.  . S PTX=$$GET1^DIQ(9000010.43,VFIEN_",",.07,"E")
  1.  . S VALUE="  *Provider Text set to: "_$S(PTX]"":PTX,1:"<Not Set>")
  1.  ;
  1.  ;Scope
  1.  I AVAL=".08" D  Q VALUE
  1.  . NEW SCO
  1.  . S SCO=$$GET1^DIQ(9000010.43,VFIEN_",",.08,"E")
  1.  . S VALUE="  *Scope set to: "_$S(SCO]"":SCO,1:"<Not Set>")
  1.  ;
  1.  ;Status
  1.  I AVAL=".09" D  Q VALUE
  1.  . NEW STS
  1.  . S STS=$$GET1^DIQ(9000010.43,VFIEN_",",.09,"E")
  1.  . S VALUE="  *Status set to: "_$S(STS]"":STS,1:"<Not Set>")
  1.  ;
  1.  ;DEDD
  1.  I AVAL=".1" D  Q VALUE
  1.  . NEW DEDD
  1.  . S DEDD=$$GET1^DIQ(9000010.43,VFIEN_",",.1,"E")
  1.  . S VALUE="  *Definitive EDD set to: "_$S(DEDD]"":DEDD,1:"<Not Set>")
  1.  ;
  1.  ;Provider Narrative
  1.  I AVAL=".11" D  Q VALUE
  1.  . NEW PNAR
  1.  . S PNAR=$$GET1^DIQ(9000010.43,VFIEN_",",.11,"E")
  1.  . S VALUE="  *Provider Narrative set to: "_$S(PNAR]"":PNAR,1:"<Not Set>")
  1.  ;
  1.  ;Original Entry Date
  1.  I AVAL="1216" D  Q VALUE
  1.  . NEW OEDT
  1.  . S OEDT=$$GET1^DIQ(9000010.43,VFIEN_",",1216,"I")
  1.  . S OEDT=$$FMTE^BJPNPRL(OEDT)
  1.  . S VALUE="  *Original Entry Date: "_OEDT
  1.  ;
  1.  ;Original Entered By
  1.  I AVAL="1217" D  Q VALUE
  1.  . NEW OEBY
  1.  . S OEBY=$$GET1^DIQ(9000010.43,VFIEN_",",1217,"E")
  1.  . S VALUE="  *Original Entered By: "_OEBY
  1.  ;
  1.  ;Last Modified Dt
  1.  I AVAL="1218" D  Q VALUE
  1.  . NEW LMDT
  1.  . S LMDT=$$GET1^DIQ(9000010.43,VFIEN_",",1218,"I")
  1.  . S LMDT=$$FMTE^BJPNPRL(LMDT)
  1.  . S VALUE="  *Entry Modified On: "_LMDT
  1.  ;
  1.  ;Last Modified By
  1.  I AVAL="1219" D  Q VALUE
  1.  . NEW LMBY
  1.  . S LMBY=$$GET1^DIQ(9000010.43,VFIEN_",",1219,"E")
  1.  . S VALUE="  *Entry Modified By: "_LMBY
  1.  ;
  1.  ;Problem Deleted By
  1.  I AVAL="2.01" D  Q VALUE
  1.  . NEW PDBY
  1.  . S PDBY=$$GET1^DIQ(9000010.43,VFIEN_",",2.01,"E")
  1.  . S VALUE="  *Problem Deleted By: "_$S(PDBY]"":PDBY,1:"<Not Set>")
  1.  ;
  1.  I AVAL="2.02" D  Q VALUE
  1.  . NEW PDDT
  1.  . S PDDT=$$GET1^DIQ(9000010.43,VFIEN_",",2.02,"I")
  1.  . S PDDT=$$FMTE^BJPNPRL(PDDT)
  1.  . S VALUE="  *Problem Deleted On: "_$S(PDDT]"":PDDT,1:"<Not Set>")
  1.  ;
  1.  ;Delete Code
  1.  I AVAL="2.03" D  Q VALUE
  1.  . NEW DCOD
  1.  . S DCOD=$$GET1^DIQ(9000010.43,VFIEN_",",2.03,"E")
  1.  . S VALUE="  *Problem Delete Reason: "_$S(DCOD]"":DCOD,1:"<Not Set>")
  1.  ;
  1.  ;Delete Reason
  1.  I AVAL="2.04" D  Q VALUE
  1.  . NEW DRSN
  1.  . S DRSN=$$GET1^DIQ(9000010.43,VFIEN_",",2.04,"E")
  1.  . S VALUE="  *Problem Delete Reason: "_$S(DRSN]"":DRSN,1:"<Not Set>")
  1.  ;
  1.  ;Problem Note Additions
  1.  I $P(AVAL,":")=2100,$P(AVAL,":",4)'="D" D  Q VALUE
  1.  . NEW NOTE,DA,IENS
  1.  . S DA(1)=VFIEN,DA=$P(AVAL,":",2),IENS=$$IENS^DILF(.DA)
  1.  . S VALUE=$$GET1^DIQ(9000010.431,IENS,.01,"E")
  1.  . S:VALUE]"" VALUE="  *Note Added: "_VALUE
  1.  ;
  1.  ;Problem Note Deletions
  1.  I $P(AVAL,":")=2100,$P(AVAL,":",4)="D" D  Q VALUE
  1.  . NEW NOTE,DA,IENS,VAL
  1.  . S VALUE=""
  1.  . S DA(1)=$P(AVAL,":",2),DA=$P(AVAL,":",3),IENS=$$IENS^DILF(.DA)
  1.  . S VAL=$$GET1^DIQ(9000010.431,IENS,.01,"E")
  1.  . S:VAL]"" VALUE="  *Note Deleted: "_VAL
  1.  . ;
  1.  . ;Deleted On
  1.  . S VAL=$$FMTE^BJPNPRL($$GET1^DIQ(9000010.431,IENS,2.02,"I"))
  1.  . S:VAL]"" VALUE=VALUE_$S(VALUE]"":$C(28),1:"")_"  *Note Deleted On: "_VAL
  1.  . ;
  1.  . ;Deleted By
  1.  . S VAL=$$GET1^DIQ(9000010.431,IENS,2.01,"E")
  1.  . S:VAL]"" VALUE=VALUE_$S(VALUE]"":$C(28),1:"")_"  *Note Deleted By: "_VAL
  1.  . ;
  1.  . ;Delete Code
  1.  . S VAL=$$GET1^DIQ(9000010.431,IENS,2.03,"E")
  1.  . S:VAL]"" VALUE=VALUE_$S(VALUE]"":$C(28),1:"")_"  *Note Deletion Code: "_VAL
  1.  . ;
  1.  . ;Delete Reason
  1.  . S VAL=$$GET1^DIQ(9000010.431,IENS,2.04,"E")
  1.  . S:VAL]"" VALUE=VALUE_$S(VALUE]"":$C(28),1:"")_"  *Note Deletion Reason: "_VAL
  1.  ;
  1.  Q AVAL
  1.  ;
  1. EDIT(DATA,DFN) ;EP - BJPN CAN EDIT PIP
  1.  ;
  1.  ;This RPC returns whether the PIP can be edited
  1.  ;
  1.  ;Input:
  1.  ; DFN - Patient IEN
  1.  ;
  1.  NEW UID,II,KEY,RET,X1,X2,X
  1.  ;
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BJPNPDET",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^BJPNPDET D UNWIND^%ZTER" ; SAC 2009 2.2.3.17
  1.  ;
  1.  ;Define Header
  1.  S @DATA@(II)="T00001CAN_EDIT^T00100VIEW_ONLY_REASON"_$C(30)
  1.  ;
  1.  ;Key Check
  1.  S KEY=0 D
  1.  . I $$HASKEY^CIAVCXUS("ORES",DUZ) S KEY=1 Q
  1.  . I $$HASKEY^CIAVCXUS("PROVIDER",DUZ) S KEY=1 Q
  1.  . I $$HASKEY^CIAVCXUS("ORELSE",DUZ) S KEY=1 Q
  1.  . I $$HASKEY^CIAVCXUS("BGOZ PROBLEM LIST EDIT",DUZ) S KEY=1 Q
  1.  . I $$HASKEY^CIAVCXUS("BGOZ VIEW ONLY",DUZ) S KEY=1
  1.  I KEY=0 S II=II+1,@DATA@(II)="1^USER DOES NOT HOLD THE APPROPRIATE KEY(S) TO VIEW/EDIT"_$C(30) G XEDIT
  1.  ;
  1.  ;Parameter check
  1.  I $$HASKEY^CIAVCXUS("@BJPN DISABLE PRENATAL EDITING",DUZ) D  G XEDIT
  1.  . S II=II+1,@DATA@(II)="3^USER OR USER CLASS FOUND IN BJPN DISABLE PRENATAL EDITING"_$C(30)
  1.  ;
  1.  ;BGOZ VIEW ONLY key check
  1.  I $$HASKEY^CIAVCXUS("BGOZ VIEW ONLY",DUZ) S II=II+1,@DATA@(II)="2^USER HOLDS THE BGOZ VIEW ONLY KEY"_$C(30) G XEDIT
  1.  ;
  1.  ;Definitive EDD checks
  1.  ;
  1.  S DEDD=$$DEDD(DFN)
  1.  S:DEDD="" DEDD=$$GET1^DIQ(9000017,DFN_",",1311,"I")
  1.  I DEDD="" D  G XEDIT
  1.  . S II=II+1,@DATA@(II)="4^NO CURRENT OR PAST DEFINITIVE EDD FOUND"_$C(30)
  1.  ;
  1.  ;Definitive EDD date range check
  1.  D GETPAR^CIAVMRPC(.RET,"BJPN POST DEDD DAYS","SYS",1,"I","")
  1.  ;
  1.  ;If blank default to 70
  1.  I +RET<1 S RET=70
  1.  ;
  1.  ;Check range
  1.  S X1=DEDD,X2=-280 D C^%DTC
  1.  I DEDD>0,DT<X S II=II+1,@DATA@(II)="5^TODAYS DATE IS EARLIER THAN ALLOWABLE EDIT RANGE"_$C(30) G XEDIT
  1.  S X1=DEDD,X2=RET D C^%DTC
  1.  I DEDD>0,DT>X S II=II+1,@DATA@(II)="6^TODAYS DATE IS GREATER THAN ALLOWABLE POST RANGE"_$C(30) G XEDIT
  1.  ;
  1.  S II=II+1,@DATA@(II)="0^"_$C(30)
  1.  ;
  1. XEDIT S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. DEDD(DFN) ;EP - Return Last Definitive EDD
  1.  ;
  1.  NEW PIPIEN,DEDD
  1.  ;
  1.  I $G(DFN)="" Q ""
  1.  ;
  1.  ;Loop through problems and find last DEDD
  1.  S (DEDD,PIPIEN)="" F  S PIPIEN=$O(^BJPNPL("D",DFN,PIPIEN)) Q:'PIPIEN  D  Q:DEDD
  1.  . ;
  1.  . ;Skip deletes
  1.  . I $$GET1^DIQ(90680.01,PIPIEN_",",2.01,"I")]"" Q
  1.  . ;
  1.  . ;Pull DEDD
  1.  . S DEDD=$$GET1^DIQ(90680.01,PIPIEN_",",.09,"I")
  1.  Q DEDD
  1.  ;
  1. FIREEV(DATA,TYPE,STUB,LST,AID,XUSER) ;EP - BJPN FIRE EHR EVENT
  1.  ;
  1.  ;This RPC will fire the passed event in EHR
  1.  ;
  1.  ;Input:
  1.  ; TYPE - Event Type to Broadcast (ex. PCC.<dfn>.PIP)
  1.  ; STUB - Event Stub (optional)
  1.  ; LST  - Recipient List (optional)
  1.  ; AID  - Application ID (optional)
  1.  ; XUSER - If 1, do not include user in event fire
  1.  ;
  1.  NEW UID,II,TOT
  1.  ;
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BJPNPDET",UID))
  1.  K @DATA
  1.  I $G(DT)=""!($G(U)="") D DT^DICRW
  1.  ;
  1.  S TYPE=$G(TYPE),STUB=$G(STUB),AID=$G(AID),XUSER=$G(XUSER)
  1.  ;
  1.  S II=0
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BJPNPDET D UNWIND^%ZTER" ; SAC 2009 2.2.3.17
  1.  ;
  1.  ;Define Header
  1.  S @DATA@(II)="I00100EVENTS_FIRED"_$C(30)
  1.  ;
  1.  ;Verify type
  1.  I TYPE="" S II=II+1,@DATA@(II)="0"_$C(30) G XEV
  1.  ;
  1.  ;Check if Excluding Current User
  1.  I XUSER D
  1.  . NEW SUB,Z,DZ
  1.  . D GETSUBSC^CIANBEVT(.SUB,TYPE)
  1.  . F Z=0:0 S Z=$O(@SUB@(Z)) Q:'Z  D
  1.  .. S DZ=$P($G(@SUB@(Z)),U,4)
  1.  .. K @SUB@(Z)
  1.  .. I DZ=DUZ Q
  1.  .. S:DZ]"" LST("DUZ",DZ)=""
  1.  ;
  1.  ;Return Events Fired
  1.  S TOT=$$BRDCAST^CIANBEVT(TYPE,STUB,.LST,AID)
  1.  S II=II+1,@DATA@(II)=TOT_$C(30)
  1.  ;
  1. XEV S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. AUTHORCK(DATA,PIPIEN,VIEN) ;EP - BJPN CHECK VISIT NOTE AUTHOR
  1.  ;
  1.  ;This RPC returns whether the given user is the author of all notes
  1.  ;for a problem for a visit
  1.  ;
  1.  ;Input:
  1.  ; PIPIEN - Pointer to Prenatal Problem file entry
  1.  ; VIEN - The visit IEN
  1.  ;
  1.  ;Output:
  1.  ; 1 - User is the author of all the specific problem notes for a visit
  1.  ; 0 - User is not the author of all the notes for a problem for a visit
  1.  ;
  1.  S PIPIEN=$G(PIPIEN,""),VIEN=$G(VIEN,"")
  1.  I PIPIEN="" S BMXSEC="INVALID PIP VALUE" Q
  1.  I VIEN=""  S BMXSEC="INVALID VIEN" Q
  1.  ;
  1.  NEW UID,II,DFN,CNT,RESULT
  1.  ;
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BJPNPDET",UID))
  1.  K @DATA
  1.  I $G(DT)=""!($G(U)="") D DT^DICRW
  1.  ;
  1.  ;S TMP=$NA(^TMP("BJPNPDET",UID))
  1.  ;K @TMP
  1.  ;
  1.  S II=0,RESULT=1
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BJPNPDET D UNWIND^%ZTER" ; SAC 2009 2.2.3.17
  1.  ;
  1.  ;Header
  1.  S @DATA@(II)="T00001NOTE_AUTHOR"_$C(30)
  1.  ;
  1.  ;Retrieve DFN
  1.  S DFN=$$GET1^DIQ(90680.01,PIPIEN_",",.02,"I") I DFN="" S BMXSEC="INVALID PIPIEN/DFN" Q
  1.  ;
  1.  D NOTES^BJPNPRL("",DFN,PIPIEN,1)
  1.  ;
  1.  ;Loop through and check each note for visit
  1.  S CNT=0 F  S CNT=$O(^TMP("BJPNPRL",$J,CNT)) Q:CNT=""  D
  1.  . NEW NODE,NVIEN,USER
  1.  . S NODE=^TMP("BJPNPRL",$J,CNT)
  1.  . S NVIEN=$P(NODE,U,4) I VIEN'=NVIEN Q
  1.  . S USER=$TR($P(NODE,U,10),$C(30)) I USER=DUZ Q
  1.  . S RESULT=0
  1.  S II=II+1,@DATA@(II)=RESULT_$C(30)
  1.  ;
  1.  ;Cleanup
  1.  K ^TMP("BJPNPRL",$J)
  1.  ;
  1.  S II=II+1,@DATA@(II)=$C(31)
  1.  Q
  1.  ;
  1. DVNOTES(DATA,PIPIEN,VIEN,DCODE,DRSN) ;EP - BJPN DEL PRB VST NOTES
  1.  ;
  1.  ;This RPC deletes all notes entered for a particular visit for
  1.  ;a specific prenatal problem
  1.  ;
  1.  ;Input:
  1.  ; PIPIEN - Pointer to Prenatal Problem file entry
  1.  ;   VIEN - The visit IEN
  1.  ;  DCODE - Delete Code
  1.  ;   DRSN - Delete Reason
  1.  ;
  1.  ;Output:
  1.  ; 1 - Notes deleted successfully
  1.  ; 0 - Note deletion failed
  1.  ;
  1.  S PIPIEN=$G(PIPIEN,""),VIEN=$G(VIEN,"")
  1.  I PIPIEN="" S BMXSEC="INVALID PIP VALUE" Q
  1.  I VIEN=""  S BMXSEC="INVALID VIEN" Q
  1.  S DCODE=$G(DCODE,"")
  1.  S DRSN=$G(DRSN,"")
  1.  ;
  1.  NEW UID,II,DFN,CNT,RESULT,NOTES
  1.  ;
  1.  S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
  1.  S DATA=$NA(^TMP("BJPNPDET",UID))
  1.  K @DATA
  1.  I $G(DT)=""!($G(U)="") D DT^DICRW
  1.  ;
  1.  ;S TMP=$NA(^TMP("BJPNPDET",UID))
  1.  ;K @TMP
  1.  ;
  1.  S II=0,RESULT=1
  1.  NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BJPNPDET D UNWIND^%ZTER" ; SAC 2009 2.2.3.17
  1.  ;
  1.  ;Header
  1.  S @DATA@(II)="T00001SUCCESS"_$C(30)
  1.  ;
  1.  ;Retrieve DFN
  1.  S DFN=$$GET1^DIQ(90680.01,PIPIEN_",",.02,"I") I DFN="" S BMXSEC="INVALID PIPIEN/DFN" Q
  1.  ;
  1.  D NOTES^BJPNPRL("",DFN,PIPIEN,1)
  1.  ;
  1.  ;Move to local (delete call wipes out results)
  1.  M NOTES=^TMP("BJPNPRL",$J)
  1.  ;
  1.  ;Loop through and delete each note for visit
  1.  S CNT=0 F  S CNT=$O(NOTES(CNT)) Q:CNT=""  D
  1.  . NEW NODE,NVIEN,VFIEN,VNIEN
  1.  . S NODE=NOTES(CNT)
  1.  . S NVIEN=$P(NODE,U,4) I VIEN'=NVIEN Q
  1.  . S VFIEN=$P(NODE,U,2)
  1.  . S VNIEN=$P(NODE,U,3)
  1.  . ;
  1.  . ;Delete each note
  1.  . D DEL^BJPNPUP(DATA,VIEN,VFIEN,VNIEN,DCODE,DRSN) ;BJPN DELETE PRB NOTE
  1.  ;
  1.  S II=II+1,@DATA@(II)=RESULT_$C(30)
  1.  ;
  1.  ;Cleanup
  1.  K ^TMP("BJPNPRL",$J)
  1.  ;
  1.  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