BJPNGPIP ;GDIT/HS/BEE-Prenatal Care Module Problem List ; 08 May 2012 12:00 PM
;;2.0;PRENATAL CARE MODULE;**3,7,8**;Feb 24, 2015;Build 25
;
Q
;
PIP(DATA,DFN,VIEN,PIPLST) ;EP - BJPN GET PIP
;
;This RPC returns the patient PIP (PREGNANCY ISSUES AND PROBLEMS)
;
;Input: DFN - Patient IEN
; VIEN (optional) - Visit IEN
; PIPLST (optional) - List of specific entries to return ($c(28) separated)
;
NEW UID,II,RET,BGO,TMP,B,P,T,PRBIEN,VDT,I,PC,PPLST
;
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BJPNPRL",UID))
K @DATA
I $G(DT)=""!($G(U)="") D DT^DICRW
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BJPNGPIP D UNWIND^%ZTER" ; SAC 2009 2.2.3.17
;
;Verify DFN was entered
I $G(DFN)="" G XPIP
S VIEN=$G(VIEN,"")
;
;Set up Header
S @DATA@(II)="I00010PIPIEN^I00010PRBIEN^T00012PRIORITY^T00001PIP_STATUS^T00025SCOPE"
S @DATA@(II)=@DATA@(II)_"^D00030LM_DT^T00050LM_BY^T00010IPL_STS^T00120ICD^T04096HOVER_ICD"
S @DATA@(II)=@DATA@(II)_"^T00160PROVIDER_TEXT^T00360PROVIDER_NARRATIVE^T04096LAST_GOAL"
S @DATA@(II)=@DATA@(II)_"^T04096LAST_CARE_PLAN^T04096LAST_VISIT_INSTRUCTION"
S @DATA@(II)=@DATA@(II)_"^I00010HIDE_PRV^T00035PRV^D00015DEFINITIVE_EDD^T00001POV"
S @DATA@(II)=@DATA@(II)_"^T00001INPATIENT_POV^T00001PRIMARY^T00001PATIENT_TYPE^T00001POV_DISP"
S @DATA@(II)=@DATA@(II)_"^T00030ONSET_DT^T00050LOCATION^I00010POV_IEN^T04096LAST_OB"_$C(30)
;
;Get the visit date or default to DT if visit not passed in
I $G(VIEN)]"" S VDT=$P($$GET1^DIQ(9000010,VIEN_",",".01","I"),".")
S:$G(VDT)="" VDT=DT
;
;Call EHR API and format results into usable data
D COMP^BJPNUTIL(DFN,UID,VIEN)
S TMP=$NA(^TMP("BJPNIPL",UID)) ;Define compiled data reference
;
;Assemble Specific PIP List
S PIPLST=$G(PIPLST,"") F I=1:1:$L(PIPLST,$C(28)) S PC=$P(PIPLST,$C(28),I) I PC]"" S PPLST(PC)=""
;
;Loop through problems for patient
S PRBIEN="" F S PRBIEN=$O(^BJPNPL("F",DFN,PRBIEN)) Q:PRBIEN="" D
. NEW BPIEN
. S BPIEN="" F S BPIEN=$O(^BJPNPL("F",DFN,PRBIEN,BPIEN)) Q:BPIEN="" D
.. NEW DEL,DESCID,CONCID,DESCTM,PTEXT,PNARR,BGO,API,XPRI,XSTS,XLMDT,XLMBY,IPLSTS,PRIMARY,DPOV,CDEL
.. NEW ICD,ADDICD,ICDCNT,ADICD,HICD,GGO,CGO,VGO,GOAL,CARE,INST,DEDD,POV,IPOV,ITYPE,PRV,XPRV,XSCO
.. NEW ONSET,LOC,PVIEN,TGO,CPGSTS,VOB,OB,X1,X2,X,DEDD,BRNG
.. ;
.. ;Handle specific PIP requests
.. I $D(PPLST),'$D(PPLST(BPIEN)) Q
.. ;
.. ;Skip deletes
.. S DEL=$$GET1^DIQ(90680.01,BPIEN_",",2.01,"I") Q:DEL]"" ;PIP Delete
.. S DEL=$$GET1^DIQ(9000011,PRBIEN_",",2.02,"I") I DEL]"" D Q ;IPL Delete
... ;
... ;If deleted on IPL, need to delete in PIP
... NEW BJPNUPD,ERROR
... S BJPNUPD(90680.01,BPIEN_",",2.01)=$$GET1^DIQ(9000011,PRBIEN_",",2.01,"I") ;Deleted By
... S BJPNUPD(90680.01,BPIEN_",",2.02)=$$GET1^DIQ(9000011,PRBIEN_",",2.02,"I") ;Del Dt/Tm
... S BJPNUPD(90680.01,BPIEN_",",2.03)=$$GET1^DIQ(9000011,PRBIEN_",",2.03,"I") ;Del Rsn
... S BJPNUPD(90680.01,BPIEN_",",2.04)=$$GET1^DIQ(9000011,PRBIEN_",",2.04,"I") ;Del Other
... D FILE^DIE("","BJPNUPD","ERROR")
.. ;
.. ;Retrieve the entry from the API results
.. S BGO=$O(@TMP@("P",PRBIEN,"")) Q:BGO="" ;Quit if no IPL entry
.. S API=$G(@TMP@("P",PRBIEN,BGO)) Q:API=""
.. ;
.. ;SNOMED DescId and ConcId
.. S DESCID=$P(API,U,4)
.. S:DESCID="" DESCID=$$GET1^DIQ(9000011,PRBIEN_",",80002,"I") Q:DESCID=""
.. S DESCTM=$P($$DESC^BSTSAPI(DESCID_"^^1"),U,2) Q:DESCTM=""
.. S CONCID=$P(API,U,3)
.. S:CONCID="" CONCID=$$GET1^DIQ(9000011,PRBIEN_",",80001,"I") Q:CONCID=""
.. ;
.. ;PIP Priority
.. S XPRI=$$GET1^DIQ(90680.01,BPIEN_",",.06,"E")
.. ;
.. ;Status
.. S XSTS=$$GET1^DIQ(90680.01,BPIEN_",",.08,"E")
.. ;
.. ;Scope
.. S XSCO=$$GET1^DIQ(90680.01,BPIEN_",",.07,"E")
.. ;
.. ;Last Modified Date
.. S XLMDT=$$FMTE^BJPNPRL($$GET1^DIQ(9000011,PRBIEN_",",.03,"I"))
.. ;
.. ;Last Modified By
.. S XLMBY=$$GET1^DIQ(9000011,PRBIEN_",",.14,"E")
.. ;
.. ;Get Window Start
.. S DEDD=$$GET1^DIQ(90680.01,BPIEN_",",.09,"I")
.. S X1=DEDD,X2=-280 D C^%DTC S BRNG=X
.. ;
.. ;IPL Status - Convert manually lower case can be displayed
.. S IPLSTS=$P(API,U,6)
.. S:IPLSTS="" IPLSTS=$$GET1^DIQ(9000011,PRBIEN_",",.12,"E")
.. S IPLSTS=$S(IPLSTS="CHRONIC":"Chronic",IPLSTS="INACTIVE":"Inactive",IPLSTS="D":"DELETED",IPLSTS="SUB-ACUTE":"Sub-acute",IPLSTS="EPISODIC":"Episodic",IPLSTS="SOCIAL":"Social/Environmental",IPLSTS="ROUTINE/ADMIN":"Routine/Admin",1:"")
.. ;
.. ;Handle Personal Hx
.. I $$GET1^DIQ(9000011,PRBIEN_",",.04,"I")="P" S IPLSTS="Personal Hx"
.. ;
.. ;ICD Information - Pull primary and additional ICD values
.. S ICD=$P(API,U,9)
.. S ADDICD=$P(API,U,13)
.. I ADDICD]"" F ICDCNT=1:1:$L(ADDICD,"|") S ADICD=$P(ADDICD,"|",ICDCNT) I ADICD]"" S ICD=ICD_$S(ICD]"":"|",1:"")_ADICD
.. ;
.. ;ICD Hover field
.. D
... NEW ADV,STS
... ;
... ;Only return if in ICD10
... I '$$ICD10^BSTSUTIL(DT) S HICD="No ICD9 mapping advice available" Q
... ;
... ;Get the mapping advice
... S STS=$$I10ADV^BSTSAPI("ADV",CONCID_"^1")
... S (HICD,ADV)="" F S ADV=$O(ADV(ADV)) Q:ADV="" S HICD=HICD_$S($L(HICD)]"":$C(13)_$C(10),1:"")_ADV(ADV)
... S:HICD HICD="No ICD10 mapping advice available"
.. ;
.. ;Location
.. S LOC=$$GET1^DIQ(9000011,PRBIEN_",",.06,"I")
.. ;
.. ;Onset Date
.. S ONSET=$$GET1^DIQ(9000011,PRBIEN_",",.13,"I")
.. I ONSET]"" D
... I $E(ONSET,4,7)="0000" S ONSET="20"_$E(ONSET,2,3) Q ;Year only
... I $E(ONSET,6,7)="00" S ONSET=+$E(ONSET,4,5)_"/20"_$E(ONSET,2,3) Q ;Month/Year
... S ONSET=$$FMTE^BJPNPRL(ONSET,"5D")
.. ;
.. ;Provider Text
.. S PNARR=$P(API,U,8)
.. S PTEXT=$P(PNARR," | ",2)
.. ;
.. ;Reset Can Delete flag
.. S CDEL="Y"
.. ;
.. ;Get latest Goal note
.. S GOAL=""
.. S GGO="" F S GGO=$O(@TMP@("G",PRBIEN,GGO)) Q:GGO="" D Q:GOAL]""
... ;
... ;Skip inactive goals but mark as cannot delete
... S CPGSTS=$P($G(@TMP@("G",PRBIEN,GGO,0)),U,6)
... I CPGSTS="I" S CDEL="" Q
... ;
... ;Only include active
... I CPGSTS'="A" Q
... ;
... NEW NIEN,ND,BY,WHEN
... S ND=$G(@TMP@("G",PRBIEN,GGO,0))
... S BY=$P(ND,U,4) ;BY
... S WHEN=$P($P(ND,U,5)," ") ;WHEN
... S NIEN=0 F S NIEN=$O(@TMP@("G",PRBIEN,GGO,NIEN)) Q:NIEN="" D
.... NEW NNT,L
.... S NNT=$P($G(@TMP@("G",PRBIEN,GGO,NIEN)),U,2)
.... S L=$E(GOAL,$L(GOAL))
.... S GOAL=GOAL_$S(GOAL]"":$C(13)_$C(10),1:"")_NNT
... I GOAL]"",BY]"" S GOAL=GOAL_$C(13)_$C(10)_"Modified by: "_BY_" "_WHEN
... S CDEL=""
.. ;
.. ;Get latest Care Plan note
.. S CARE=""
.. S CGO="" F S CGO=$O(@TMP@("C",PRBIEN,CGO)) Q:CGO="" D Q:CARE]""
... ;
... ;Skip inactive care plans but mark as cannot delete
... S CPGSTS=$P($G(@TMP@("C",PRBIEN,CGO,0)),U,6)
... I CPGSTS="I" S CDEL="" Q
... ;
... ;Only include active
... I CPGSTS'="A" Q
... ;
... NEW NIEN,ND,BY,WHEN
... S ND=$G(@TMP@("C",PRBIEN,CGO,0))
... S BY=$P(ND,U,4) ;BY
... S WHEN=$P($P(ND,U,5)," ") ;WHEN
... S NIEN=0 F S NIEN=$O(@TMP@("C",PRBIEN,CGO,NIEN)) Q:NIEN="" D
.... NEW NNT,L,BY
.... S ND=$G(@TMP@("C",PRBIEN,CGO,0))
.... S NNT=$P($G(@TMP@("C",PRBIEN,CGO,NIEN)),U,2)
.... S L=$E(CARE,$L(CARE))
.... S CARE=CARE_$S(CARE]"":$C(13)_$C(10),1:"")_NNT
... I CARE]"",BY]"" S CARE=CARE_$C(13)_$C(10)_"Modified by: "_BY_" "_WHEN
... S CDEL=""
.. ;
.. ;Get latest V Visit Instruction
.. S VGO=$O(@TMP@("I",PRBIEN,""))
.. S INST="" I VGO]"" S INST=$$LVI^BJPNGNOT(PRBIEN,TMP,VGO,BRNG,.CDEL)
.. ;
.. ;Get latest V OB Note
.. S VOB=$O(@TMP@("O",PRBIEN,""))
.. S OB="" I VOB]"" S OB=$$LOB^BJPNGNOT(PRBIEN,TMP,VOB,BRNG,.CDEL)
.. ;
.. ;Treatment Regimen
.. S TGO=$O(@TMP@("T",PRBIEN,"")) I TGO]"" S CDEL=""
.. ;
.. ;Visit POV
.. S (IPOV,POV,ITYPE,DPOV)="" I VIEN]"" D
... S ITYPE=$$GET1^DIQ(9000010,VIEN_",",.07,"I") Q:ITYPE=""
... S ITYPE=$S(ITYPE="H":"H",1:"A")
... I $O(^AUPNPROB(PRBIEN,14,"B",VIEN,"")) S POV="Y"
... I $O(^AUPNPROB(PRBIEN,15,"B",VIEN,"")) S IPOV="Y"
.. I (POV="Y")!(IPOV="Y") S DPOV="Y"
.. ;
.. ;Ever a POV - needed for deleting permission
.. I $O(^AUPNPROB(PRBIEN,14,"B",""))]"" S CDEL=""
.. I $O(^AUPNPROB(PRBIEN,15,"B",""))]"" S CDEL=""
.. ;
.. ;Get Primary/Secondary value
.. S PRIMARY=$P(API,U,20)
.. ;
.. ;Get the V POV IEN
.. S PVIEN=$P(API,U,21)
.. ;
.. ;Definitive EDD
.. S DEDD=$$FMTE^BJPNPRL($$GET1^DIQ(90680.01,BPIEN_",",.09,"I"))
.. ;
.. ;PRV fields
.. S (PRV,XPRV)=""
.. S PRV=$$PPRV^BJPNPKL(VIEN)
.. S:PRV]"" XPRV=$$GET1^DIQ(200,PRV_",",.01,"E")
.. ;
.. ;Set up entry
.. S II=II+1,@DATA@(II)=BPIEN_U_PRBIEN_U_XPRI_U_XSTS_U_XSCO_U_XLMDT_U_XLMBY_U_IPLSTS
.. S @DATA@(II)=@DATA@(II)_U_ICD_U_HICD_U_PTEXT_U_PNARR_U_GOAL_U_CARE_U_INST_U_PRV_U_XPRV
.. S @DATA@(II)=@DATA@(II)_U_DEDD_U_POV_U_IPOV_U_PRIMARY_U_ITYPE_U_DPOV
.. S @DATA@(II)=@DATA@(II)_U_ONSET_U_LOC_U_PVIEN_U_OB_$C(30)
;
XPIP S II=II+1,@DATA@(II)=$C(31)
Q
;
NOTES(DATA,DFN,PRBIEN,ITYPE,VIEN) ;EP - BJPN GET PR NOTES
;
;Get BJPN CARE PLANS, GOALS, VISIT INSTRUCTIONS
;
;This RPC returns the CVGT information for one problem - it is used on the
;PIP add/edit screen to populate the bottom CVGT section
;
;Input: DFN - Patient IEN
; PRBIEN - Problem IEN
; ITYPE - (C) Care Plans, (G) Goals, (I) Visit Instructions, (T) Treatment Plan/Education
; VIEN - If passed in, limit visit instructions and treatment reg returned to that visit
;
S DFN=$G(DFN),PRBIEN=$G(PRBIEN),ITYPE=$G(ITYPE),VIEN=$G(VIEN)
I ITYPE="" S BMXSEC="Null/Invalid TYPE value" Q
;
NEW UID,II,SORT,PC,PARY,NEDT,TMP,SIGN,CNT,MDT,BGO,DEL,TYPE,TPC
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BJPNGPIP",UID))
K @DATA
I $G(DT)=""!($G(U)="") D DT^DICRW
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BJPNGPIP D UNWIND^%ZTER" ; SAC 2009 2.2.3.17
;
S @DATA@(II)="T00001TYPE^I00010PRBIEN^I00010GCIIEN^I00010VIEN^D00030VISIT_DT^T00001NOTE_STATUS"
S @DATA@(II)=@DATA@(II)_"^D00030LAST_MODIFIED^T00050MODIFIED_BY^T00160NOTE^I00010HIDE_DUZ^T00001SIGNED"_$C(30)
;
;For treatment request, include education as well
I ITYPE["T",ITYPE'["E" S ITYPE=ITYPE_"~E"
;
;Verify DFN
I DFN="" G XNOTES
;
;Definitive EDD date range check
D GETPAR^CIAVMRPC(.NEDT,"BJPN POST DEDD DAYS","SYS",1,"I","")
;
;If blank default to 70
I +$G(NEDT)<1 S NEDT=70
;
;Call EHR API and format results into usable data
S TMP=$NA(^TMP("BJPNIPL",UID)) ;Define compiled data reference
D COMP^BJPNUTIL(DFN,UID)
;
;Skip deletes
S DEL=$$GET1^DIQ(9000011,PRBIEN_",",2.02,"I") I DEL]"" Q ;IPL Delete
;
S CNT=0
;
;Loop through compiled results for type
F TPC=1:1:$L(ITYPE,"~") S TYPE=$P(ITYPE,"~",TPC) I TYPE]"" S BGO="" F S BGO=$O(@TMP@(TYPE,PRBIEN,BGO),-1) Q:BGO="" D
. ;
. NEW APIRES,VISIT,DEDD,BRNG,ERNG,NIEN,X1,X2,X,VDT
. NEW DTTM,MDBY,ILMBY,NOTE,NSTS,SIGN
. ;
. S SIGN=""
. S APIRES=$G(@TMP@(TYPE,PRBIEN,BGO,0)) Q:APIRES=""
. ;
. ;Pull Visit - If V VISIT INSTRUCTIONS (GOALS and CARE PLANS are not visit driven)
. S (VISIT,VDT)=""
. I (TYPE="I")!(TYPE="O") S VISIT=$P(APIRES,U,9),VDT=$P(APIRES,U,4)
. S:TYPE="T" VISIT=$P(APIRES,U,10),VDT=$P(APIRES,U,5)
. I TYPE="E" D
.. NEW VEDIEN
.. S VEDIEN=$P(APIRES,U,6) Q:VEDIEN=""
.. S VISIT=$$GET1^DIQ(9000010.16,VEDIEN_",",.03,"I")
.. S VDT=$$GET1^DIQ(9000010,VISIT,.01,"I")
. ;
. ;Filter on visit
. I ((TYPE="I")!(TYPE="T")!(TYPE="E"))!((TYPE="O")),VIEN]"",VIEN'=VISIT Q
. ;
. ;Skip Inactive Goals/Care Plans
. I ((TYPE="G")!(TYPE="C")),$P(APIRES,U,6)'="A" Q
. ;
. ;Note IEN (Pointer to entry)
. I TYPE'="E" S NIEN=$P(APIRES,U,2)
. E S NIEN=$P(APIRES,U,6)
. Q:NIEN=""
. ;
. ;Pull Definitive EDD
. S DEDD=$$GET1^DIQ(9000017,DFN_",",1311,"I")
. S X1=DEDD,X2=-280 D C^%DTC S BRNG=X
. S X1=DEDD,X2=NEDT D C^%DTC S ERNG=X
. ;
. ;Get note date/time entered and by - V VISIT INSTRUCTIONS/V OB
. S (DTTM,ILMBY)=""
. I TYPE="I" D
.. S DTTM=$$GET1^DIQ(9000010.58,NIEN_",",1216,"I")
.. S ILMBY=$$GET1^DIQ(9000010.58,NIEN_",",1217,"I")
.. S SIGN=$P(APIRES,U,13)
. I TYPE="O" D
.. S DTTM=$$GET1^DIQ(9000010.43,NIEN_",",1216,"I")
.. S ILMBY=$$GET1^DIQ(9000010.43,NIEN_",",1217,"I")
.. S SIGN=$P(APIRES,U,13)
. ;
. ;Get note date/time entered and by - CARE PLAN
. I TYPE'="I",TYPE'="T",TYPE'="E",TYPE'="O" D
.. NEW IENS,DA
.. S DA=$O(^AUPNCPL(NIEN,11,"B","A",""),-1) Q:DA=""
.. S DA(1)=NIEN,IENS=$$IENS^DILF(.DA)
.. S DTTM=$$GET1^DIQ(9000092.11,IENS,".03","I")
.. S ILMBY=$$GET1^DIQ(9000092.11,IENS,".02","I")
.. S SIGN=$P(APIRES,U,7)
. ;
. ;Get treatment plan date/time and by - V TREATMENT/REGIMEN
. I TYPE="T" D
.. S DTTM=$$GET1^DIQ(9000010.61,NIEN_",",1216,"I")
.. S ILMBY=$$GET1^DIQ(9000010.61,NIEN_",",1217,"I")
. ;
. ;Get education plan date/time and by - V PATIENT ED
. I TYPE="E" D
.. S DTTM=$$GET1^DIQ(9000010.16,NIEN_",",1216,"I")
.. S ILMBY=$$GET1^DIQ(9000010.16,NIEN_",",1217,"I")
. ;
. Q:DTTM=""
. S MDBY=$$GET1^DIQ(200,ILMBY_",",".01","E")
. ;
. ;Get Note
. I TYPE="T" S NOTE=$P($G(@TMP@(TYPE,PRBIEN,BGO,0)),U,14)
. E I TYPE="E" S NOTE=$P(APIRES,U,2)
. E D
.. S NOTE=""
.. NEW NIEN
.. S NIEN=0 F S NIEN=$O(@TMP@(TYPE,PRBIEN,BGO,NIEN)) Q:NIEN="" D
... NEW NNT,L
... S NNT=$P($G(@TMP@(TYPE,PRBIEN,BGO,NIEN)),U,2)
... S L=$E(NOTE,$L(NOTE))
... S NOTE=NOTE_$S(NOTE]"":$C(13)_$C(10),1:"")_NNT
. Q:NOTE=""
. ;
. ;Note Status
. S NSTS="A"
. I DEDD]"",DTTM'<BRNG,DTTM'>ERNG S NSTS="C"
. ;
. ;Determined signed/unsigned
. S SIGN=$S(TYPE="T":"",SIGN]"":"S",1:"U")
. ;
. ;Set up record
. S CNT=CNT+1,SORT(DTTM,CNT)=$S(TYPE="E":"T",1:TYPE)_U_PRBIEN_U_NIEN_U_VISIT_U_VDT_U_NSTS_U_$$FMTE^BJPNPRL(DTTM)_U_MDBY_U_NOTE_U_ILMBY_U_SIGN
;
;Sort - Most recent first
S DTTM="" F S DTTM=$O(SORT(DTTM),-1) Q:DTTM="" D
. S CNT="" F S CNT=$O(SORT(DTTM,CNT),-1) Q:CNT="" D
.. S II=II+1,@DATA@(II)=SORT(DTTM,CNT)_$C(30)
;
XNOTES S II=II+1,@DATA@(II)=$C(31)
Q
;
ERR ;
D ^%ZTER
NEW Y,ERRDTM
S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
S II=II+1,@DATA@(II)=$C(31)
Q
BJPNGPIP ;GDIT/HS/BEE-Prenatal Care Module Problem List ; 08 May 2012 12:00 PM
+1 ;;2.0;PRENATAL CARE MODULE;**3,7,8**;Feb 24, 2015;Build 25
+2 ;
+3 QUIT
+4 ;
PIP(DATA,DFN,VIEN,PIPLST) ;EP - BJPN GET PIP
+1 ;
+2 ;This RPC returns the patient PIP (PREGNANCY ISSUES AND PROBLEMS)
+3 ;
+4 ;Input: DFN - Patient IEN
+5 ; VIEN (optional) - Visit IEN
+6 ; PIPLST (optional) - List of specific entries to return ($c(28) separated)
+7 ;
+8 NEW UID,II,RET,BGO,TMP,B,P,T,PRBIEN,VDT,I,PC,PPLST
+9 ;
+10 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+11 SET DATA=$NAME(^TMP("BJPNPRL",UID))
+12 KILL @DATA
+13 IF $GET(DT)=""!($GET(U)="")
DO DT^DICRW
+14 ;
+15 SET II=0
+16 ; SAC 2009 2.2.3.17
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BJPNGPIP D UNWIND^%ZTER"
+17 ;
+18 ;Verify DFN was entered
+19 IF $GET(DFN)=""
GOTO XPIP
+20 SET VIEN=$GET(VIEN,"")
+21 ;
+22 ;Set up Header
+23 SET @DATA@(II)="I00010PIPIEN^I00010PRBIEN^T00012PRIORITY^T00001PIP_STATUS^T00025SCOPE"
+24 SET @DATA@(II)=@DATA@(II)_"^D00030LM_DT^T00050LM_BY^T00010IPL_STS^T00120ICD^T04096HOVER_ICD"
+25 SET @DATA@(II)=@DATA@(II)_"^T00160PROVIDER_TEXT^T00360PROVIDER_NARRATIVE^T04096LAST_GOAL"
+26 SET @DATA@(II)=@DATA@(II)_"^T04096LAST_CARE_PLAN^T04096LAST_VISIT_INSTRUCTION"
+27 SET @DATA@(II)=@DATA@(II)_"^I00010HIDE_PRV^T00035PRV^D00015DEFINITIVE_EDD^T00001POV"
+28 SET @DATA@(II)=@DATA@(II)_"^T00001INPATIENT_POV^T00001PRIMARY^T00001PATIENT_TYPE^T00001POV_DISP"
+29 SET @DATA@(II)=@DATA@(II)_"^T00030ONSET_DT^T00050LOCATION^I00010POV_IEN^T04096LAST_OB"_$CHAR(30)
+30 ;
+31 ;Get the visit date or default to DT if visit not passed in
+32 IF $GET(VIEN)]""
SET VDT=$PIECE($$GET1^DIQ(9000010,VIEN_",",".01","I"),".")
+33 IF $GET(VDT)=""
SET VDT=DT
+34 ;
+35 ;Call EHR API and format results into usable data
+36 DO COMP^BJPNUTIL(DFN,UID,VIEN)
+37 ;Define compiled data reference
SET TMP=$NAME(^TMP("BJPNIPL",UID))
+38 ;
+39 ;Assemble Specific PIP List
+40 SET PIPLST=$GET(PIPLST,"")
FOR I=1:1:$LENGTH(PIPLST,$CHAR(28))
SET PC=$PIECE(PIPLST,$CHAR(28),I)
IF PC]""
SET PPLST(PC)=""
+41 ;
+42 ;Loop through problems for patient
+43 SET PRBIEN=""
FOR
SET PRBIEN=$ORDER(^BJPNPL("F",DFN,PRBIEN))
IF PRBIEN=""
QUIT
Begin DoDot:1
+44 NEW BPIEN
+45 SET BPIEN=""
FOR
SET BPIEN=$ORDER(^BJPNPL("F",DFN,PRBIEN,BPIEN))
IF BPIEN=""
QUIT
Begin DoDot:2
+46 NEW DEL,DESCID,CONCID,DESCTM,PTEXT,PNARR,BGO,API,XPRI,XSTS,XLMDT,XLMBY,IPLSTS,PRIMARY,DPOV,CDEL
+47 NEW ICD,ADDICD,ICDCNT,ADICD,HICD,GGO,CGO,VGO,GOAL,CARE,INST,DEDD,POV,IPOV,ITYPE,PRV,XPRV,XSCO
+48 NEW ONSET,LOC,PVIEN,TGO,CPGSTS,VOB,OB,X1,X2,X,DEDD,BRNG
+49 ;
+50 ;Handle specific PIP requests
+51 IF $DATA(PPLST)
IF '$DATA(PPLST(BPIEN))
QUIT
+52 ;
+53 ;Skip deletes
+54 ;PIP Delete
SET DEL=$$GET1^DIQ(90680.01,BPIEN_",",2.01,"I")
IF DEL]""
QUIT
+55 ;IPL Delete
SET DEL=$$GET1^DIQ(9000011,PRBIEN_",",2.02,"I")
IF DEL]""
Begin DoDot:3
+56 ;
+57 ;If deleted on IPL, need to delete in PIP
+58 NEW BJPNUPD,ERROR
+59 ;Deleted By
SET BJPNUPD(90680.01,BPIEN_",",2.01)=$$GET1^DIQ(9000011,PRBIEN_",",2.01,"I")
+60 ;Del Dt/Tm
SET BJPNUPD(90680.01,BPIEN_",",2.02)=$$GET1^DIQ(9000011,PRBIEN_",",2.02,"I")
+61 ;Del Rsn
SET BJPNUPD(90680.01,BPIEN_",",2.03)=$$GET1^DIQ(9000011,PRBIEN_",",2.03,"I")
+62 ;Del Other
SET BJPNUPD(90680.01,BPIEN_",",2.04)=$$GET1^DIQ(9000011,PRBIEN_",",2.04,"I")
+63 DO FILE^DIE("","BJPNUPD","ERROR")
End DoDot:3
QUIT
+64 ;
+65 ;Retrieve the entry from the API results
+66 ;Quit if no IPL entry
SET BGO=$ORDER(@TMP@("P",PRBIEN,""))
IF BGO=""
QUIT
+67 SET API=$GET(@TMP@("P",PRBIEN,BGO))
IF API=""
QUIT
+68 ;
+69 ;SNOMED DescId and ConcId
+70 SET DESCID=$PIECE(API,U,4)
+71 IF DESCID=""
SET DESCID=$$GET1^DIQ(9000011,PRBIEN_",",80002,"I")
IF DESCID=""
QUIT
+72 SET DESCTM=$PIECE($$DESC^BSTSAPI(DESCID_"^^1"),U,2)
IF DESCTM=""
QUIT
+73 SET CONCID=$PIECE(API,U,3)
+74 IF CONCID=""
SET CONCID=$$GET1^DIQ(9000011,PRBIEN_",",80001,"I")
IF CONCID=""
QUIT
+75 ;
+76 ;PIP Priority
+77 SET XPRI=$$GET1^DIQ(90680.01,BPIEN_",",.06,"E")
+78 ;
+79 ;Status
+80 SET XSTS=$$GET1^DIQ(90680.01,BPIEN_",",.08,"E")
+81 ;
+82 ;Scope
+83 SET XSCO=$$GET1^DIQ(90680.01,BPIEN_",",.07,"E")
+84 ;
+85 ;Last Modified Date
+86 SET XLMDT=$$FMTE^BJPNPRL($$GET1^DIQ(9000011,PRBIEN_",",.03,"I"))
+87 ;
+88 ;Last Modified By
+89 SET XLMBY=$$GET1^DIQ(9000011,PRBIEN_",",.14,"E")
+90 ;
+91 ;Get Window Start
+92 SET DEDD=$$GET1^DIQ(90680.01,BPIEN_",",.09,"I")
+93 SET X1=DEDD
SET X2=-280
DO C^%DTC
SET BRNG=X
+94 ;
+95 ;IPL Status - Convert manually lower case can be displayed
+96 SET IPLSTS=$PIECE(API,U,6)
+97 IF IPLSTS=""
SET IPLSTS=$$GET1^DIQ(9000011,PRBIEN_",",.12,"E")
+98 SET IPLSTS=$SELECT(IPLSTS="CHRONIC":"Chronic",IPLSTS="INACTIVE":"Inactive",IPLSTS="D":"DELETED",IPLSTS="SUB-ACUTE":"Sub-acute",IPLSTS="EPISODIC":"Episodic",IPLSTS="SOCIAL":"Social/Environmental",IPLSTS="ROUTINE/ADMIN":"Routine/A
dmin",1:"")
+99 ;
+100 ;Handle Personal Hx
+101 IF $$GET1^DIQ(9000011,PRBIEN_",",.04,"I")="P"
SET IPLSTS="Personal Hx"
+102 ;
+103 ;ICD Information - Pull primary and additional ICD values
+104 SET ICD=$PIECE(API,U,9)
+105 SET ADDICD=$PIECE(API,U,13)
+106 IF ADDICD]""
FOR ICDCNT=1:1:$LENGTH(ADDICD,"|")
SET ADICD=$PIECE(ADDICD,"|",ICDCNT)
IF ADICD]""
SET ICD=ICD_$SELECT(ICD]"":"|",1:"")_ADICD
+107 ;
+108 ;ICD Hover field
+109 Begin DoDot:3
+110 NEW ADV,STS
+111 ;
+112 ;Only return if in ICD10
+113 IF '$$ICD10^BSTSUTIL(DT)
SET HICD="No ICD9 mapping advice available"
QUIT
+114 ;
+115 ;Get the mapping advice
+116 SET STS=$$I10ADV^BSTSAPI("ADV",CONCID_"^1")
+117 SET (HICD,ADV)=""
FOR
SET ADV=$ORDER(ADV(ADV))
IF ADV=""
QUIT
SET HICD=HICD_$SELECT($LENGTH(HICD)]"":$CHAR(13)_$CHAR(10),1:"")_ADV(ADV)
+118 IF HICD
SET HICD="No ICD10 mapping advice available"
End DoDot:3
+119 ;
+120 ;Location
+121 SET LOC=$$GET1^DIQ(9000011,PRBIEN_",",.06,"I")
+122 ;
+123 ;Onset Date
+124 SET ONSET=$$GET1^DIQ(9000011,PRBIEN_",",.13,"I")
+125 IF ONSET]""
Begin DoDot:3
+126 ;Year only
IF $EXTRACT(ONSET,4,7)="0000"
SET ONSET="20"_$EXTRACT(ONSET,2,3)
QUIT
+127 ;Month/Year
IF $EXTRACT(ONSET,6,7)="00"
SET ONSET=+$EXTRACT(ONSET,4,5)_"/20"_$EXTRACT(ONSET,2,3)
QUIT
+128 SET ONSET=$$FMTE^BJPNPRL(ONSET,"5D")
End DoDot:3
+129 ;
+130 ;Provider Text
+131 SET PNARR=$PIECE(API,U,8)
+132 SET PTEXT=$PIECE(PNARR," | ",2)
+133 ;
+134 ;Reset Can Delete flag
+135 SET CDEL="Y"
+136 ;
+137 ;Get latest Goal note
+138 SET GOAL=""
+139 SET GGO=""
FOR
SET GGO=$ORDER(@TMP@("G",PRBIEN,GGO))
IF GGO=""
QUIT
Begin DoDot:3
+140 ;
+141 ;Skip inactive goals but mark as cannot delete
+142 SET CPGSTS=$PIECE($GET(@TMP@("G",PRBIEN,GGO,0)),U,6)
+143 IF CPGSTS="I"
SET CDEL=""
QUIT
+144 ;
+145 ;Only include active
+146 IF CPGSTS'="A"
QUIT
+147 ;
+148 NEW NIEN,ND,BY,WHEN
+149 SET ND=$GET(@TMP@("G",PRBIEN,GGO,0))
+150 ;BY
SET BY=$PIECE(ND,U,4)
+151 ;WHEN
SET WHEN=$PIECE($PIECE(ND,U,5)," ")
+152 SET NIEN=0
FOR
SET NIEN=$ORDER(@TMP@("G",PRBIEN,GGO,NIEN))
IF NIEN=""
QUIT
Begin DoDot:4
+153 NEW NNT,L
+154 SET NNT=$PIECE($GET(@TMP@("G",PRBIEN,GGO,NIEN)),U,2)
+155 SET L=$EXTRACT(GOAL,$LENGTH(GOAL))
+156 SET GOAL=GOAL_$SELECT(GOAL]"":$CHAR(13)_$CHAR(10),1:"")_NNT
End DoDot:4
+157 IF GOAL]""
IF BY]""
SET GOAL=GOAL_$CHAR(13)_$CHAR(10)_"Modified by: "_BY_" "_WHEN
+158 SET CDEL=""
End DoDot:3
IF GOAL]""
QUIT
+159 ;
+160 ;Get latest Care Plan note
+161 SET CARE=""
+162 SET CGO=""
FOR
SET CGO=$ORDER(@TMP@("C",PRBIEN,CGO))
IF CGO=""
QUIT
Begin DoDot:3
+163 ;
+164 ;Skip inactive care plans but mark as cannot delete
+165 SET CPGSTS=$PIECE($GET(@TMP@("C",PRBIEN,CGO,0)),U,6)
+166 IF CPGSTS="I"
SET CDEL=""
QUIT
+167 ;
+168 ;Only include active
+169 IF CPGSTS'="A"
QUIT
+170 ;
+171 NEW NIEN,ND,BY,WHEN
+172 SET ND=$GET(@TMP@("C",PRBIEN,CGO,0))
+173 ;BY
SET BY=$PIECE(ND,U,4)
+174 ;WHEN
SET WHEN=$PIECE($PIECE(ND,U,5)," ")
+175 SET NIEN=0
FOR
SET NIEN=$ORDER(@TMP@("C",PRBIEN,CGO,NIEN))
IF NIEN=""
QUIT
Begin DoDot:4
+176 NEW NNT,L,BY
+177 SET ND=$GET(@TMP@("C",PRBIEN,CGO,0))
+178 SET NNT=$PIECE($GET(@TMP@("C",PRBIEN,CGO,NIEN)),U,2)
+179 SET L=$EXTRACT(CARE,$LENGTH(CARE))
+180 SET CARE=CARE_$SELECT(CARE]"":$CHAR(13)_$CHAR(10),1:"")_NNT
End DoDot:4
+181 IF CARE]""
IF BY]""
SET CARE=CARE_$CHAR(13)_$CHAR(10)_"Modified by: "_BY_" "_WHEN
+182 SET CDEL=""
End DoDot:3
IF CARE]""
QUIT
+183 ;
+184 ;Get latest V Visit Instruction
+185 SET VGO=$ORDER(@TMP@("I",PRBIEN,""))
+186 SET INST=""
IF VGO]""
SET INST=$$LVI^BJPNGNOT(PRBIEN,TMP,VGO,BRNG,.CDEL)
+187 ;
+188 ;Get latest V OB Note
+189 SET VOB=$ORDER(@TMP@("O",PRBIEN,""))
+190 SET OB=""
IF VOB]""
SET OB=$$LOB^BJPNGNOT(PRBIEN,TMP,VOB,BRNG,.CDEL)
+191 ;
+192 ;Treatment Regimen
+193 SET TGO=$ORDER(@TMP@("T",PRBIEN,""))
IF TGO]""
SET CDEL=""
+194 ;
+195 ;Visit POV
+196 SET (IPOV,POV,ITYPE,DPOV)=""
IF VIEN]""
Begin DoDot:3
+197 SET ITYPE=$$GET1^DIQ(9000010,VIEN_",",.07,"I")
IF ITYPE=""
QUIT
+198 SET ITYPE=$SELECT(ITYPE="H":"H",1:"A")
+199 IF $ORDER(^AUPNPROB(PRBIEN,14,"B",VIEN,""))
SET POV="Y"
+200 IF $ORDER(^AUPNPROB(PRBIEN,15,"B",VIEN,""))
SET IPOV="Y"
End DoDot:3
+201 IF (POV="Y")!(IPOV="Y")
SET DPOV="Y"
+202 ;
+203 ;Ever a POV - needed for deleting permission
+204 IF $ORDER(^AUPNPROB(PRBIEN,14,"B",""))]""
SET CDEL=""
+205 IF $ORDER(^AUPNPROB(PRBIEN,15,"B",""))]""
SET CDEL=""
+206 ;
+207 ;Get Primary/Secondary value
+208 SET PRIMARY=$PIECE(API,U,20)
+209 ;
+210 ;Get the V POV IEN
+211 SET PVIEN=$PIECE(API,U,21)
+212 ;
+213 ;Definitive EDD
+214 SET DEDD=$$FMTE^BJPNPRL($$GET1^DIQ(90680.01,BPIEN_",",.09,"I"))
+215 ;
+216 ;PRV fields
+217 SET (PRV,XPRV)=""
+218 SET PRV=$$PPRV^BJPNPKL(VIEN)
+219 IF PRV]""
SET XPRV=$$GET1^DIQ(200,PRV_",",.01,"E")
+220 ;
+221 ;Set up entry
+222 SET II=II+1
SET @DATA@(II)=BPIEN_U_PRBIEN_U_XPRI_U_XSTS_U_XSCO_U_XLMDT_U_XLMBY_U_IPLSTS
+223 SET @DATA@(II)=@DATA@(II)_U_ICD_U_HICD_U_PTEXT_U_PNARR_U_GOAL_U_CARE_U_INST_U_PRV_U_XPRV
+224 SET @DATA@(II)=@DATA@(II)_U_DEDD_U_POV_U_IPOV_U_PRIMARY_U_ITYPE_U_DPOV
+225 SET @DATA@(II)=@DATA@(II)_U_ONSET_U_LOC_U_PVIEN_U_OB_$CHAR(30)
End DoDot:2
End DoDot:1
+226 ;
XPIP SET II=II+1
SET @DATA@(II)=$CHAR(31)
+1 QUIT
+2 ;
NOTES(DATA,DFN,PRBIEN,ITYPE,VIEN) ;EP - BJPN GET PR NOTES
+1 ;
+2 ;Get BJPN CARE PLANS, GOALS, VISIT INSTRUCTIONS
+3 ;
+4 ;This RPC returns the CVGT information for one problem - it is used on the
+5 ;PIP add/edit screen to populate the bottom CVGT section
+6 ;
+7 ;Input: DFN - Patient IEN
+8 ; PRBIEN - Problem IEN
+9 ; ITYPE - (C) Care Plans, (G) Goals, (I) Visit Instructions, (T) Treatment Plan/Education
+10 ; VIEN - If passed in, limit visit instructions and treatment reg returned to that visit
+11 ;
+12 SET DFN=$GET(DFN)
SET PRBIEN=$GET(PRBIEN)
SET ITYPE=$GET(ITYPE)
SET VIEN=$GET(VIEN)
+13 IF ITYPE=""
SET BMXSEC="Null/Invalid TYPE value"
QUIT
+14 ;
+15 NEW UID,II,SORT,PC,PARY,NEDT,TMP,SIGN,CNT,MDT,BGO,DEL,TYPE,TPC
+16 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+17 SET DATA=$NAME(^TMP("BJPNGPIP",UID))
+18 KILL @DATA
+19 IF $GET(DT)=""!($GET(U)="")
DO DT^DICRW
+20 ;
+21 SET II=0
+22 ; SAC 2009 2.2.3.17
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BJPNGPIP D UNWIND^%ZTER"
+23 ;
+24 SET @DATA@(II)="T00001TYPE^I00010PRBIEN^I00010GCIIEN^I00010VIEN^D00030VISIT_DT^T00001NOTE_STATUS"
+25 SET @DATA@(II)=@DATA@(II)_"^D00030LAST_MODIFIED^T00050MODIFIED_BY^T00160NOTE^I00010HIDE_DUZ^T00001SIGNED"_$CHAR(30)
+26 ;
+27 ;For treatment request, include education as well
+28 IF ITYPE["T"
IF ITYPE'["E"
SET ITYPE=ITYPE_"~E"
+29 ;
+30 ;Verify DFN
+31 IF DFN=""
GOTO XNOTES
+32 ;
+33 ;Definitive EDD date range check
+34 DO GETPAR^CIAVMRPC(.NEDT,"BJPN POST DEDD DAYS","SYS",1,"I","")
+35 ;
+36 ;If blank default to 70
+37 IF +$GET(NEDT)<1
SET NEDT=70
+38 ;
+39 ;Call EHR API and format results into usable data
+40 ;Define compiled data reference
SET TMP=$NAME(^TMP("BJPNIPL",UID))
+41 DO COMP^BJPNUTIL(DFN,UID)
+42 ;
+43 ;Skip deletes
+44 ;IPL Delete
SET DEL=$$GET1^DIQ(9000011,PRBIEN_",",2.02,"I")
IF DEL]""
QUIT
+45 ;
+46 SET CNT=0
+47 ;
+48 ;Loop through compiled results for type
+49 FOR TPC=1:1:$LENGTH(ITYPE,"~")
SET TYPE=$PIECE(ITYPE,"~",TPC)
IF TYPE]""
SET BGO=""
FOR
SET BGO=$ORDER(@TMP@(TYPE,PRBIEN,BGO),-1)
IF BGO=""
QUIT
Begin DoDot:1
+50 ;
+51 NEW APIRES,VISIT,DEDD,BRNG,ERNG,NIEN,X1,X2,X,VDT
+52 NEW DTTM,MDBY,ILMBY,NOTE,NSTS,SIGN
+53 ;
+54 SET SIGN=""
+55 SET APIRES=$GET(@TMP@(TYPE,PRBIEN,BGO,0))
IF APIRES=""
QUIT
+56 ;
+57 ;Pull Visit - If V VISIT INSTRUCTIONS (GOALS and CARE PLANS are not visit driven)
+58 SET (VISIT,VDT)=""
+59 IF (TYPE="I")!(TYPE="O")
SET VISIT=$PIECE(APIRES,U,9)
SET VDT=$PIECE(APIRES,U,4)
+60 IF TYPE="T"
SET VISIT=$PIECE(APIRES,U,10)
SET VDT=$PIECE(APIRES,U,5)
+61 IF TYPE="E"
Begin DoDot:2
+62 NEW VEDIEN
+63 SET VEDIEN=$PIECE(APIRES,U,6)
IF VEDIEN=""
QUIT
+64 SET VISIT=$$GET1^DIQ(9000010.16,VEDIEN_",",.03,"I")
+65 SET VDT=$$GET1^DIQ(9000010,VISIT,.01,"I")
End DoDot:2
+66 ;
+67 ;Filter on visit
+68 IF ((TYPE="I")!(TYPE="T")!(TYPE="E"))!((TYPE="O"))
IF VIEN]""
IF VIEN'=VISIT
QUIT
+69 ;
+70 ;Skip Inactive Goals/Care Plans
+71 IF ((TYPE="G")!(TYPE="C"))
IF $PIECE(APIRES,U,6)'="A"
QUIT
+72 ;
+73 ;Note IEN (Pointer to entry)
+74 IF TYPE'="E"
SET NIEN=$PIECE(APIRES,U,2)
+75 IF '$TEST
SET NIEN=$PIECE(APIRES,U,6)
+76 IF NIEN=""
QUIT
+77 ;
+78 ;Pull Definitive EDD
+79 SET DEDD=$$GET1^DIQ(9000017,DFN_",",1311,"I")
+80 SET X1=DEDD
SET X2=-280
DO C^%DTC
SET BRNG=X
+81 SET X1=DEDD
SET X2=NEDT
DO C^%DTC
SET ERNG=X
+82 ;
+83 ;Get note date/time entered and by - V VISIT INSTRUCTIONS/V OB
+84 SET (DTTM,ILMBY)=""
+85 IF TYPE="I"
Begin DoDot:2
+86 SET DTTM=$$GET1^DIQ(9000010.58,NIEN_",",1216,"I")
+87 SET ILMBY=$$GET1^DIQ(9000010.58,NIEN_",",1217,"I")
+88 SET SIGN=$PIECE(APIRES,U,13)
End DoDot:2
+89 IF TYPE="O"
Begin DoDot:2
+90 SET DTTM=$$GET1^DIQ(9000010.43,NIEN_",",1216,"I")
+91 SET ILMBY=$$GET1^DIQ(9000010.43,NIEN_",",1217,"I")
+92 SET SIGN=$PIECE(APIRES,U,13)
End DoDot:2
+93 ;
+94 ;Get note date/time entered and by - CARE PLAN
+95 IF TYPE'="I"
IF TYPE'="T"
IF TYPE'="E"
IF TYPE'="O"
Begin DoDot:2
+96 NEW IENS,DA
+97 SET DA=$ORDER(^AUPNCPL(NIEN,11,"B","A",""),-1)
IF DA=""
QUIT
+98 SET DA(1)=NIEN
SET IENS=$$IENS^DILF(.DA)
+99 SET DTTM=$$GET1^DIQ(9000092.11,IENS,".03","I")
+100 SET ILMBY=$$GET1^DIQ(9000092.11,IENS,".02","I")
+101 SET SIGN=$PIECE(APIRES,U,7)
End DoDot:2
+102 ;
+103 ;Get treatment plan date/time and by - V TREATMENT/REGIMEN
+104 IF TYPE="T"
Begin DoDot:2
+105 SET DTTM=$$GET1^DIQ(9000010.61,NIEN_",",1216,"I")
+106 SET ILMBY=$$GET1^DIQ(9000010.61,NIEN_",",1217,"I")
End DoDot:2
+107 ;
+108 ;Get education plan date/time and by - V PATIENT ED
+109 IF TYPE="E"
Begin DoDot:2
+110 SET DTTM=$$GET1^DIQ(9000010.16,NIEN_",",1216,"I")
+111 SET ILMBY=$$GET1^DIQ(9000010.16,NIEN_",",1217,"I")
End DoDot:2
+112 ;
+113 IF DTTM=""
QUIT
+114 SET MDBY=$$GET1^DIQ(200,ILMBY_",",".01","E")
+115 ;
+116 ;Get Note
+117 IF TYPE="T"
SET NOTE=$PIECE($GET(@TMP@(TYPE,PRBIEN,BGO,0)),U,14)
+118 IF '$TEST
IF TYPE="E"
SET NOTE=$PIECE(APIRES,U,2)
+119 IF '$TEST
Begin DoDot:2
+120 SET NOTE=""
+121 NEW NIEN
+122 SET NIEN=0
FOR
SET NIEN=$ORDER(@TMP@(TYPE,PRBIEN,BGO,NIEN))
IF NIEN=""
QUIT
Begin DoDot:3
+123 NEW NNT,L
+124 SET NNT=$PIECE($GET(@TMP@(TYPE,PRBIEN,BGO,NIEN)),U,2)
+125 SET L=$EXTRACT(NOTE,$LENGTH(NOTE))
+126 SET NOTE=NOTE_$SELECT(NOTE]"":$CHAR(13)_$CHAR(10),1:"")_NNT
End DoDot:3
End DoDot:2
+127 IF NOTE=""
QUIT
+128 ;
+129 ;Note Status
+130 SET NSTS="A"
+131 IF DEDD]""
IF DTTM'<BRNG
IF DTTM'>ERNG
SET NSTS="C"
+132 ;
+133 ;Determined signed/unsigned
+134 SET SIGN=$SELECT(TYPE="T":"",SIGN]"":"S",1:"U")
+135 ;
+136 ;Set up record
+137 SET CNT=CNT+1
SET SORT(DTTM,CNT)=$SELECT(TYPE="E":"T",1:TYPE)_U_PRBIEN_U_NIEN_U_VISIT_U_VDT_U_NSTS_U_$$FMTE^BJPNPRL(DTTM)_U_MDBY_U_NOTE_U_ILMBY_U_SIGN
End DoDot:1
+138 ;
+139 ;Sort - Most recent first
+140 SET DTTM=""
FOR
SET DTTM=$ORDER(SORT(DTTM),-1)
IF DTTM=""
QUIT
Begin DoDot:1
+141 SET CNT=""
FOR
SET CNT=$ORDER(SORT(DTTM,CNT),-1)
IF CNT=""
QUIT
Begin DoDot:2
+142 SET II=II+1
SET @DATA@(II)=SORT(DTTM,CNT)_$CHAR(30)
End DoDot:2
End DoDot:1
+143 ;
XNOTES SET II=II+1
SET @DATA@(II)=$CHAR(31)
+1 QUIT
+2 ;
ERR ;
+1 DO ^%ZTER
+2 NEW Y,ERRDTM
+3 SET Y=$$NOW^XLFDT()
XECUTE ^DD("DD")
SET ERRDTM=Y
+4 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+5 QUIT
