BJPNAPI2 ;GDIT/HS/BEE-Prenatal Care Module V2.0 API Calls ; 08 May 2012 12:00 PM
;;2.0;PRENATAL CARE MODULE;**8**;Feb 24, 2015;Build 25
;
Q
;
PIP(TARGET,DFN,TYPE,ASTS,VIEN,VONLY,VLAST,PARM,XICG) ;Returns PIPA/PIPN - PIP-Active/Inactive Information
;
;Input:
; DFN - Patient IEN
; TYPE - "C" - Returns list of problem entries on the PIP.
; For each problem entry, returns any information for each entry
; entered within the date range for the current pregnancy.
; "A" - Returns list of problem entries on the PIP.
; For each problem entry, returns ALL information for each entry,
; regardless of whether they apply to the current pregnancy
; or to prior pregnancies.
; ASTS - All Statuses - (Optional) If 1, return both Active and Inactive
; Problems. Otherwise, just return Active problems.
; VIEN - Visit IEN - If populated, only return problems that were set as the POV
; for that visit. Return only visit instructions associated with that visit
; VONLY - 1 - (Optional) Used with VIEN, return only visit instructions/OB Notes for the
; specified visit
; VLAST - 1 - (Optional) Used with VIEN and VONLY. If 1, get previous instruction/OB Notes if
; there is no instruction on current visit
; PARM - (Optional) - Formatting parameter which can contain one or more of the following codes
; - 'V' - Do NOT display the date beside visit instructions/OB Notes
; - 'P' - Do NOT display the date entered for the problem
; - 'H' - Do Not display a hyphen next to each care plan, goal, and visit instruction
; - 'O' - Include OB Notes
; - So as an example, passing "VP" would not display either date listed, but the hyphen
; would still display
; XICG - 1 - (Optional) - Exclude Inactive Care Plans and Goals regardles of TYPE
;
;Input validation
S ASTS=$G(ASTS)
I $G(DFN)="" S @TARGET@(1,0)="Invalid DFN" Q "~@"_$NA(@TARGET)
I $G(TYPE)="" S @TARGET@(1,0)="Invalid TYPE" Q "~@"_$NA(@TARGET)
;
I (",C,A,")'[TYPE D Q "~@"_$NA(@TARGET)
. S @TARGET@(1,0)="Invalid TYPE - Must be C or A"
S VIEN=$G(VIEN) I VIEN]"",$$GET1^DIQ(9000010,VIEN_",",.01,"I")="" D Q "~@"_$NA(@TARGET)
. S @TARGET@(1,0)="Invalid VIEN"
;
S VONLY=$G(VONLY) S:VIEN="" VONLY=""
S VLAST=$G(VLAST) S:VIEN="" VLAST=""
S XICG=$G(XICG)
S PARM=$G(PARM)
;
NEW II,CNT,RESULT,PRBIEN,PCNT,UID,TMP,NEDT
;
;Reset output
K @TARGET
;
;Define task id
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
;
;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
D COMP^BJPNUTIL(DFN,UID,VIEN)
S TMP=$NA(^TMP("BJPNIPL",UID)) ;Define compiled data reference
;
;Loop through PIP - Process each entry
S PRBIEN="",II=0,PCNT=0 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
.. D PROC(PRBIEN,BPIEN,ASTS,TMP,VIEN,VONLY,VLAST,PARM)
;
;Clear out scratch global
K ^TMP("BJPNPRL",$J)
;
;Define Output
S (II,CNT)=0 F S II=$O(RESULT(II)) Q:'II D
.S CNT=CNT+1
.S @TARGET@(CNT,0)=RESULT(II)
I 'CNT S @TARGET@(1,0)="No Active Problems for Current Pregnanacy"
Q "~@"_$NA(@TARGET)
;
PROC(PRBIEN,BPIEN,ASTS,TMP,VIEN,VONLY,VLAST,PARM) ;EP - Process one entry
;
NEW DEL,PNR,OEDT,OEBY,CNT,WRAP,PDSP,STS,LINE,SPACE,BGO,API,IVOB
NEW X1,X2,X,DEDD,BRNG,ERNG,GOAL,VISIT,CARE,VSTDT,NVDT,NPDT,NHYP,OBN
;
;Define formatting parameters
S NVDT=$S(PARM["V":1,1:"")
S NPDT=$S(PARM["P":1,1:"")
S NHYP=$S(PARM["H":1,1:"")
S IVOB=$S(PARM["O":1,1:"")
;
;Get the visit date
S VSTDT="" S:VIEN]"" VSTDT=$$GET1^DIQ(9000010,VIEN_",",.01,"I")
;
S $P(SPACE," ",80)=" "
;
;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]"" Q ;IPL Delete
;
;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=""
;
;If passed in only return POV problems
I VIEN]"",$P(API,U,31)="" Q
;
;Status - Active Only
S STS=$$GET1^DIQ(90680.01,BPIEN_",",.08,"I")
I '$G(ASTS),STS'="A" Q
;
;Provider Text
S PNR=$P(API,U,8)
;
;Tack on Inactive
I STS'="A" S PNR="(i)"_PNR
;
;Original Entry Date
S OEDT=$$FMTE^XLFDT($$GET1^DIQ(9000011,PRBIEN_",",.08,"I"),"2D")
;
;Original Entry By
S OEBY=$$GET1^DIQ(9000011,PRBIEN_",",1.03,"E")
;
;Problem Count
S PCNT=PCNT+1 I PCNT>1 S II=II+1,RESULT(II)=" "
S PDSP=PCNT_") ",PDSP=$E(PDSP,1,4)
;
;Handle Wrapping
D WRAP^BJPNPRNT(.WRAP,PNR,76)
;
;Process each wrapped line
S WRAP="" F LINE=1:1 S WRAP=$O(WRAP(WRAP)) Q:WRAP="" D
. S II=II+1,RESULT(II)=$S(LINE=1:PDSP,1:($E(SPACE,1,4)))_WRAP(WRAP)
;
;Tack on Date/By
S II=II+1,RESULT(II)=$E(SPACE,1,4)_"(Entered"_$S(NPDT:"",1:" "_OEDT)_$S(OEBY]"":" by ",1:"")_OEBY_")"
;
;Pull Definitive EDD
S DEDD=$$GET1^DIQ(90680.01,BPIEN_",",.09,"I")
S X1=DEDD,X2=-280 D C^%DTC S BRNG=X
S X1=DEDD,X2=NEDT D C^%DTC S ERNG=X
;
;Reset Notes Entries
S (GOAL,CARE,VISIT,OBN)=""
;
;Loop through goals
I 'VONLY S BGO="" F S BGO=$O(@TMP@("G",PRBIEN,BGO)) Q:BGO="" D
. ;
. NEW APIRES,VISIT,NIEN,IENS,DA,SCO,WRAP
. NEW DTTM,MDBY,ILMBY,NOTE,NSTS,SIGN
. ;
. S SIGN=""
. S APIRES=$G(@TMP@("G",PRBIEN,BGO,0)) Q:APIRES=""
. ;
. ;Skip Inactive Goals for Current Display
. S NSTS=$P(APIRES,U,6),NSTS=$S(NSTS="A":"a",1:"i")
. I TYPE="C",NSTS'="a" Q
. ;
. ;Skip Inactive Goals if override set
. I XICG=1,NSTS'="a" Q
. ;
. ;Get note date/time entered and by
. S (DTTM,ILMBY)=""
. ;
. ;Note IEN
. S NIEN=$P(APIRES,U,2) Q:NIEN=""
. ;
. ;Get note date/time entered and by - Goal
. 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)
. ;
. Q:DTTM=""
. S MDBY=$$GET1^DIQ(200,ILMBY_",",".01","E")
. ;
. ;Get Note
. S NOTE=$P($G(@TMP@("G",PRBIEN,BGO,1)),U,2)
. Q:NOTE=""
. ;
. ;Note Status
. S NSTS=$S(VIEN]"":" ",TYPE="C":" ",XICG=1:" ",1:" ("_NSTS_") ")
. ;
. ;Determined signed/unsigned
. S SIGN=$S(SIGN]"":"S",1:"U")
. ;
. ;Set up record
. ;
. ;Display Header
. I 'GOAL D
.. NEW WRAP
.. D WRAP^BJPNPRNT(.WRAP,"Goal Notes",75,2)
.. S II=II+1,RESULT(II)=$E(SPACE,1,6)_$G(WRAP(1))
.. S GOAL=1
. ;
. ;Handle Wrapping
. D WRAP^BJPNPRNT(.WRAP,$S(NHYP:"",1:"-")_NSTS_NOTE_" ("_$$FMTE^XLFDT(DTTM,"2D")_$S(MDBY]"":" by ",1:"")_MDBY_")",72,2)
. ;
. ;Process each wrapped line
. S WRAP="" F LINE=1:1 S WRAP=$O(WRAP(WRAP)) Q:WRAP="" D
.. S II=II+1,RESULT(II)=$E(SPACE,1,8)_WRAP(WRAP)
;
;Loop through care plans
I 'VONLY S BGO="" F S BGO=$O(@TMP@("C",PRBIEN,BGO)) Q:BGO="" D
. ;
. NEW APIRES,VISIT,NIEN,IENS,DA,SCO,WRAP
. NEW DTTM,MDBY,ILMBY,NOTE,NSTS,SIGN
. ;
. S SIGN=""
. S APIRES=$G(@TMP@("C",PRBIEN,BGO,0)) Q:APIRES=""
. ;
. ;Skip Inactive Care Plans for Current Display
. S NSTS=$P(APIRES,U,6),NSTS=$S(NSTS="A":"a",1:"i")
. I TYPE="C",NSTS'="a" Q
. ;
. ;Skip Inactive Care Plans if override set
. I XICG=1,NSTS'="a" Q
. ;
. ;Get note date/time entered and by
. S (DTTM,ILMBY)=""
. ;
. ;Note IEN
. S NIEN=$P(APIRES,U,2) Q:NIEN=""
. ;
. ;Get note date/time entered and by - Goal
. 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)
. ;
. Q:DTTM=""
. S MDBY=$$GET1^DIQ(200,ILMBY_",",".01","E")
. ;
. ;Get Note
. S NOTE=$P($G(@TMP@("C",PRBIEN,BGO,1)),U,2)
. Q:NOTE=""
. ;
. ;Note Status
. S NSTS=$S(VIEN]"":" ",TYPE="C":" ",XICG=1:" ",1:" ("_NSTS_") ")
. ;
. ;Determined signed/unsigned
. S SIGN=$S(SIGN]"":"S",1:"U")
. ;
. ;Set up record
. ;
. ;Display Header
. I 'CARE D
.. ;
.. ;Skip a line if there were goals
.. I GOAL S II=II+1,RESULT(II)=" "
.. ;
.. NEW WRAP
.. D WRAP^BJPNPRNT(.WRAP,"Care Plan",75,2)
.. S II=II+1,RESULT(II)=$E(SPACE,1,6)_$G(WRAP(1))
.. S CARE=1
. ;
. ;Handle Wrapping
. D WRAP^BJPNPRNT(.WRAP,$S(NHYP:"",1:"-")_NSTS_NOTE_" ("_$$FMTE^XLFDT(DTTM,"2D")_$S(MDBY]"":" by ",1:"")_MDBY_")",72,2)
. ;
. ;Process each wrapped line
. S WRAP="" F LINE=1:1 S WRAP=$O(WRAP(WRAP)) Q:WRAP="" D
.. S II=II+1,RESULT(II)=$E(SPACE,1,8)_WRAP(WRAP)
;
;Loop through OB Notes (Return All)
I IVOB S BGO="" F S BGO=$O(@TMP@("O",PRBIEN,BGO)) Q:BGO="" D
. ;
. NEW APIRES,NIEN,IENS,DA,SCO,WRAP,SKIP
. NEW DTTM,MDBY,ILMBY,NOTE,NSTS,SIGN,VSIT
. ;
. S SIGN=""
. S APIRES=$G(@TMP@("O",PRBIEN,BGO,0)) Q:APIRES=""
. ;
. ;Filter out unmatch visits, if desired
. S VSIT=$P(APIRES,U,9)
. I 'VLAST,VIEN]"",VSIT'=VIEN Q
. ;
. ;See if only last note should be displayed
. S SKIP="" I VLAST D Q:SKIP
.. NEW VDT
.. S VDT=$$GET1^DIQ(9000010,VSIT_",",.01,"I")
.. I VDT>VSTDT S SKIP=1
.. I VSIT'=VIEN,VISIT S SKIP=1
. ;
. ;Get note date/time entered and by
. S (DTTM,ILMBY)=""
. ;
. ;Note IEN
. S NIEN=$P(APIRES,U,2) Q:NIEN=""
. ;
. ;Get note date/time entered and by - V VISIT INSTRUCTIONS
. S (DTTM,ILMBY)=""
. S DTTM=$$GET1^DIQ(9000010.43,NIEN_",",1216,"I")
. S ILMBY=$$GET1^DIQ(9000010.43,NIEN_",",1217,"I")
. S SIGN=$P(APIRES,U,13)
. ;
. Q:DTTM=""
. S MDBY=$$GET1^DIQ(200,ILMBY_",",".01","E")
. ;
. ;Get Note
. S NOTE=$P($G(@TMP@("O",PRBIEN,BGO,1)),U,2)
. Q:NOTE=""
. ;
. ;Note Status
. S NSTS="i"
. I DEDD]"",DTTM'<BRNG,DTTM'>ERNG S NSTS="a"
. ;
. ;Quit if current display and out of pregnancy range
. I TYPE="C",NSTS="i" Q
. ;
. S NSTS=$S(VIEN]"":" ",TYPE="C":" ",1:" ("_NSTS_") ")
. ;
. ;Determined signed/unsigned
. S SIGN=$S(SIGN]"":"S",1:"U")
. ;
. ;Set up record
. ;
. ;Display Header
. I 'OBN D
.. ;
.. ;Skip a line if there were goals
.. I GOAL!CARE S II=II+1,RESULT(II)=" "
.. ;
.. NEW WRAP
.. D WRAP^BJPNPRNT(.WRAP,"OB Brief Note",75,2)
.. S II=II+1,RESULT(II)=$E(SPACE,1,6)_$G(WRAP(1))
.. S OBN=1
. ;
. ;Handle Wrapping
. D WRAP^BJPNPRNT(.WRAP,$S(NHYP:"",1:"-")_NSTS_NOTE_" ("_$S('NVDT:$$FMTE^XLFDT(DTTM,"2D")_" ",1:"")_$S(MDBY]"":"by ",1:"")_MDBY_")",72,2)
. ;
. ;Process each wrapped line
. S WRAP="" F LINE=1:1 S WRAP=$O(WRAP(WRAP)) Q:WRAP="" D
.. S II=II+1,RESULT(II)=$E(SPACE,1,8)_WRAP(WRAP)
;
;Loop through Visit Instructions (Return All)
S BGO="" F S BGO=$O(@TMP@("I",PRBIEN,BGO)) Q:BGO="" D
. ;
. NEW APIRES,NIEN,IENS,DA,SCO,WRAP,SKIP
. NEW DTTM,MDBY,ILMBY,NOTE,NSTS,SIGN,VSIT
. ;
. S SIGN=""
. S APIRES=$G(@TMP@("I",PRBIEN,BGO,0)) Q:APIRES=""
. ;
. ;Filter out unmatch visits, if desired
. S VSIT=$P(APIRES,U,9)
. I 'VLAST,VIEN]"",VSIT'=VIEN Q
. ;
. ;See if only last note should be displayed
. S SKIP="" I VLAST D Q:SKIP
.. NEW VDT
.. S VDT=$$GET1^DIQ(9000010,VSIT_",",.01,"I")
.. I VDT>VSTDT S SKIP=1
.. I VSIT'=VIEN,VISIT S SKIP=1
. ;
. ;Get note date/time entered and by
. S (DTTM,ILMBY)=""
. ;
. ;Note IEN
. S NIEN=$P(APIRES,U,2) Q:NIEN=""
. ;
. ;Get note date/time entered and by - V VISIT INSTRUCTIONS
. S (DTTM,ILMBY)=""
. S DTTM=$$GET1^DIQ(9000010.58,NIEN_",",1216,"I")
. S ILMBY=$$GET1^DIQ(9000010.58,NIEN_",",1217,"I")
. S SIGN=$P(APIRES,U,13)
. ;
. Q:DTTM=""
. S MDBY=$$GET1^DIQ(200,ILMBY_",",".01","E")
. ;
. ;Get Note
. S NOTE=$P($G(@TMP@("I",PRBIEN,BGO,1)),U,2)
. Q:NOTE=""
. ;
. ;Note Status
. S NSTS="i"
. I DEDD]"",DTTM'<BRNG,DTTM'>ERNG S NSTS="a"
. ;
. ;Quit if current display and out of pregnancy range
. I TYPE="C",NSTS="i" Q
. ;
. S NSTS=$S(VIEN]"":" ",TYPE="C":" ",1:" ("_NSTS_") ")
. ;
. ;Determined signed/unsigned
. S SIGN=$S(SIGN]"":"S",1:"U")
. ;
. ;Set up record
. ;
. ;Display Header
. I 'VISIT D
.. ;
.. ;Skip a line if there were goals
.. I GOAL!CARE!OBN S II=II+1,RESULT(II)=" "
.. ;
.. NEW WRAP
.. D WRAP^BJPNPRNT(.WRAP,"Visit Instructions",75,2)
.. S II=II+1,RESULT(II)=$E(SPACE,1,6)_$G(WRAP(1))
.. S VISIT=1
. ;
. ;Handle Wrapping
. D WRAP^BJPNPRNT(.WRAP,$S(NHYP:"",1:"-")_NSTS_NOTE_" ("_$S('NVDT:$$FMTE^XLFDT(DTTM,"2D")_" ",1:"")_$S(MDBY]"":"by ",1:"")_MDBY_")",72,2)
. ;
. ;Process each wrapped line
. S WRAP="" F LINE=1:1 S WRAP=$O(WRAP(WRAP)) Q:WRAP="" D
.. S II=II+1,RESULT(II)=$E(SPACE,1,8)_WRAP(WRAP)
;
Q
BJPNAPI2 ;GDIT/HS/BEE-Prenatal Care Module V2.0 API Calls ; 08 May 2012 12:00 PM
+1 ;;2.0;PRENATAL CARE MODULE;**8**;Feb 24, 2015;Build 25
+2 ;
+3 QUIT
+4 ;
PIP(TARGET,DFN,TYPE,ASTS,VIEN,VONLY,VLAST,PARM,XICG) ;Returns PIPA/PIPN - PIP-Active/Inactive Information
+1 ;
+2 ;Input:
+3 ; DFN - Patient IEN
+4 ; TYPE - "C" - Returns list of problem entries on the PIP.
+5 ; For each problem entry, returns any information for each entry
+6 ; entered within the date range for the current pregnancy.
+7 ; "A" - Returns list of problem entries on the PIP.
+8 ; For each problem entry, returns ALL information for each entry,
+9 ; regardless of whether they apply to the current pregnancy
+10 ; or to prior pregnancies.
+11 ; ASTS - All Statuses - (Optional) If 1, return both Active and Inactive
+12 ; Problems. Otherwise, just return Active problems.
+13 ; VIEN - Visit IEN - If populated, only return problems that were set as the POV
+14 ; for that visit. Return only visit instructions associated with that visit
+15 ; VONLY - 1 - (Optional) Used with VIEN, return only visit instructions/OB Notes for the
+16 ; specified visit
+17 ; VLAST - 1 - (Optional) Used with VIEN and VONLY. If 1, get previous instruction/OB Notes if
+18 ; there is no instruction on current visit
+19 ; PARM - (Optional) - Formatting parameter which can contain one or more of the following codes
+20 ; - 'V' - Do NOT display the date beside visit instructions/OB Notes
+21 ; - 'P' - Do NOT display the date entered for the problem
+22 ; - 'H' - Do Not display a hyphen next to each care plan, goal, and visit instruction
+23 ; - 'O' - Include OB Notes
+24 ; - So as an example, passing "VP" would not display either date listed, but the hyphen
+25 ; would still display
+26 ; XICG - 1 - (Optional) - Exclude Inactive Care Plans and Goals regardles of TYPE
+27 ;
+28 ;Input validation
+29 SET ASTS=$GET(ASTS)
+30 IF $GET(DFN)=""
SET @TARGET@(1,0)="Invalid DFN"
QUIT "~@"_$NAME(@TARGET)
+31 IF $GET(TYPE)=""
SET @TARGET@(1,0)="Invalid TYPE"
QUIT "~@"_$NAME(@TARGET)
+32 ;
+33 IF (",C,A,")'[TYPE
Begin DoDot:1
+34 SET @TARGET@(1,0)="Invalid TYPE - Must be C or A"
End DoDot:1
QUIT "~@"_$NAME(@TARGET)
+35 SET VIEN=$GET(VIEN)
IF VIEN]""
IF $$GET1^DIQ(9000010,VIEN_",",.01,"I")=""
Begin DoDot:1
+36 SET @TARGET@(1,0)="Invalid VIEN"
End DoDot:1
QUIT "~@"_$NAME(@TARGET)
+37 ;
+38 SET VONLY=$GET(VONLY)
IF VIEN=""
SET VONLY=""
+39 SET VLAST=$GET(VLAST)
IF VIEN=""
SET VLAST=""
+40 SET XICG=$GET(XICG)
+41 SET PARM=$GET(PARM)
+42 ;
+43 NEW II,CNT,RESULT,PRBIEN,PCNT,UID,TMP,NEDT
+44 ;
+45 ;Reset output
+46 KILL @TARGET
+47 ;
+48 ;Define task id
+49 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+50 ;
+51 ;Definitive EDD date range check
+52 DO GETPAR^CIAVMRPC(.NEDT,"BJPN POST DEDD DAYS","SYS",1,"I","")
+53 ;
+54 ;If blank default to 70
+55 IF +$GET(NEDT)<1
SET NEDT=70
+56 ;
+57 ;Call EHR API and format results into usable data
+58 DO COMP^BJPNUTIL(DFN,UID,VIEN)
+59 ;Define compiled data reference
SET TMP=$NAME(^TMP("BJPNIPL",UID))
+60 ;
+61 ;Loop through PIP - Process each entry
+62 SET PRBIEN=""
SET II=0
SET PCNT=0
FOR
SET PRBIEN=$ORDER(^BJPNPL("F",DFN,PRBIEN))
IF PRBIEN=""
QUIT
Begin DoDot:1
+63 NEW BPIEN
+64 SET BPIEN=""
FOR
SET BPIEN=$ORDER(^BJPNPL("F",DFN,PRBIEN,BPIEN))
IF BPIEN=""
QUIT
Begin DoDot:2
+65 DO PROC(PRBIEN,BPIEN,ASTS,TMP,VIEN,VONLY,VLAST,PARM)
End DoDot:2
End DoDot:1
+66 ;
+67 ;Clear out scratch global
+68 KILL ^TMP("BJPNPRL",$JOB)
+69 ;
+70 ;Define Output
+71 SET (II,CNT)=0
FOR
SET II=$ORDER(RESULT(II))
IF 'II
QUIT
Begin DoDot:1
+72 SET CNT=CNT+1
+73 SET @TARGET@(CNT,0)=RESULT(II)
End DoDot:1
+74 IF 'CNT
SET @TARGET@(1,0)="No Active Problems for Current Pregnanacy"
+75 QUIT "~@"_$NAME(@TARGET)
+76 ;
PROC(PRBIEN,BPIEN,ASTS,TMP,VIEN,VONLY,VLAST,PARM) ;EP - Process one entry
+1 ;
+2 NEW DEL,PNR,OEDT,OEBY,CNT,WRAP,PDSP,STS,LINE,SPACE,BGO,API,IVOB
+3 NEW X1,X2,X,DEDD,BRNG,ERNG,GOAL,VISIT,CARE,VSTDT,NVDT,NPDT,NHYP,OBN
+4 ;
+5 ;Define formatting parameters
+6 SET NVDT=$SELECT(PARM["V":1,1:"")
+7 SET NPDT=$SELECT(PARM["P":1,1:"")
+8 SET NHYP=$SELECT(PARM["H":1,1:"")
+9 SET IVOB=$SELECT(PARM["O":1,1:"")
+10 ;
+11 ;Get the visit date
+12 SET VSTDT=""
IF VIEN]""
SET VSTDT=$$GET1^DIQ(9000010,VIEN_",",.01,"I")
+13 ;
+14 SET $PIECE(SPACE," ",80)=" "
+15 ;
+16 ;Skip deletes
+17 ;PIP Delete
SET DEL=$$GET1^DIQ(90680.01,BPIEN_",",2.01,"I")
IF DEL]""
QUIT
+18 ;IPL Delete
SET DEL=$$GET1^DIQ(9000011,PRBIEN_",",2.02,"I")
IF DEL]""
QUIT
+19 ;
+20 ;Retrieve the entry from the API results
+21 ;Quit if no IPL entry
SET BGO=$ORDER(@TMP@("P",PRBIEN,""))
IF BGO=""
QUIT
+22 SET API=$GET(@TMP@("P",PRBIEN,BGO))
IF API=""
QUIT
+23 ;
+24 ;If passed in only return POV problems
+25 IF VIEN]""
IF $PIECE(API,U,31)=""
QUIT
+26 ;
+27 ;Status - Active Only
+28 SET STS=$$GET1^DIQ(90680.01,BPIEN_",",.08,"I")
+29 IF '$GET(ASTS)
IF STS'="A"
QUIT
+30 ;
+31 ;Provider Text
+32 SET PNR=$PIECE(API,U,8)
+33 ;
+34 ;Tack on Inactive
+35 IF STS'="A"
SET PNR="(i)"_PNR
+36 ;
+37 ;Original Entry Date
+38 SET OEDT=$$FMTE^XLFDT($$GET1^DIQ(9000011,PRBIEN_",",.08,"I"),"2D")
+39 ;
+40 ;Original Entry By
+41 SET OEBY=$$GET1^DIQ(9000011,PRBIEN_",",1.03,"E")
+42 ;
+43 ;Problem Count
+44 SET PCNT=PCNT+1
IF PCNT>1
SET II=II+1
SET RESULT(II)=" "
+45 SET PDSP=PCNT_") "
SET PDSP=$EXTRACT(PDSP,1,4)
+46 ;
+47 ;Handle Wrapping
+48 DO WRAP^BJPNPRNT(.WRAP,PNR,76)
+49 ;
+50 ;Process each wrapped line
+51 SET WRAP=""
FOR LINE=1:1
SET WRAP=$ORDER(WRAP(WRAP))
IF WRAP=""
QUIT
Begin DoDot:1
+52 SET II=II+1
SET RESULT(II)=$SELECT(LINE=1:PDSP,1:($EXTRACT(SPACE,1,4)))_WRAP(WRAP)
End DoDot:1
+53 ;
+54 ;Tack on Date/By
+55 SET II=II+1
SET RESULT(II)=$EXTRACT(SPACE,1,4)_"(Entered"_$SELECT(NPDT:"",1:" "_OEDT)_$SELECT(OEBY]"":" by ",1:"")_OEBY_")"
+56 ;
+57 ;Pull Definitive EDD
+58 SET DEDD=$$GET1^DIQ(90680.01,BPIEN_",",.09,"I")
+59 SET X1=DEDD
SET X2=-280
DO C^%DTC
SET BRNG=X
+60 SET X1=DEDD
SET X2=NEDT
DO C^%DTC
SET ERNG=X
+61 ;
+62 ;Reset Notes Entries
+63 SET (GOAL,CARE,VISIT,OBN)=""
+64 ;
+65 ;Loop through goals
+66 IF 'VONLY
SET BGO=""
FOR
SET BGO=$ORDER(@TMP@("G",PRBIEN,BGO))
IF BGO=""
QUIT
Begin DoDot:1
+67 ;
+68 NEW APIRES,VISIT,NIEN,IENS,DA,SCO,WRAP
+69 NEW DTTM,MDBY,ILMBY,NOTE,NSTS,SIGN
+70 ;
+71 SET SIGN=""
+72 SET APIRES=$GET(@TMP@("G",PRBIEN,BGO,0))
IF APIRES=""
QUIT
+73 ;
+74 ;Skip Inactive Goals for Current Display
+75 SET NSTS=$PIECE(APIRES,U,6)
SET NSTS=$SELECT(NSTS="A":"a",1:"i")
+76 IF TYPE="C"
IF NSTS'="a"
QUIT
+77 ;
+78 ;Skip Inactive Goals if override set
+79 IF XICG=1
IF NSTS'="a"
QUIT
+80 ;
+81 ;Get note date/time entered and by
+82 SET (DTTM,ILMBY)=""
+83 ;
+84 ;Note IEN
+85 SET NIEN=$PIECE(APIRES,U,2)
IF NIEN=""
QUIT
+86 ;
+87 ;Get note date/time entered and by - Goal
+88 SET DA=$ORDER(^AUPNCPL(NIEN,11,"B","A",""),-1)
IF DA=""
QUIT
+89 SET DA(1)=NIEN
SET IENS=$$IENS^DILF(.DA)
+90 SET DTTM=$$GET1^DIQ(9000092.11,IENS,".03","I")
+91 SET ILMBY=$$GET1^DIQ(9000092.11,IENS,".02","I")
+92 SET SIGN=$PIECE(APIRES,U,7)
+93 ;
+94 IF DTTM=""
QUIT
+95 SET MDBY=$$GET1^DIQ(200,ILMBY_",",".01","E")
+96 ;
+97 ;Get Note
+98 SET NOTE=$PIECE($GET(@TMP@("G",PRBIEN,BGO,1)),U,2)
+99 IF NOTE=""
QUIT
+100 ;
+101 ;Note Status
+102 SET NSTS=$SELECT(VIEN]"":" ",TYPE="C":" ",XICG=1:" ",1:" ("_NSTS_") ")
+103 ;
+104 ;Determined signed/unsigned
+105 SET SIGN=$SELECT(SIGN]"":"S",1:"U")
+106 ;
+107 ;Set up record
+108 ;
+109 ;Display Header
+110 IF 'GOAL
Begin DoDot:2
+111 NEW WRAP
+112 DO WRAP^BJPNPRNT(.WRAP,"Goal Notes",75,2)
+113 SET II=II+1
SET RESULT(II)=$EXTRACT(SPACE,1,6)_$GET(WRAP(1))
+114 SET GOAL=1
End DoDot:2
+115 ;
+116 ;Handle Wrapping
+117 DO WRAP^BJPNPRNT(.WRAP,$SELECT(NHYP:"",1:"-")_NSTS_NOTE_" ("_$$FMTE^XLFDT(DTTM,"2D")_$SELECT(MDBY]"":" by ",1:"")_MDBY_")",72,2)
+118 ;
+119 ;Process each wrapped line
+120 SET WRAP=""
FOR LINE=1:1
SET WRAP=$ORDER(WRAP(WRAP))
IF WRAP=""
QUIT
Begin DoDot:2
+121 SET II=II+1
SET RESULT(II)=$EXTRACT(SPACE,1,8)_WRAP(WRAP)
End DoDot:2
End DoDot:1
+122 ;
+123 ;Loop through care plans
+124 IF 'VONLY
SET BGO=""
FOR
SET BGO=$ORDER(@TMP@("C",PRBIEN,BGO))
IF BGO=""
QUIT
Begin DoDot:1
+125 ;
+126 NEW APIRES,VISIT,NIEN,IENS,DA,SCO,WRAP
+127 NEW DTTM,MDBY,ILMBY,NOTE,NSTS,SIGN
+128 ;
+129 SET SIGN=""
+130 SET APIRES=$GET(@TMP@("C",PRBIEN,BGO,0))
IF APIRES=""
QUIT
+131 ;
+132 ;Skip Inactive Care Plans for Current Display
+133 SET NSTS=$PIECE(APIRES,U,6)
SET NSTS=$SELECT(NSTS="A":"a",1:"i")
+134 IF TYPE="C"
IF NSTS'="a"
QUIT
+135 ;
+136 ;Skip Inactive Care Plans if override set
+137 IF XICG=1
IF NSTS'="a"
QUIT
+138 ;
+139 ;Get note date/time entered and by
+140 SET (DTTM,ILMBY)=""
+141 ;
+142 ;Note IEN
+143 SET NIEN=$PIECE(APIRES,U,2)
IF NIEN=""
QUIT
+144 ;
+145 ;Get note date/time entered and by - Goal
+146 SET DA=$ORDER(^AUPNCPL(NIEN,11,"B","A",""),-1)
IF DA=""
QUIT
+147 SET DA(1)=NIEN
SET IENS=$$IENS^DILF(.DA)
+148 SET DTTM=$$GET1^DIQ(9000092.11,IENS,".03","I")
+149 SET ILMBY=$$GET1^DIQ(9000092.11,IENS,".02","I")
+150 SET SIGN=$PIECE(APIRES,U,7)
+151 ;
+152 IF DTTM=""
QUIT
+153 SET MDBY=$$GET1^DIQ(200,ILMBY_",",".01","E")
+154 ;
+155 ;Get Note
+156 SET NOTE=$PIECE($GET(@TMP@("C",PRBIEN,BGO,1)),U,2)
+157 IF NOTE=""
QUIT
+158 ;
+159 ;Note Status
+160 SET NSTS=$SELECT(VIEN]"":" ",TYPE="C":" ",XICG=1:" ",1:" ("_NSTS_") ")
+161 ;
+162 ;Determined signed/unsigned
+163 SET SIGN=$SELECT(SIGN]"":"S",1:"U")
+164 ;
+165 ;Set up record
+166 ;
+167 ;Display Header
+168 IF 'CARE
Begin DoDot:2
+169 ;
+170 ;Skip a line if there were goals
+171 IF GOAL
SET II=II+1
SET RESULT(II)=" "
+172 ;
+173 NEW WRAP
+174 DO WRAP^BJPNPRNT(.WRAP,"Care Plan",75,2)
+175 SET II=II+1
SET RESULT(II)=$EXTRACT(SPACE,1,6)_$GET(WRAP(1))
+176 SET CARE=1
End DoDot:2
+177 ;
+178 ;Handle Wrapping
+179 DO WRAP^BJPNPRNT(.WRAP,$SELECT(NHYP:"",1:"-")_NSTS_NOTE_" ("_$$FMTE^XLFDT(DTTM,"2D")_$SELECT(MDBY]"":" by ",1:"")_MDBY_")",72,2)
+180 ;
+181 ;Process each wrapped line
+182 SET WRAP=""
FOR LINE=1:1
SET WRAP=$ORDER(WRAP(WRAP))
IF WRAP=""
QUIT
Begin DoDot:2
+183 SET II=II+1
SET RESULT(II)=$EXTRACT(SPACE,1,8)_WRAP(WRAP)
End DoDot:2
End DoDot:1
+184 ;
+185 ;Loop through OB Notes (Return All)
+186 IF IVOB
SET BGO=""
FOR
SET BGO=$ORDER(@TMP@("O",PRBIEN,BGO))
IF BGO=""
QUIT
Begin DoDot:1
+187 ;
+188 NEW APIRES,NIEN,IENS,DA,SCO,WRAP,SKIP
+189 NEW DTTM,MDBY,ILMBY,NOTE,NSTS,SIGN,VSIT
+190 ;
+191 SET SIGN=""
+192 SET APIRES=$GET(@TMP@("O",PRBIEN,BGO,0))
IF APIRES=""
QUIT
+193 ;
+194 ;Filter out unmatch visits, if desired
+195 SET VSIT=$PIECE(APIRES,U,9)
+196 IF 'VLAST
IF VIEN]""
IF VSIT'=VIEN
QUIT
+197 ;
+198 ;See if only last note should be displayed
+199 SET SKIP=""
IF VLAST
Begin DoDot:2
+200 NEW VDT
+201 SET VDT=$$GET1^DIQ(9000010,VSIT_",",.01,"I")
+202 IF VDT>VSTDT
SET SKIP=1
+203 IF VSIT'=VIEN
IF VISIT
SET SKIP=1
End DoDot:2
IF SKIP
QUIT
+204 ;
+205 ;Get note date/time entered and by
+206 SET (DTTM,ILMBY)=""
+207 ;
+208 ;Note IEN
+209 SET NIEN=$PIECE(APIRES,U,2)
IF NIEN=""
QUIT
+210 ;
+211 ;Get note date/time entered and by - V VISIT INSTRUCTIONS
+212 SET (DTTM,ILMBY)=""
+213 SET DTTM=$$GET1^DIQ(9000010.43,NIEN_",",1216,"I")
+214 SET ILMBY=$$GET1^DIQ(9000010.43,NIEN_",",1217,"I")
+215 SET SIGN=$PIECE(APIRES,U,13)
+216 ;
+217 IF DTTM=""
QUIT
+218 SET MDBY=$$GET1^DIQ(200,ILMBY_",",".01","E")
+219 ;
+220 ;Get Note
+221 SET NOTE=$PIECE($GET(@TMP@("O",PRBIEN,BGO,1)),U,2)
+222 IF NOTE=""
QUIT
+223 ;
+224 ;Note Status
+225 SET NSTS="i"
+226 IF DEDD]""
IF DTTM'<BRNG
IF DTTM'>ERNG
SET NSTS="a"
+227 ;
+228 ;Quit if current display and out of pregnancy range
+229 IF TYPE="C"
IF NSTS="i"
QUIT
+230 ;
+231 SET NSTS=$SELECT(VIEN]"":" ",TYPE="C":" ",1:" ("_NSTS_") ")
+232 ;
+233 ;Determined signed/unsigned
+234 SET SIGN=$SELECT(SIGN]"":"S",1:"U")
+235 ;
+236 ;Set up record
+237 ;
+238 ;Display Header
+239 IF 'OBN
Begin DoDot:2
+240 ;
+241 ;Skip a line if there were goals
+242 IF GOAL!CARE
SET II=II+1
SET RESULT(II)=" "
+243 ;
+244 NEW WRAP
+245 DO WRAP^BJPNPRNT(.WRAP,"OB Brief Note",75,2)
+246 SET II=II+1
SET RESULT(II)=$EXTRACT(SPACE,1,6)_$GET(WRAP(1))
+247 SET OBN=1
End DoDot:2
+248 ;
+249 ;Handle Wrapping
+250 DO WRAP^BJPNPRNT(.WRAP,$SELECT(NHYP:"",1:"-")_NSTS_NOTE_" ("_$SELECT('NVDT:$$FMTE^XLFDT(DTTM,"2D")_" ",1:"")_$SELECT(MDBY]"":"by ",1:"")_MDBY_")",72,2)
+251 ;
+252 ;Process each wrapped line
+253 SET WRAP=""
FOR LINE=1:1
SET WRAP=$ORDER(WRAP(WRAP))
IF WRAP=""
QUIT
Begin DoDot:2
+254 SET II=II+1
SET RESULT(II)=$EXTRACT(SPACE,1,8)_WRAP(WRAP)
End DoDot:2
End DoDot:1
+255 ;
+256 ;Loop through Visit Instructions (Return All)
+257 SET BGO=""
FOR
SET BGO=$ORDER(@TMP@("I",PRBIEN,BGO))
IF BGO=""
QUIT
Begin DoDot:1
+258 ;
+259 NEW APIRES,NIEN,IENS,DA,SCO,WRAP,SKIP
+260 NEW DTTM,MDBY,ILMBY,NOTE,NSTS,SIGN,VSIT
+261 ;
+262 SET SIGN=""
+263 SET APIRES=$GET(@TMP@("I",PRBIEN,BGO,0))
IF APIRES=""
QUIT
+264 ;
+265 ;Filter out unmatch visits, if desired
+266 SET VSIT=$PIECE(APIRES,U,9)
+267 IF 'VLAST
IF VIEN]""
IF VSIT'=VIEN
QUIT
+268 ;
+269 ;See if only last note should be displayed
+270 SET SKIP=""
IF VLAST
Begin DoDot:2
+271 NEW VDT
+272 SET VDT=$$GET1^DIQ(9000010,VSIT_",",.01,"I")
+273 IF VDT>VSTDT
SET SKIP=1
+274 IF VSIT'=VIEN
IF VISIT
SET SKIP=1
End DoDot:2
IF SKIP
QUIT
+275 ;
+276 ;Get note date/time entered and by
+277 SET (DTTM,ILMBY)=""
+278 ;
+279 ;Note IEN
+280 SET NIEN=$PIECE(APIRES,U,2)
IF NIEN=""
QUIT
+281 ;
+282 ;Get note date/time entered and by - V VISIT INSTRUCTIONS
+283 SET (DTTM,ILMBY)=""
+284 SET DTTM=$$GET1^DIQ(9000010.58,NIEN_",",1216,"I")
+285 SET ILMBY=$$GET1^DIQ(9000010.58,NIEN_",",1217,"I")
+286 SET SIGN=$PIECE(APIRES,U,13)
+287 ;
+288 IF DTTM=""
QUIT
+289 SET MDBY=$$GET1^DIQ(200,ILMBY_",",".01","E")
+290 ;
+291 ;Get Note
+292 SET NOTE=$PIECE($GET(@TMP@("I",PRBIEN,BGO,1)),U,2)
+293 IF NOTE=""
QUIT
+294 ;
+295 ;Note Status
+296 SET NSTS="i"
+297 IF DEDD]""
IF DTTM'<BRNG
IF DTTM'>ERNG
SET NSTS="a"
+298 ;
+299 ;Quit if current display and out of pregnancy range
+300 IF TYPE="C"
IF NSTS="i"
QUIT
+301 ;
+302 SET NSTS=$SELECT(VIEN]"":" ",TYPE="C":" ",1:" ("_NSTS_") ")
+303 ;
+304 ;Determined signed/unsigned
+305 SET SIGN=$SELECT(SIGN]"":"S",1:"U")
+306 ;
+307 ;Set up record
+308 ;
+309 ;Display Header
+310 IF 'VISIT
Begin DoDot:2
+311 ;
+312 ;Skip a line if there were goals
+313 IF GOAL!CARE!OBN
SET II=II+1
SET RESULT(II)=" "
+314 ;
+315 NEW WRAP
+316 DO WRAP^BJPNPRNT(.WRAP,"Visit Instructions",75,2)
+317 SET II=II+1
SET RESULT(II)=$EXTRACT(SPACE,1,6)_$GET(WRAP(1))
+318 SET VISIT=1
End DoDot:2
+319 ;
+320 ;Handle Wrapping
+321 DO WRAP^BJPNPRNT(.WRAP,$SELECT(NHYP:"",1:"-")_NSTS_NOTE_" ("_$SELECT('NVDT:$$FMTE^XLFDT(DTTM,"2D")_" ",1:"")_$SELECT(MDBY]"":"by ",1:"")_MDBY_")",72,2)
+322 ;
+323 ;Process each wrapped line
+324 SET WRAP=""
FOR LINE=1:1
SET WRAP=$ORDER(WRAP(WRAP))
IF WRAP=""
QUIT
Begin DoDot:2
+325 SET II=II+1
SET RESULT(II)=$EXTRACT(SPACE,1,8)_WRAP(WRAP)
End DoDot:2
End DoDot:1
+326 ;
+327 QUIT
