BTPWPLND ;VNGT/HS/KML-GET PLANNED EVENTS ; 21 Sep 2009 12:00 PM
;;1.2;CARE MANAGEMENT EVENT TRACKING;;Jul 07, 2017;Build 71
;
GET(DATA,CNT,SRC,PARMS) ; EP - BTPW GET PLANNED EVENTS
; Input parameters
; CNT - Count of # of records to return
; SRC - Values to continue search on
; PARMS - Delimited list of input variables
; -> TMFRAME - Time frame
; -> CAT - Category
; -> COMM - Community
; -> COMMTX - Community Taxonomy
; -> CMIEN - List of Event IENs to Return
;
N UID,II,COMM,BJ,CIN,RESULT,QFL,CT,VALUE,WHEN,WHO,TRN,STAGE,HDR,CLOSE,CATLST,CMIEN
N FDUE,NDUE,PCOM,PREV,PRVIEN,RDUE
S UID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S DATA=$NA(^TMP("BTPWPLND",UID))
K @DATA
I $G(DT)=""!($G(U)="") D DT^DICRW
;
S II=0
NEW $ESTACK,$ETRAP S $ETRAP="D ERR^BTPWPLND D UNWIND^%ZTER" ; SAC 2006 2.2.3.3.2
;
;Re-Assemble parameter list if in an array
S PARMS=$G(PARMS,"")
I PARMS="" D
. N LIST,BN
. S LIST="",BN=""
. F S BN=$O(PARMS(BN)) Q:BN="" S LIST=LIST_PARMS(BN)
. K PARMS
. S PARMS=LIST
. K LIST
;
;Set up incoming variables
S (CAT,TMFRAME,COMM,COMMTX,CMIEN)=""
F BJ=1:1:$L(PARMS,$C(28)) D Q:$G(BMXSEC)'=""
.N PDATA,NAME,VALUE,BP,BV
.S PDATA=$P(PARMS,$C(28),BJ) Q:PDATA=""
.S NAME=$P(PDATA,"=",1) Q:NAME=""
.S VALUE=$P(PDATA,"=",2,99) Q:VALUE=""
.F BP=1:1:$L(VALUE,$C(29)) S BV=$P(VALUE,$C(29),BP),@NAME=@NAME_$S(BP=1:"",1:$C(29))_BV
;
;Initialize/save original values
S SRC=$G(SRC,"")
S CNT=+$G(CNT)
;
;Set up search beginning/end dates
S (BDT,EDT)=""
I (TMFRAME'="")&(TMFRAME'="Ever") D ; treat "Ever" timeframe like null value
. I TMFRAME="Past Due" S EDT=DT_U_1 Q
. S BDT=DT
. S EDT=$$DATE^BQIUL1(TMFRAME)
;
;Set up Category List Array
I CAT'="",CAT'=0 D
. F BJ=1:1:$L(CAT,$C(29)) S CIN=$P(CAT,$C(29),BJ),CATLST(CIN)=""
;
;Set up Community Taxonomy
I COMMTX'="" D
. N CM,TREF
. S TREF="COMM" K @TREF
. D BLD^BQITUTL(COMMTX,TREF)
. S (COMM,CM)="" F S CM=$O(COMM(CM)) Q:CM="" S COMM=$G(COMM)_$S($G(COMM)]"":$C(29),1:"")_CM K COMM(CM)
;
;Set up Community List Array
I COMM'="" D
. F BJ=1:1:$L(COMM,$C(29)) S CIN=$P(COMM,$C(29),BJ),COMM(CIN)=$P(^AUTTCOM(CIN,0),U,1)
;
;Define Header
D HDR
S @DATA@(0)=HDR_$C(30) ; set up the zero subscript of the record
;
S QFL=0
;
;Search 1 - List of CMIENs
I $G(CMIEN)'="" D CMIEN(CMIEN,.COMM,SRC) G DONE
;
;Search 2 - COMMUNITY, STATE, DUE BY DATE - NOW INACTIVE
;I COMM'="",TMFRAME'="" D CMSTVD(BDT,EDT,.COMM,.CATLST,SRC) G DONE
;
;Search 3 - CATEGORY, STATE, DUE BY DATE
I CAT'="",TMFRAME'="" D CSVD(CAT,.COMM,BDT,EDT,SRC) G DONE
;
;Search 4 - STATE, DUE BY DATE
I TMFRAME'="" D SV(.COMM,BDT,EDT,SRC) G DONE
;
;Search 5 - CATEGORY, STATE
I CAT'="" D STCT(.COMM,.CATLST,CAT,SRC) G DONE
;
;Search 6 - STATE
D ST(.COMM,SRC)
;
DONE ;
I II=0,'$D(@DATA@(II)) S:$E(HDR,$L(HDR))="^" HDR=$E(HDR,1,$L(HDR)-1) S @DATA@(II)=HDR_$C(30)
S II=II+1,@DATA@(II)=$C(31)
Q
;
CMIEN(CMIEN,COMM,OSRC) ; EP - Search 1 - List of IENs
N IEN,CT,LII,ISTRT,IFND,ILST,ITSP,RESULT,SRC
;
;Pull the last record info
S IEN=$G(OSRC)
;
S CT=0
;
;Loop through the CMIEN list (at selected point) and retrieve records
S ISTRT=1 I IEN]"" F IFND=1:1:$L(CMIEN,$C(29)) I $P(CMIEN,$C(29),IFND)=IEN S ISTRT=IFND
F ITSP=ISTRT:1:$L(CMIEN,$C(29)) S IEN=$P(CMIEN,$C(29),ITSP) D Q:QFL
. ;
. S SRC=IEN
. ;
. ;Get Event Information
. D SNG^BTPWPLN1(IEN,.COMM,.RESULT) I RESULT="" Q
. S CT=CT+1 I CNT,CT=CNT S QFL=1
. S II=II+1,@DATA@(II)=RESULT_U_SRC_$C(30)
Q
;
CMSTVD(BDT,EDT,COMM,CTLST,OSRC) ; EP - Search 2 - COMMUNITY, STATE, DUE BY DATE - NOW INACTIVE
N CMIEN,CM,SBDT,CT,COMP,CSTRT,CFND,STSP,SRC,RESULT,PASTEV
S PASTEV=0 ; past events check
S:$P(EDT,U,2) PASTEV=$P(EDT,U,2),EDT=$P(EDT,U)
;
;Pull the last record info
S CSTRT=1,CM=$P(OSRC,$C(29),3) I CM]"" F CFND=1:1:$L(COMM,$C(29)) I $P(COMM,$C(29),CFND)=CM S CSTRT=CFND
S:$P(OSRC,$C(29),2)'="" SBDT=$P(OSRC,$C(29),2)
S CMIEN=$P(OSRC,$C(29),1)
S CT=0 ; number of records retrieved counter
;
;Loop through index (at selected point) and retrieve records
S SBDT=$S($G(SBDT)]"":SBDT-.001,BDT]"":BDT-.001,1:"")
F COMP=CSTRT:1:$L(COMM,$C(29)) S CM=$P(COMM,$C(29),COMP) D Q:QFL
. F S SBDT=$O(^BTPWP("AP",CM,"F",SBDT)) Q:(SBDT="") Q:('PASTEV)&(SBDT>EDT) Q:(PASTEV)&(SBDT'<EDT) D Q:QFL
.. F S CMIEN=$O(^BTPWP("AP",CM,"F",SBDT,CMIEN)) Q:CMIEN="" D Q:QFL
... S SRC=CMIEN_$C(29)_SBDT_$C(29)_CM
... ;
... ;Check for CATEGORY - if passed
... N CTG,CTGCHK S CTGCHK=1
... I $D(CTLST) D Q:'CTGCHK
.... S CTG=$$GET1^DIQ(90620,CMIEN_",",.12,"I")
.... I CTG]"",$D(CTLST(CTG)) Q
.... S CTGCHK=0
... K CTG,CTGCHK
... ;
... ;Get Event Information
... D SNG^BTPWPLN1(CMIEN,.COMM,.RESULT) I RESULT="" Q
... S CT=CT+1 I CNT'=0,CT=CNT S QFL=1
... S II=II+1,@DATA@(II)=RESULT_U_SRC_$C(30)
. S SBDT=$S(BDT]"":BDT-.001,1:"") ;Reset to original start date
Q
;
CSVD(CAT,COMM,BDT,EDT,OSRC) ; EP - Search 3 - CATEGORY, STATE, DUE BY DATE
N CMIEN,SBDT,CT,CATP,CSTRT,CFND,STSP,SRC,PASTEV
S PASTEV=0 ; past events check
S:$P(EDT,U,2) PASTEV=$P(EDT,U,2),EDT=$P(EDT,U)
;
;Pull the last record info
S CSTRT=1,CTG=$P(OSRC,$C(29),3) I CTG]"" F CFND=1:1:$L(CAT,$C(29)) I $P(CAT,$C(29),CFND)=CTG S CSTRT=CFND
S:$P(OSRC,$C(29),2)'="" SBDT=$P(OSRC,$C(29),2)
S CMIEN=$P(OSRC,$C(29),1)
S CT=0 ; number of records retrieved counter
;
;Loop through index (at selected point) and retrieve records
S SBDT=$S($G(SBDT)]"":SBDT-.001,BDT]"":BDT-.001,1:"")
F CATP=CSTRT:1:$L(CAT,$C(29)) S CTG=$P(CAT,$C(29),CATP) D Q:QFL
. F S SBDT=$O(^BTPWP("AN",CTG,"F",SBDT)) Q:(SBDT="") Q:('PASTEV)&(SBDT>EDT) Q:(PASTEV)&(SBDT'<EDT) D Q:QFL
.. F S CMIEN=$O(^BTPWP("AN",CTG,"F",SBDT,CMIEN)) Q:CMIEN="" D Q:QFL
... S SRC=CMIEN_$C(29)_SBDT_$C(29)_CTG
... D SNG^BTPWPLN1(CMIEN,.COMM,.RESULT) Q:RESULT=""
... S CT=CT+1 I CNT,CT=CNT S QFL=1 ; number of records retrieved has met the max cnt needed
... S II=II+1,@DATA@(II)=RESULT_U_SRC_$C(30)
. S SBDT=$S(BDT]"":BDT-.001,1:"") ;Reset to original start date
Q
;
SV(COMM,BDT,EDT,OSRC) ; EP - Search 4 - STATE, DUE BY DATE
N CMIEN,SBDT,CT,SRC,PASTEV
S PASTEV=0 ; past events check
S:$P(EDT,U,2) PASTEV=$P(EDT,U,2),EDT=$P(EDT,U)
;
;Pull the last record info
S:$P(OSRC,$C(29),2)'="" SBDT=$P(OSRC,$C(29),2)
S CMIEN=$P(OSRC,$C(29),1)
S CT=0 ; number of records retrieved counter
;
;Loop through index (at selected point) and retrieve records
S SBDT=$S($G(SBDT)]"":SBDT-.001,BDT]"":BDT-.001,1:"")
F S SBDT=$O(^BTPWP("AO","F",SBDT)) Q:(SBDT="") Q:('PASTEV)&(SBDT>EDT) Q:(PASTEV)&(SBDT'<EDT) D Q:QFL
. F S CMIEN=$O(^BTPWP("AO","F",SBDT,CMIEN)) Q:CMIEN="" D Q:QFL
.. S SRC=CMIEN_$C(29)_SBDT
.. D SNG^BTPWPLN1(CMIEN,.COMM,.RESULT) Q:RESULT=""
.. S CT=CT+1 I CNT,CT=CNT S QFL=1 ; number of records retrieved has met the max cnt needed
.. S II=II+1,@DATA@(II)=RESULT_U_SRC_$C(30)
S SBDT=$S(BDT]"":BDT-.001,1:"") ;Reset to original start date
Q
;
STCT(COMM,CTLST,CAT,OSRC) ;EP - Search 5 - CATEGORY, STATE
N CMIEN,SRC,CSTRT,CFND,CATP,CT,CTG
;
;Pull the last record info
S CSTRT=1,CTG=$P(OSRC,$C(29),2) I CTG]"" F CFND=1:1:$L(CAT,$C(29)) I $P(CAT,$C(29),CFND)=CTG S CSTRT=CFND
S CMIEN=$P(OSRC,$C(29),1),QFL=0
S CT=0 ; number of records retrieved counter
;
;Loop through index (at selected point) and retrieve records
F CATP=CSTRT:1:$L(CAT,$C(29)) S CTG=$P(CAT,$C(29),CATP) D Q:QFL
. F S CMIEN=$O(^BTPWP("AF",CTG,"F",CMIEN)) Q:CMIEN="" D Q:QFL
.. ;
.. ;Get Event Information
.. D SNG^BTPWPLN1(CMIEN,.COMM,.RESULT) I RESULT="" Q
.. S SRC=CMIEN_$C(29)_CTG
.. S CT=CT+1 I CNT'=0,CT=CNT S QFL=1 ; number of records retrieved has met the max cnt needed
.. S II=II+1,@DATA@(II)=RESULT_U_SRC_$C(30)
Q
;
ST(COMM,OSRC) ;EP - Search 6 - search on STATE
N CMIEN,CT,SRC,RESULT
;
;Pull the last record info
S CMIEN=$P(OSRC,$C(29),1),CT=0,QFL=0
;Loop through index (at selected point) and retrieve records
F S CMIEN=$O(^BTPWP("AC","F",CMIEN)) Q:CMIEN="" D Q:QFL
. S SRC=CMIEN_$C(29)
. D SNG^BTPWPLN1(CMIEN,.COMM,.RESULT) Q:RESULT=""
. S CT=CT+1 I CNT,CT=CNT S QFL=1
. S II=II+1,@DATA@(II)=RESULT_U_SRC_$C(30)
Q
;
HDR ;
S HDR="I00010HIDE_CMET_IEN^T00040CATEGORY^I00010HIDE_DFN^T00001SENS_FLAG^T00035PATIENT_NAME^T00030HRN^D00015DOB^T00010AGE^T00001SEX"
S HDR=HDR_"^T00001COMM_FLAG^T00050COMMUNITY^T00060PLANNED_EVENT^D00015PLANNED_EVNT_DATE^D00030PRECEDING_EVENT^I00010HIDE_PREVIOUS_EVENT^T00060HIDE_PRVEVT^T00001ORDERED^T00030HIDE_ORD_NUM^D00030HIDE_ORD_DT^T01024HIDE_SEARCH"
Q
;
ERR ;
D ^%ZTER
NEW Y,ERRDTM
S Y=$$NOW^XLFDT() X ^DD("DD") S ERRDTM=Y
S BMXSEC="Recording that an error occurred at "_ERRDTM
S II=II+1,@DATA@(II)=$C(31)
Q
;
EVTS(TIEN) ;EP - Calculate Event Summary Column Values - Executable code 90506.1 BTPWTEVS entry
N EVT,PROC,PRCDT,EVLMB,EVLMD,CVAR,WP,CIEN,CLN
;
S EVT="TEST VALUE FOR COLUMN"
S PROC=$$GET1^DIQ(90620,TIEN_",",.01,"E") ;Procedure/Name (Event)
S PRCDT=$$FMTE^BQIUL1($$GET1^DIQ(90620,TIEN_",",.03,"I")) ;Event Date
S EVLMB=$$GET1^DIQ(90620,TIEN_",",1.03,"E") ;Event Tracked By
S EVLMD=$$FMTE^BQIUL1($$GET1^DIQ(90620,TIEN_",",1.02,"I")) ;Event Tracked Date
S EVT="Event Name: "_PROC
S EVT=EVT_$C(13)_$C(10)_"Event Date: "_PRCDT
;
;Pull previous history value
S CVAR=$$GET1^DIQ(90620,TIEN_",",4,"","WP")
;
;Pull Event Comment Field
S FCOM=""
S CIEN=0 F CLN=1:1 S CIEN=$O(WP(CIEN)) Q:'CIEN D
. S FCOM=$G(WP(CIEN))
. S:CLN=1 EVT=EVT_$C(13)_$C(10)_"Event Comments:"
. S:FCOM]"" EVT=EVT_$C(13)_$C(10)_FCOM
;
S EVT=EVT_$C(13)_$C(10)_"Event Tracked By: "_EVLMB
S EVT=EVT_$C(13)_$C(10)_"Event Tracked Date/Time: "_EVLMD
;
Q EVT
;
FNDS(TIEN) ;EP - Calculate Findings - Executable code for 90506.1 BTPWTFDA entry
N FDATA,FVAL,FCOM,FIEN,CIEN,CLN
D GETS^DIQ(90620,TIEN_",","10*","IE","FDATA")
;
S FVAL="",FIEN=0 F S FIEN=$O(FDATA(90620.01,FIEN)) Q:FIEN="" D
. ;
. ;Skip ENTERED IN ERROR
. I $G(FDATA(90620.01,FIEN,".08","I"))="Y" Q
. ;
. S:FVAL]"" FVAL=FVAL_$C(13)_$C(10)_$C(13)_$C(10)
. ;
. S FVAL=FVAL_"Finding: "_$E($G(FDATA(90620.01,FIEN,".02","E")),1,35) ;Finding
. ;S FVAL=FVAL_" Interpretation: "_$E($G(FDATA(90620.01,FIEN,".03","E")),1,15) ;Finding Interpretation
. ;S FVAL=FVAL_$C(13)_$C(10)_"Finding Date: "_$E($$FMTE^BQIUL1($P($G(FDATA(90620.01,FIEN,".01","I")),".")),1,11) ;Finding Date
. S FVAL=FVAL_$C(13)_$C(10)_"Finding Date: "_$$FMTE^BQIUL1($G(FDATA(90620.01,FIEN,".01","I"))\1)
. ;
. ;Pull Comment Field
. S FCOM=""
. S CIEN=0 F CLN=1:1 S CIEN=$O(FDATA(90620.01,FIEN,1,CIEN)) Q:'CIEN D
.. S FCOM=$G(FDATA(90620.01,FIEN,1,CIEN))
.. S:CLN=1 FVAL=FVAL_$C(13)_$C(10)_"Finding Comments:"
.. S FVAL=FVAL_$C(13)_$C(10)_FCOM
. ;
. S FVAL=FVAL_$C(13)_$C(10)_"Finding Entered By: "_$E($G(FDATA(90620.01,FIEN,".05","E")),1,26) ;Last Modified By
. S FVAL=FVAL_$C(13)_$C(10)_"Finding Entered Date/Time: "_$$FMTE^BQIUL1($G(FDATA(90620.01,FIEN,".04","I"))) ;Last Modified Date
. ;
Q FVAL
;
FUPS(TIEN) ;EP - Calculate Follow-Ups(s) Field
;
N FDATA,FUP,FCOM,FIEN,CIEN,CLN
D GETS^DIQ(90620,TIEN_",","12*","IE","FDATA")
;
S FUP=""
S FIEN="" F S FIEN=$O(FDATA(90620.012,FIEN)) Q:FIEN="" D
. ;
. ;Skip ENTERED IN ERROR
. I $G(FDATA(90620.012,FIEN,".07","I"))="Y" Q
. ;
. S:FUP]"" FUP=FUP_$C(13)_$C(10)_$C(13)_$C(10)
. S FUP=FUP_"Follow-up: "_$G(FDATA(90620.012,FIEN,".02","E")) ;Follow-up
. ;S FUP=FUP_$C(13)_$C(10)_"Follow-up Due Date: "_$E($$FMTE^BQIUL1($P($G(FDATA(90620.012,FIEN,".05","I")),".")),1,11) ;Follow-up Due Date
. S FUP=FUP_$C(13)_$C(10)_"Follow-up Due Date: "_$$FMTE^BQIUL1($G(FDATA(90620.012,FIEN,".05","I"))\1)
. ;
. ;Pull Comment Field
. S FCOM=""
. S CIEN=0 F CLN=1:1 S CIEN=$O(FDATA(90620.012,FIEN,1,CIEN)) Q:'CIEN D
.. S FCOM=$G(FDATA(90620.012,FIEN,1,CIEN))
.. S:CLN=1 FUP=FUP_$C(13)_$C(10)_"Follow-up Comments:"
.. S FUP=FUP_$C(13)_$C(10)_FCOM
. ;
. S FUP=FUP_$C(13)_$C(10)_"Follow-up Entered By: "_$G(FDATA(90620.012,FIEN,".04","E")) ;Follow-up Entered By
. S FUP=FUP_$C(13)_$C(10)_"Date Follow-up Entered: "_$$FMTE^BQIUL1($P($G(FDATA(90620.012,FIEN,".03","I")),".")) ;Follow-up Entered Date
. ;
Q FUP
;
NOTS(TIEN) ;EP - Calculate Notification(s) Field
;
N FDATA,NOT,FCOM,FIEN,CIEN,FCOM,CLN
D GETS^DIQ(90620,TIEN_",","11*","IE","FDATA")
;
S NOT=""
S FIEN="" F S FIEN=$O(FDATA(90620.011,FIEN)) Q:FIEN="" D
. ;
. ;Skip ENTERED IN ERROR
. I $G(FDATA(90620.011,FIEN,".09","I"))="Y" Q
. ;
. S:NOT]"" NOT=NOT_$C(13)_$C(10)_$C(13)_$C(10)
. S NOT=NOT_"Patient Notification: "_$G(FDATA(90620.011,FIEN,".02","E")) ;Type
. S NOT=NOT_$C(13)_$C(10)_"Patient Notification Date: "_$$FMTE^BQIUL1($P($G(FDATA(90620.011,FIEN,".01","I")),".")) ;Notification Date
. ;
. ;Pull Comment Field
. S FCOM=""
. S CIEN=0 F CLN=1:1 S CIEN=$O(FDATA(90620.011,FIEN,1,CIEN)) Q:'CIEN D
.. S FCOM=$G(FDATA(90620.011,FIEN,1,CIEN))
.. S:CLN=1 NOT=NOT_$C(13)_$C(10)_"Patient Notification Comments:"
.. S NOT=NOT_$C(13)_$C(10)_FCOM
. ;
. S NOT=NOT_$C(13)_$C(10)_"Patient Notification Entered By: "_$G(FDATA(90620.011,FIEN,".04","E")) ;Notification Entered By
. S NOT=NOT_$C(13)_$C(10)_"Date Patient Notification Entered: "_$$FMTE^BQIUL1($P($G(FDATA(90620.011,FIEN,".03","I")),".")) ;Notification Entered Date
Q NOT
BTPWPLND ;VNGT/HS/KML-GET PLANNED EVENTS ; 21 Sep 2009 12:00 PM
+1 ;;1.2;CARE MANAGEMENT EVENT TRACKING;;Jul 07, 2017;Build 71
+2 ;
GET(DATA,CNT,SRC,PARMS) ; EP - BTPW GET PLANNED EVENTS
+1 ; Input parameters
+2 ; CNT - Count of # of records to return
+3 ; SRC - Values to continue search on
+4 ; PARMS - Delimited list of input variables
+5 ; -> TMFRAME - Time frame
+6 ; -> CAT - Category
+7 ; -> COMM - Community
+8 ; -> COMMTX - Community Taxonomy
+9 ; -> CMIEN - List of Event IENs to Return
+10 ;
+11 NEW UID,II,COMM,BJ,CIN,RESULT,QFL,CT,VALUE,WHEN,WHO,TRN,STAGE,HDR,CLOSE,CATLST,CMIEN
+12 NEW FDUE,NDUE,PCOM,PREV,PRVIEN,RDUE
+13 SET UID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+14 SET DATA=$NAME(^TMP("BTPWPLND",UID))
+15 KILL @DATA
+16 IF $GET(DT)=""!($GET(U)="")
DO DT^DICRW
+17 ;
+18 SET II=0
+19 ; SAC 2006 2.2.3.3.2
NEW $ESTACK,$ETRAP
SET $ETRAP="D ERR^BTPWPLND D UNWIND^%ZTER"
+20 ;
+21 ;Re-Assemble parameter list if in an array
+22 SET PARMS=$GET(PARMS,"")
+23 IF PARMS=""
Begin DoDot:1
+24 NEW LIST,BN
+25 SET LIST=""
SET BN=""
+26 FOR
SET BN=$ORDER(PARMS(BN))
IF BN=""
QUIT
SET LIST=LIST_PARMS(BN)
+27 KILL PARMS
+28 SET PARMS=LIST
+29 KILL LIST
End DoDot:1
+30 ;
+31 ;Set up incoming variables
+32 SET (CAT,TMFRAME,COMM,COMMTX,CMIEN)=""
+33 FOR BJ=1:1:$LENGTH(PARMS,$CHAR(28))
Begin DoDot:1
+34 NEW PDATA,NAME,VALUE,BP,BV
+35 SET PDATA=$PIECE(PARMS,$CHAR(28),BJ)
IF PDATA=""
QUIT
+36 SET NAME=$PIECE(PDATA,"=",1)
IF NAME=""
QUIT
+37 SET VALUE=$PIECE(PDATA,"=",2,99)
IF VALUE=""
QUIT
+38 FOR BP=1:1:$LENGTH(VALUE,$CHAR(29))
SET BV=$PIECE(VALUE,$CHAR(29),BP)
SET @NAME=@NAME_$SELECT(BP=1:"",1:$CHAR(29))_BV
End DoDot:1
IF $GET(BMXSEC)'=""
QUIT
+39 ;
+40 ;Initialize/save original values
+41 SET SRC=$GET(SRC,"")
+42 SET CNT=+$GET(CNT)
+43 ;
+44 ;Set up search beginning/end dates
+45 SET (BDT,EDT)=""
+46 ; treat "Ever" timeframe like null value
IF (TMFRAME'="")&(TMFRAME'="Ever")
Begin DoDot:1
+47 IF TMFRAME="Past Due"
SET EDT=DT_U_1
QUIT
+48 SET BDT=DT
+49 SET EDT=$$DATE^BQIUL1(TMFRAME)
End DoDot:1
+50 ;
+51 ;Set up Category List Array
+52 IF CAT'=""
IF CAT'=0
Begin DoDot:1
+53 FOR BJ=1:1:$LENGTH(CAT,$CHAR(29))
SET CIN=$PIECE(CAT,$CHAR(29),BJ)
SET CATLST(CIN)=""
End DoDot:1
+54 ;
+55 ;Set up Community Taxonomy
+56 IF COMMTX'=""
Begin DoDot:1
+57 NEW CM,TREF
+58 SET TREF="COMM"
KILL @TREF
+59 DO BLD^BQITUTL(COMMTX,TREF)
+60 SET (COMM,CM)=""
FOR
SET CM=$ORDER(COMM(CM))
IF CM=""
QUIT
SET COMM=$GET(COMM)_$SELECT($GET(COMM)]"":$CHAR(29),1:"")_CM
KILL COMM(CM)
End DoDot:1
+61 ;
+62 ;Set up Community List Array
+63 IF COMM'=""
Begin DoDot:1
+64 FOR BJ=1:1:$LENGTH(COMM,$CHAR(29))
SET CIN=$PIECE(COMM,$CHAR(29),BJ)
SET COMM(CIN)=$PIECE(^AUTTCOM(CIN,0),U,1)
End DoDot:1
+65 ;
+66 ;Define Header
+67 DO HDR
+68 ; set up the zero subscript of the record
SET @DATA@(0)=HDR_$CHAR(30)
+69 ;
+70 SET QFL=0
+71 ;
+72 ;Search 1 - List of CMIENs
+73 IF $GET(CMIEN)'=""
DO CMIEN(CMIEN,.COMM,SRC)
GOTO DONE
+74 ;
+75 ;Search 2 - COMMUNITY, STATE, DUE BY DATE - NOW INACTIVE
+76 ;I COMM'="",TMFRAME'="" D CMSTVD(BDT,EDT,.COMM,.CATLST,SRC) G DONE
+77 ;
+78 ;Search 3 - CATEGORY, STATE, DUE BY DATE
+79 IF CAT'=""
IF TMFRAME'=""
DO CSVD(CAT,.COMM,BDT,EDT,SRC)
GOTO DONE
+80 ;
+81 ;Search 4 - STATE, DUE BY DATE
+82 IF TMFRAME'=""
DO SV(.COMM,BDT,EDT,SRC)
GOTO DONE
+83 ;
+84 ;Search 5 - CATEGORY, STATE
+85 IF CAT'=""
DO STCT(.COMM,.CATLST,CAT,SRC)
GOTO DONE
+86 ;
+87 ;Search 6 - STATE
+88 DO ST(.COMM,SRC)
+89 ;
DONE ;
+1 IF II=0
IF '$DATA(@DATA@(II))
IF $EXTRACT(HDR,$LENGTH(HDR))="^"
SET HDR=$EXTRACT(HDR,1,$LENGTH(HDR)-1)
SET @DATA@(II)=HDR_$CHAR(30)
+2 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+3 QUIT
+4 ;
CMIEN(CMIEN,COMM,OSRC) ; EP - Search 1 - List of IENs
+1 NEW IEN,CT,LII,ISTRT,IFND,ILST,ITSP,RESULT,SRC
+2 ;
+3 ;Pull the last record info
+4 SET IEN=$GET(OSRC)
+5 ;
+6 SET CT=0
+7 ;
+8 ;Loop through the CMIEN list (at selected point) and retrieve records
+9 SET ISTRT=1
IF IEN]""
FOR IFND=1:1:$LENGTH(CMIEN,$CHAR(29))
IF $PIECE(CMIEN,$CHAR(29),IFND)=IEN
SET ISTRT=IFND
+10 FOR ITSP=ISTRT:1:$LENGTH(CMIEN,$CHAR(29))
SET IEN=$PIECE(CMIEN,$CHAR(29),ITSP)
Begin DoDot:1
+11 ;
+12 SET SRC=IEN
+13 ;
+14 ;Get Event Information
+15 DO SNG^BTPWPLN1(IEN,.COMM,.RESULT)
IF RESULT=""
QUIT
+16 SET CT=CT+1
IF CNT
IF CT=CNT
SET QFL=1
+17 SET II=II+1
SET @DATA@(II)=RESULT_U_SRC_$CHAR(30)
End DoDot:1
IF QFL
QUIT
+18 QUIT
+19 ;
CMSTVD(BDT,EDT,COMM,CTLST,OSRC) ; EP - Search 2 - COMMUNITY, STATE, DUE BY DATE - NOW INACTIVE
+1 NEW CMIEN,CM,SBDT,CT,COMP,CSTRT,CFND,STSP,SRC,RESULT,PASTEV
+2 ; past events check
SET PASTEV=0
+3 IF $PIECE(EDT,U,2)
SET PASTEV=$PIECE(EDT,U,2)
SET EDT=$PIECE(EDT,U)
+4 ;
+5 ;Pull the last record info
+6 SET CSTRT=1
SET CM=$PIECE(OSRC,$CHAR(29),3)
IF CM]""
FOR CFND=1:1:$LENGTH(COMM,$CHAR(29))
IF $PIECE(COMM,$CHAR(29),CFND)=CM
SET CSTRT=CFND
+7 IF $PIECE(OSRC,$CHAR(29),2)'=""
SET SBDT=$PIECE(OSRC,$CHAR(29),2)
+8 SET CMIEN=$PIECE(OSRC,$CHAR(29),1)
+9 ; number of records retrieved counter
SET CT=0
+10 ;
+11 ;Loop through index (at selected point) and retrieve records
+12 SET SBDT=$SELECT($GET(SBDT)]"":SBDT-.001,BDT]"":BDT-.001,1:"")
+13 FOR COMP=CSTRT:1:$LENGTH(COMM,$CHAR(29))
SET CM=$PIECE(COMM,$CHAR(29),COMP)
Begin DoDot:1
+14 FOR
SET SBDT=$ORDER(^BTPWP("AP",CM,"F",SBDT))
IF (SBDT="")
QUIT
IF ('PASTEV)&(SBDT>EDT)
QUIT
IF (PASTEV)&(SBDT'<EDT)
QUIT
Begin DoDot:2
+15 FOR
SET CMIEN=$ORDER(^BTPWP("AP",CM,"F",SBDT,CMIEN))
IF CMIEN=""
QUIT
Begin DoDot:3
+16 SET SRC=CMIEN_$CHAR(29)_SBDT_$CHAR(29)_CM
+17 ;
+18 ;Check for CATEGORY - if passed
+19 NEW CTG,CTGCHK
SET CTGCHK=1
+20 IF $DATA(CTLST)
Begin DoDot:4
+21 SET CTG=$$GET1^DIQ(90620,CMIEN_",",.12,"I")
+22 IF CTG]""
IF $DATA(CTLST(CTG))
QUIT
+23 SET CTGCHK=0
End DoDot:4
IF 'CTGCHK
QUIT
+24 KILL CTG,CTGCHK
+25 ;
+26 ;Get Event Information
+27 DO SNG^BTPWPLN1(CMIEN,.COMM,.RESULT)
IF RESULT=""
QUIT
+28 SET CT=CT+1
IF CNT'=0
IF CT=CNT
SET QFL=1
+29 SET II=II+1
SET @DATA@(II)=RESULT_U_SRC_$CHAR(30)
End DoDot:3
IF QFL
QUIT
End DoDot:2
IF QFL
QUIT
+30 ;Reset to original start date
SET SBDT=$SELECT(BDT]"":BDT-.001,1:"")
End DoDot:1
IF QFL
QUIT
+31 QUIT
+32 ;
CSVD(CAT,COMM,BDT,EDT,OSRC) ; EP - Search 3 - CATEGORY, STATE, DUE BY DATE
+1 NEW CMIEN,SBDT,CT,CATP,CSTRT,CFND,STSP,SRC,PASTEV
+2 ; past events check
SET PASTEV=0
+3 IF $PIECE(EDT,U,2)
SET PASTEV=$PIECE(EDT,U,2)
SET EDT=$PIECE(EDT,U)
+4 ;
+5 ;Pull the last record info
+6 SET CSTRT=1
SET CTG=$PIECE(OSRC,$CHAR(29),3)
IF CTG]""
FOR CFND=1:1:$LENGTH(CAT,$CHAR(29))
IF $PIECE(CAT,$CHAR(29),CFND)=CTG
SET CSTRT=CFND
+7 IF $PIECE(OSRC,$CHAR(29),2)'=""
SET SBDT=$PIECE(OSRC,$CHAR(29),2)
+8 SET CMIEN=$PIECE(OSRC,$CHAR(29),1)
+9 ; number of records retrieved counter
SET CT=0
+10 ;
+11 ;Loop through index (at selected point) and retrieve records
+12 SET SBDT=$SELECT($GET(SBDT)]"":SBDT-.001,BDT]"":BDT-.001,1:"")
+13 FOR CATP=CSTRT:1:$LENGTH(CAT,$CHAR(29))
SET CTG=$PIECE(CAT,$CHAR(29),CATP)
Begin DoDot:1
+14 FOR
SET SBDT=$ORDER(^BTPWP("AN",CTG,"F",SBDT))
IF (SBDT="")
QUIT
IF ('PASTEV)&(SBDT>EDT)
QUIT
IF (PASTEV)&(SBDT'<EDT)
QUIT
Begin DoDot:2
+15 FOR
SET CMIEN=$ORDER(^BTPWP("AN",CTG,"F",SBDT,CMIEN))
IF CMIEN=""
QUIT
Begin DoDot:3
+16 SET SRC=CMIEN_$CHAR(29)_SBDT_$CHAR(29)_CTG
+17 DO SNG^BTPWPLN1(CMIEN,.COMM,.RESULT)
IF RESULT=""
QUIT
+18 ; number of records retrieved has met the max cnt needed
SET CT=CT+1
IF CNT
IF CT=CNT
SET QFL=1
+19 SET II=II+1
SET @DATA@(II)=RESULT_U_SRC_$CHAR(30)
End DoDot:3
IF QFL
QUIT
End DoDot:2
IF QFL
QUIT
+20 ;Reset to original start date
SET SBDT=$SELECT(BDT]"":BDT-.001,1:"")
End DoDot:1
IF QFL
QUIT
+21 QUIT
+22 ;
SV(COMM,BDT,EDT,OSRC) ; EP - Search 4 - STATE, DUE BY DATE
+1 NEW CMIEN,SBDT,CT,SRC,PASTEV
+2 ; past events check
SET PASTEV=0
+3 IF $PIECE(EDT,U,2)
SET PASTEV=$PIECE(EDT,U,2)
SET EDT=$PIECE(EDT,U)
+4 ;
+5 ;Pull the last record info
+6 IF $PIECE(OSRC,$CHAR(29),2)'=""
SET SBDT=$PIECE(OSRC,$CHAR(29),2)
+7 SET CMIEN=$PIECE(OSRC,$CHAR(29),1)
+8 ; number of records retrieved counter
SET CT=0
+9 ;
+10 ;Loop through index (at selected point) and retrieve records
+11 SET SBDT=$SELECT($GET(SBDT)]"":SBDT-.001,BDT]"":BDT-.001,1:"")
+12 FOR
SET SBDT=$ORDER(^BTPWP("AO","F",SBDT))
IF (SBDT="")
QUIT
IF ('PASTEV)&(SBDT>EDT)
QUIT
IF (PASTEV)&(SBDT'<EDT)
QUIT
Begin DoDot:1
+13 FOR
SET CMIEN=$ORDER(^BTPWP("AO","F",SBDT,CMIEN))
IF CMIEN=""
QUIT
Begin DoDot:2
+14 SET SRC=CMIEN_$CHAR(29)_SBDT
+15 DO SNG^BTPWPLN1(CMIEN,.COMM,.RESULT)
IF RESULT=""
QUIT
+16 ; number of records retrieved has met the max cnt needed
SET CT=CT+1
IF CNT
IF CT=CNT
SET QFL=1
+17 SET II=II+1
SET @DATA@(II)=RESULT_U_SRC_$CHAR(30)
End DoDot:2
IF QFL
QUIT
End DoDot:1
IF QFL
QUIT
+18 ;Reset to original start date
SET SBDT=$SELECT(BDT]"":BDT-.001,1:"")
+19 QUIT
+20 ;
STCT(COMM,CTLST,CAT,OSRC) ;EP - Search 5 - CATEGORY, STATE
+1 NEW CMIEN,SRC,CSTRT,CFND,CATP,CT,CTG
+2 ;
+3 ;Pull the last record info
+4 SET CSTRT=1
SET CTG=$PIECE(OSRC,$CHAR(29),2)
IF CTG]""
FOR CFND=1:1:$LENGTH(CAT,$CHAR(29))
IF $PIECE(CAT,$CHAR(29),CFND)=CTG
SET CSTRT=CFND
+5 SET CMIEN=$PIECE(OSRC,$CHAR(29),1)
SET QFL=0
+6 ; number of records retrieved counter
SET CT=0
+7 ;
+8 ;Loop through index (at selected point) and retrieve records
+9 FOR CATP=CSTRT:1:$LENGTH(CAT,$CHAR(29))
SET CTG=$PIECE(CAT,$CHAR(29),CATP)
Begin DoDot:1
+10 FOR
SET CMIEN=$ORDER(^BTPWP("AF",CTG,"F",CMIEN))
IF CMIEN=""
QUIT
Begin DoDot:2
+11 ;
+12 ;Get Event Information
+13 DO SNG^BTPWPLN1(CMIEN,.COMM,.RESULT)
IF RESULT=""
QUIT
+14 SET SRC=CMIEN_$CHAR(29)_CTG
+15 ; number of records retrieved has met the max cnt needed
SET CT=CT+1
IF CNT'=0
IF CT=CNT
SET QFL=1
+16 SET II=II+1
SET @DATA@(II)=RESULT_U_SRC_$CHAR(30)
End DoDot:2
IF QFL
QUIT
End DoDot:1
IF QFL
QUIT
+17 QUIT
+18 ;
ST(COMM,OSRC) ;EP - Search 6 - search on STATE
+1 NEW CMIEN,CT,SRC,RESULT
+2 ;
+3 ;Pull the last record info
+4 SET CMIEN=$PIECE(OSRC,$CHAR(29),1)
SET CT=0
SET QFL=0
+5 ;Loop through index (at selected point) and retrieve records
+6 FOR
SET CMIEN=$ORDER(^BTPWP("AC","F",CMIEN))
IF CMIEN=""
QUIT
Begin DoDot:1
+7 SET SRC=CMIEN_$CHAR(29)
+8 DO SNG^BTPWPLN1(CMIEN,.COMM,.RESULT)
IF RESULT=""
QUIT
+9 SET CT=CT+1
IF CNT
IF CT=CNT
SET QFL=1
+10 SET II=II+1
SET @DATA@(II)=RESULT_U_SRC_$CHAR(30)
End DoDot:1
IF QFL
QUIT
+11 QUIT
+12 ;
HDR ;
+1 SET HDR="I00010HIDE_CMET_IEN^T00040CATEGORY^I00010HIDE_DFN^T00001SENS_FLAG^T00035PATIENT_NAME^T00030HRN^D00015DOB^T00010AGE^T00001SEX"
+2 SET HDR=HDR_"^T00001COMM_FLAG^T00050COMMUNITY^T00060PLANNED_EVENT^D00015PLANNED_EVNT_DATE^D00030PRECEDING_EVENT^I00010HIDE_PREVIOUS_EVENT^T00060HIDE_PRVEVT^T00001ORDERED^T00030HIDE_ORD_NUM^D00030HIDE_ORD_DT^T01024HIDE_SEARCH"
+3 QUIT
+4 ;
ERR ;
+1 DO ^%ZTER
+2 NEW Y,ERRDTM
+3 SET Y=$$NOW^XLFDT()
XECUTE ^DD("DD")
SET ERRDTM=Y
+4 SET BMXSEC="Recording that an error occurred at "_ERRDTM
+5 SET II=II+1
SET @DATA@(II)=$CHAR(31)
+6 QUIT
+7 ;
EVTS(TIEN) ;EP - Calculate Event Summary Column Values - Executable code 90506.1 BTPWTEVS entry
+1 NEW EVT,PROC,PRCDT,EVLMB,EVLMD,CVAR,WP,CIEN,CLN
+2 ;
+3 SET EVT="TEST VALUE FOR COLUMN"
+4 ;Procedure/Name (Event)
SET PROC=$$GET1^DIQ(90620,TIEN_",",.01,"E")
+5 ;Event Date
SET PRCDT=$$FMTE^BQIUL1($$GET1^DIQ(90620,TIEN_",",.03,"I"))
+6 ;Event Tracked By
SET EVLMB=$$GET1^DIQ(90620,TIEN_",",1.03,"E")
+7 ;Event Tracked Date
SET EVLMD=$$FMTE^BQIUL1($$GET1^DIQ(90620,TIEN_",",1.02,"I"))
+8 SET EVT="Event Name: "_PROC
+9 SET EVT=EVT_$CHAR(13)_$CHAR(10)_"Event Date: "_PRCDT
+10 ;
+11 ;Pull previous history value
+12 SET CVAR=$$GET1^DIQ(90620,TIEN_",",4,"","WP")
+13 ;
+14 ;Pull Event Comment Field
+15 SET FCOM=""
+16 SET CIEN=0
FOR CLN=1:1
SET CIEN=$ORDER(WP(CIEN))
IF 'CIEN
QUIT
Begin DoDot:1
+17 SET FCOM=$GET(WP(CIEN))
+18 IF CLN=1
SET EVT=EVT_$CHAR(13)_$CHAR(10)_"Event Comments:"
+19 IF FCOM]""
SET EVT=EVT_$CHAR(13)_$CHAR(10)_FCOM
End DoDot:1
+20 ;
+21 SET EVT=EVT_$CHAR(13)_$CHAR(10)_"Event Tracked By: "_EVLMB
+22 SET EVT=EVT_$CHAR(13)_$CHAR(10)_"Event Tracked Date/Time: "_EVLMD
+23 ;
+24 QUIT EVT
+25 ;
FNDS(TIEN) ;EP - Calculate Findings - Executable code for 90506.1 BTPWTFDA entry
+1 NEW FDATA,FVAL,FCOM,FIEN,CIEN,CLN
+2 DO GETS^DIQ(90620,TIEN_",","10*","IE","FDATA")
+3 ;
+4 SET FVAL=""
SET FIEN=0
FOR
SET FIEN=$ORDER(FDATA(90620.01,FIEN))
IF FIEN=""
QUIT
Begin DoDot:1
+5 ;
+6 ;Skip ENTERED IN ERROR
+7 IF $GET(FDATA(90620.01,FIEN,".08","I"))="Y"
QUIT
+8 ;
+9 IF FVAL]""
SET FVAL=FVAL_$CHAR(13)_$CHAR(10)_$CHAR(13)_$CHAR(10)
+10 ;
+11 ;Finding
SET FVAL=FVAL_"Finding: "_$EXTRACT($GET(FDATA(90620.01,FIEN,".02","E")),1,35)
+12 ;S FVAL=FVAL_" Interpretation: "_$E($G(FDATA(90620.01,FIEN,".03","E")),1,15) ;Finding Interpretation
+13 ;S FVAL=FVAL_$C(13)_$C(10)_"Finding Date: "_$E($$FMTE^BQIUL1($P($G(FDATA(90620.01,FIEN,".01","I")),".")),1,11) ;Finding Date
+14 SET FVAL=FVAL_$CHAR(13)_$CHAR(10)_"Finding Date: "_$$FMTE^BQIUL1($GET(FDATA(90620.01,FIEN,".01","I"))\1)
+15 ;
+16 ;Pull Comment Field
+17 SET FCOM=""
+18 SET CIEN=0
FOR CLN=1:1
SET CIEN=$ORDER(FDATA(90620.01,FIEN,1,CIEN))
IF 'CIEN
QUIT
Begin DoDot:2
+19 SET FCOM=$GET(FDATA(90620.01,FIEN,1,CIEN))
+20 IF CLN=1
SET FVAL=FVAL_$CHAR(13)_$CHAR(10)_"Finding Comments:"
+21 SET FVAL=FVAL_$CHAR(13)_$CHAR(10)_FCOM
End DoDot:2
+22 ;
+23 ;Last Modified By
SET FVAL=FVAL_$CHAR(13)_$CHAR(10)_"Finding Entered By: "_$EXTRACT($GET(FDATA(90620.01,FIEN,".05","E")),1,26)
+24 ;Last Modified Date
SET FVAL=FVAL_$CHAR(13)_$CHAR(10)_"Finding Entered Date/Time: "_$$FMTE^BQIUL1($GET(FDATA(90620.01,FIEN,".04","I")))
+25 ;
End DoDot:1
+26 QUIT FVAL
+27 ;
FUPS(TIEN) ;EP - Calculate Follow-Ups(s) Field
+1 ;
+2 NEW FDATA,FUP,FCOM,FIEN,CIEN,CLN
+3 DO GETS^DIQ(90620,TIEN_",","12*","IE","FDATA")
+4 ;
+5 SET FUP=""
+6 SET FIEN=""
FOR
SET FIEN=$ORDER(FDATA(90620.012,FIEN))
IF FIEN=""
QUIT
Begin DoDot:1
+7 ;
+8 ;Skip ENTERED IN ERROR
+9 IF $GET(FDATA(90620.012,FIEN,".07","I"))="Y"
QUIT
+10 ;
+11 IF FUP]""
SET FUP=FUP_$CHAR(13)_$CHAR(10)_$CHAR(13)_$CHAR(10)
+12 ;Follow-up
SET FUP=FUP_"Follow-up: "_$GET(FDATA(90620.012,FIEN,".02","E"))
+13 ;S FUP=FUP_$C(13)_$C(10)_"Follow-up Due Date: "_$E($$FMTE^BQIUL1($P($G(FDATA(90620.012,FIEN,".05","I")),".")),1,11) ;Follow-up Due Date
+14 SET FUP=FUP_$CHAR(13)_$CHAR(10)_"Follow-up Due Date: "_$$FMTE^BQIUL1($GET(FDATA(90620.012,FIEN,".05","I"))\1)
+15 ;
+16 ;Pull Comment Field
+17 SET FCOM=""
+18 SET CIEN=0
FOR CLN=1:1
SET CIEN=$ORDER(FDATA(90620.012,FIEN,1,CIEN))
IF 'CIEN
QUIT
Begin DoDot:2
+19 SET FCOM=$GET(FDATA(90620.012,FIEN,1,CIEN))
+20 IF CLN=1
SET FUP=FUP_$CHAR(13)_$CHAR(10)_"Follow-up Comments:"
+21 SET FUP=FUP_$CHAR(13)_$CHAR(10)_FCOM
End DoDot:2
+22 ;
+23 ;Follow-up Entered By
SET FUP=FUP_$CHAR(13)_$CHAR(10)_"Follow-up Entered By: "_$GET(FDATA(90620.012,FIEN,".04","E"))
+24 ;Follow-up Entered Date
SET FUP=FUP_$CHAR(13)_$CHAR(10)_"Date Follow-up Entered: "_$$FMTE^BQIUL1($PIECE($GET(FDATA(90620.012,FIEN,".03","I")),"."))
+25 ;
End DoDot:1
+26 QUIT FUP
+27 ;
NOTS(TIEN) ;EP - Calculate Notification(s) Field
+1 ;
+2 NEW FDATA,NOT,FCOM,FIEN,CIEN,FCOM,CLN
+3 DO GETS^DIQ(90620,TIEN_",","11*","IE","FDATA")
+4 ;
+5 SET NOT=""
+6 SET FIEN=""
FOR
SET FIEN=$ORDER(FDATA(90620.011,FIEN))
IF FIEN=""
QUIT
Begin DoDot:1
+7 ;
+8 ;Skip ENTERED IN ERROR
+9 IF $GET(FDATA(90620.011,FIEN,".09","I"))="Y"
QUIT
+10 ;
+11 IF NOT]""
SET NOT=NOT_$CHAR(13)_$CHAR(10)_$CHAR(13)_$CHAR(10)
+12 ;Type
SET NOT=NOT_"Patient Notification: "_$GET(FDATA(90620.011,FIEN,".02","E"))
+13 ;Notification Date
SET NOT=NOT_$CHAR(13)_$CHAR(10)_"Patient Notification Date: "_$$FMTE^BQIUL1($PIECE($GET(FDATA(90620.011,FIEN,".01","I")),"."))
+14 ;
+15 ;Pull Comment Field
+16 SET FCOM=""
+17 SET CIEN=0
FOR CLN=1:1
SET CIEN=$ORDER(FDATA(90620.011,FIEN,1,CIEN))
IF 'CIEN
QUIT
Begin DoDot:2
+18 SET FCOM=$GET(FDATA(90620.011,FIEN,1,CIEN))
+19 IF CLN=1
SET NOT=NOT_$CHAR(13)_$CHAR(10)_"Patient Notification Comments:"
+20 SET NOT=NOT_$CHAR(13)_$CHAR(10)_FCOM
End DoDot:2
+21 ;
+22 ;Notification Entered By
SET NOT=NOT_$CHAR(13)_$CHAR(10)_"Patient Notification Entered By: "_$GET(FDATA(90620.011,FIEN,".04","E"))
+23 ;Notification Entered Date
SET NOT=NOT_$CHAR(13)_$CHAR(10)_"Date Patient Notification Entered: "_$$FMTE^BQIUL1($PIECE($GET(FDATA(90620.011,FIEN,".03","I")),"."))
End DoDot:1
+24 QUIT NOT
