WVRPCGF ;ISP/AGP - APIs for Clinical Reminders ;11/05/2020
;;1.0;WOMEN'S HEALTH;**24,26**;Sep 30, 1998;Build 624
; This routine uses the following IAs:
; #10035 - FILE 2 (supported)
;
; This routine supports the following IAs:
; NEW - 4104
;
;
FPRONNOT(RESULT,TYPE,FDATE,PAT) ;
N DATE,IEN,NODE,PROV
S IEN=0 F S IEN=$O(^WV(790.1,"S","o",IEN)) Q:IEN'>0 D
.S NODE=$G(^WV(790.1,IEN,0))
.I $P(NODE,U,2)'=PAT Q
.S DATE=+$P(NODE,U,12) Q:DATE'>0
.I +FDATE>0,DATE'=FDATE Q
.I TYPE="BR",$P(NODE,U,15)="" Q
.I TYPE="CX",$P(NODE,U,15)'="" Q
.S RESULT(IEN)=$P(NODE,U,7)
Q
;
FNDOPNOT(RESULT,TYPE,START,END) ;
N ACCESS,IEN,NODE,PAT,PROCLIST
D FINDOPEN(.RESULT,TYPE,START,END)
Q
;
FINDOPEN(RESULT,TYPE,START,END) ;
N DATE,IEN,WNNODE,WPNODE,WNIEN,WVIEN
S DATE=START F S DATE=$O(^WV(790.4,"AOPEN",DATE)) Q:DATE'>0!(DATE>END) D
.S WNIEN=0 F S WNIEN=$O(^WV(790.4,"AOPEN",DATE,WNIEN)) Q:WNIEN'>0 D
..S WNNODE=$G(^WV(790.4,WNIEN,0)) Q:WNNODE=""
..I $P(WNNODE,U,3)>0 Q
..I $P(WNNODE,U,14)="C" Q
..S WVIEN=$P(WNNODE,U,6) Q:WVIEN'>0
..S WPNODE=$G(^WV(790.1,WVIEN,0))
..I TYPE="BR",$P(WPNODE,U,15)="" Q
..I TYPE="CX",$P(WPNODE,U,15)'="" Q
..I +$P(WPNODE,U,5)=0 Q
..I $P(WPNODE,U,36)=1 Q
..S RESULT($P(WPNODE,U,2),WVIEN)=WPNODE
Q
;
FORMTX(PAT,WVTRMTS,INPUTS,CLEARNXT) ;
N DAYS,FIELD,FUDATE,ID,PROCIEN
S ID="" F S ID=$O(INPUTS("DATA",790,ID)) Q:ID="" D
.S PROCIEN=0,DAYS=""
.F FIELD=.18,.19 D
.. K VALUE
.. S VALUE=$G(INPUTS("DATA",790,ID,FIELD))
.. I FIELD=.18,VALUE'="" S PROCIEN=$S(VALUE'="DELETE":$O(^WV(790.51,"B",VALUE,"")),1:"DELETE") Q
.. S DAYS=VALUE
.I PROCIEN=0 Q
.I PROCIEN="DELETE",DAYS="DELETE" S CLEARNXT=1 Q
.I +DAYS>0 S FUDATE=$$FMADD^XLFDT(DT,DAYS)
.I +DAYS=0,+PROCIEN>0 D TERMEVAL^WVRPCGF2(PAT,.FUDATE)
.I FUDATE<DT S FUDATE=0
.I FUDATE>0 S WVTRMTS("BR",+$G(FUDATE))=PROCIEN
Q
;
FORMNOT(PAT,PURARR,WVTRMTS,INPUTS,NOTTYPE,WVDATA) ;
N AGE,CONTDATE,CONTWHO,DIFF,DIFFDAYS,DOB,FUDATE,INC,OUTCOME,PROCDATE,PRINTER,PURIEN,TMP,TYPE,X
S TYPE="",OUTCOME="",CONTDATE="",CONTWHO="",PRINTER=""
S INC="" F S INC=$O(INPUTS("DATA",790.4,INC)) Q:INC="" D
.; find purpose
.S TMP=$G(INPUTS("DATA",790.4,INC,.04))
.S PURIEN=0
.I TMP'="" D
..S PURIEN=$O(^WV(790.404,"B",TMP,""))
..I PURIEN>0 S PURARR(PURIEN)=""
.;notification type
.S TMP=$G(INPUTS("DATA",790.4,INC,.03)) I TMP'="" S TYPE=$O(^WV(790.403,"B",TMP,"")),NOTTYPE("TYPE")=TYPE
.;notification outcome
.S TMP=$G(INPUTS("DATA",790.4,INC,.05)) I TMP'="" S OUTCOME=$O(^WV(790.405,"B",TMP,""))
.;printer
.S PRINTER=$G(INPUTS("DATA",790.4,INC,"PRINTER"))
.; who was notified only updated for Phone Call and In-Person
.S CONTWHO=$G(INPUTS("DATA",790.4,INC,1)),CONTDATE=$G(INPUTS("DATA",790.4,INC,2))
.I CONTWHO'="" S NOTTYPE("WHO")=CONTWHO
.I CONTDATE'="" S NOTTYPE("WHEN")=CONTDATE
.;set the next treatment date (F/U Date)
.I $D(INPUTS("DATA",790.4,INC,"BRTXD")) S FUDATE=INPUTS("DATA",790.4,INC,"BRTXD")
.S PROCDATE=DT
.;WVDATA(0)="160^1^28^^3171101"
.I $D(WVDATA) D
..S X="" F S X=$O(WVDATA(X)) Q:X="" D
...I +$P($G(WVDATA(X)),U,5)'>0 Q
...I +$P($G(WVDATA(X)),U,5)<PROCDATE S PROCDATE=+$P($G(WVDATA(X)),U,5)
.D GETDATES^WVRPCGF2(.WVTRMTS,PURIEN,PAT,.FUDATE,PROCDATE)
S INC=0 F S INC=$O(PURARR(INC)) Q:INC'>0 S PURARR(INC)=TYPE_U_OUTCOME_U_CONTDATE_U_CONTWHO_U_PRINTER
Q
;
FORMRES(RESULTS,ID,INPUTS) ;
N COMMENT,DATE,ISHIST,PROCIEN,TMP,WVDX,WVIEN,X
S ISHIST=0,X="",DATE=0
F S X=$O(INPUTS("DATA",790.1,X)) Q:X=""!(ISHIST=1) D
.I +X=0 Q
.I $G(INPUTS("DATA",790.1,X,.36))="TRUE" S ISHIST=1 Q
.S TMP=+$P($G(^WV(790.1,+X,0)),U,12)
.I DATE=0 S DATE=TMP Q
.I TMP<DATE S DATE=TMP
I ISHIST D FORMHRES(.RESULTS,.INPUTS) Q
S COMMENT="",ISHIST=0,PROCIEN=0,WVDX=0
; get diagnosis
S TMP=$G(INPUTS("DATA",790.1,ID,.05)) I TMP'="" S WVDX=$O(^WV(790.31,"B",TMP,""))
;I $G(INPUTS("DATA",790.1,ID,.36))="TRUE" D
;.S ISHIST=1
;.S DATE=+$G(INPUTS("DATA",790.1,ID,.12))
;.;find WV Procedure for historical updates
;.S TMP=$G(INPUTS("DATA",790.1,ID,.04)) I TMP="" Q
;.S PROCIEN=+$O(^WV(790.2,"B",TMP,""))
;I ISHIST=1,PROCIEN>0 S RESULTS(0)=WVDX_U_ISHIST_U_PROCIEN_U_COMMENT_U_DATE Q
S COMMENT=$G(INPUTS("DATA",790.1,ID,3.01))
F X=1:1:$L(ID,":") D
.S WVIEN=+$P(ID,":",X)
.S RESULTS(WVIEN)=WVDX_U_ISHIST_U_PROCIEN_U_COMMENT_U_DATE
Q
;
FORMHRES(RESULTS,INPUTS) ;
N CNT,COMMENT,DATE,ID,PROC,PROCARR,PROCIEN,TMP,WVDX
S WVDX="",COMMENT=""
S ID="" F S ID=$O(INPUTS("DATA",790.1,ID)) Q:ID="" D
.S PROCIEN=0
.S TMP=$G(INPUTS("DATA",790.1,ID,.04)) I TMP'="" D
..S PROCIEN=+$O(^WV(790.2,"B",TMP,""))
.I WVDX="" D
..S TMP=$G(INPUTS("DATA",790.1,ID,.05)) I TMP="" Q
..S WVDX=$O(^WV(790.31,"B",TMP,""))
..I COMMENT="" S COMMENT=$G(INPUTS("DATA",790.1,ID,3.01))
.Q:PROCIEN=0
.S DATE=INPUTS("DATA",790.1,ID,.12)
.S PROCARR(PROCIEN)=DATE
S CNT=0,PROCIEN=0
F S PROCIEN=$O(PROCARR(PROCIEN)) Q:PROCIEN'>0 D
.S DATE=PROCARR(PROCIEN)
.S CNT=CNT+1,RESULTS(CNT)=WVDX_U_1_U_PROCIEN_U_COMMENT_U_DATE
Q
;
NEW(RESULTS,INPUTS) ;
N CLEAR,ENCPROV,ID,NOTE,NOTTYPE,PAT,PURARR,REG,USER,TMP,VISIT,WVDATA,WVIEN,WVTRMTS,WV79023,X
N UPSTATUS
S TMP=$G(INPUTS("VISIT")),WVDX=""
S NOTE=+$G(INPUTS("DOCUMENT"))
S PAT=INPUTS("DFN")
S ENCPROV=$G(INPUTS("ENCOUNTER PROVIDER"))
S USER=$G(INPUTS("USER"))
S ID=$G(INPUTS("DATA",790.1,"MASTER ID"))
I ID="" S ID="+1,"
S VISIT=$S(TMP'="":$$GETENC^PXAPI(PAT,$P(TMP,";",2),$P(TMP,";")),1:"")
I VISIT<1 S VISIT=""
S CLEARNXT=0
I $D(INPUTS("DATA",790)) D FORMTX(PAT,.WVTRMTS,.INPUTS,.CLEARNXT)
I $D(INPUTS("DATA",790.1)) D FORMRES(.WVDATA,ID,.INPUTS)
D FORMNOT(PAT,.PURARR,.WVTRMTS,.INPUTS,.NOTTYPE,.WVDATA)
I '$D(PURARR),$D(NOTTYPE) D SETOPNOT(.RESULT,.WVDATA,.NOTTYPE,.INPUTS,PAT) I $G(RESULT(1))="" S RESULT(1)=1 Q
M WV79023=INPUTS("DATA",790.23)
S WVIEN="" F S WVIEN=$O(WVDATA(WVIEN)) Q:WVIEN="" D
.D PROCESS(.RESULT,PAT,VISIT,NOTE,ID,WVIEN,USER,ENCPROV,.WVDATA,.PURARR,.WV79023)
D SETDATES^WVRPCGF2(.RESULT,.WVTRMTS,PAT,.CLEARNXT)
I $G(RESULT(1))="" D
.S UPSTATUS=""
.S ID="" F S ID=$O(INPUTS("DATA",790.1,ID)) Q:ID=""!(UPSTATUS'="") D
..I $D(INPUTS("DATA",790.1,ID,"STATUS")) S UPSTATUS=ID
.I UPSTATUS'="" D CASCADE^WVRPCGF2(.RESULT,.INPUTS,UPSTATUS,PAT)
I $G(RESULT(1))="" S RESULT(1)=1
Q
;
PROCESS(RESULT,PAT,VISIT,NOTE,ID,WVIEN,USER,ENCPROV,WVDATA,PURARR,WV79023) ;
N COMMENT,DATE,ISHIST,NODE,PROCIEN,WVDX,TIMESTAMP
S TIMESTMP=$$NOW^XLFDT
;WVDX_U_ISHIST_U_PROCIEN_U_COMMENT
S NODE=WVDATA(WVIEN)
S WVDX=$P(NODE,U),ISHIST=$P(NODE,U,2)
S PROCIEN=$P(NODE,U,3),COMMENT=$P(NODE,U,4),DATE=$P(NODE,U,5)
;set results non-historical entry, WV Procedure already exist
I +WVDX>0,WVIEN>0,ISHIST=0 D SETRESLT(.RESULT,WVIEN,WVDX,COMMENT,$G(TIMESTMP),$G(VISIT),NOTE,.WV79023)
;set results historical entry, WV Procedure does not exist
I +WVDX=0,WVIEN>0,ISHIST=0,$D(WV79023) D UPRESLT(.RESULT,WVIEN,COMMENT,$G(TIMESTMP),$G(NOTE),.WV79023)
I +WVDX>0,PROCIEN>0,ISHIST=1 D ADDHRSLT(.RESULT,.WVIEN,PAT,PROCIEN,WVDX,COMMENT,$G(TIMESTMP),$G(VISIT),NOTE,ISHIST,.WV79023,DATE,USER,ENCPROV)
;
;notification type
D ADDNOTS(.RESULT,.INPUTS,ID,WVIEN,PAT,.PURARR)
PROCESSX ;
Q
;
ADDITEMS(WV79023,WVFDA,WVIEN,TIMESTMP,VISIT,NOTE,ISHIST) ;
N CNT,FIELD,IENS,TMP
S CNT="" F S CNT=$O(WV79023(CNT)) Q:CNT="" D
.S FIELD="" F S FIELD=$O(WV79023(CNT,FIELD)) Q:FIELD="" D
..S TMP=$G(WV79023(CNT,FIELD)) I TMP="" Q
..S IENS=$S(ISHIST=0:CNT_WVIEN_",",ISHIST=1:+CNT+1_",+1,",1:"")
..I IENS="" Q
..I ISHIST=1 S IENS="+"_IENS
..S WVFDA(790.23,IENS,FIELD)=TMP
..I TIMESTMP'="" S WVFDA(790.23,IENS,1)=TIMESTMP
..I VISIT'="" S WVFDA(790.23,IENS,2)=VISIT
..I NOTE>0 S WVFDA(790.23,IENS,3)=NOTE
Q
;
;add outside report procedure
ADDHRSLT(RESULT,WVIEN,PAT,PROCIEN,WVRESULT,COMMENT,TIMESTMP,VISIT,NOTE,ISHIST,WV79023,DATE,USER,ENCPROV) ;
N ACCESS,WVERR,WVFDA,WVAIEN,WVNEWP,PERSON
S PERSON=$S(ENCPROV'="":ENCPROV,1:USER)
S ACCESS=$$ACCSSN^WVUTL5(PROCIEN)
S WVFDA(790.1,"+1,",.01)=ACCESS
S WVFDA(790.1,"+1,",.02)=PAT
S WVFDA(790.1,"+1,",.04)=PROCIEN
S WVFDA(790.1,"+1,",.05)=WVRESULT
I $G(PERSON)'="" S WVFDA(790.1,"+1,",.07)=PERSON
S WVFDA(790.1,"+1,",.12)=DATE
S WVFDA(790.1,"+1,",.14)="c"
I COMMENT'="" S WVFDA(790.1,"+1,",3.01)=COMMENT
I $D(WV79023) D ADDITEMS(.WV79023,.WVFDA,0,TIMESTMP,VISIT,NOTE,1)
S WVFDA(790.1,"+1,",.36)=$S(ISHIST="1":1,1:"0")
D UPDATE^DIE("","WVFDA","WVAIEN","WVERR")
I $D(WVERR) D Q
.S RESULT(1)="-1^Error updating the procedure data"
.S NUM=0
.S NUM=NUM+1,^TMP("PXRMXMZ",$J,NUM,0)="Error adding Women's Health Procedure to the WV PROCEDURE FILE."
.D BLDMSG^WVRPCGF1(PAT,"ERROR Updating WV PROCEDURE File",.NUM)
S WVIEN=WVAIEN(1)
;update existing Episode TODO: needs to be replace with sometype of file driver eventually
K WVERR
D ADD^PXRMEOC(PAT,TIMESTMP,WVIEN_";WV(790.1,",1,0,"BREAST CARE",.WVERR)
I '$D(WVERR) Q
S NUM=0
S NUM=NUM+1,^TMP("PXRMXMZ",$J,NUM,0)="Error adding Women's Health Procedure to the patient episode file."
D BLDMSG^WVRPCGF1(PAT,"ERROR Updating Episode of Care File.",.NUM)
Q
;
;set result for procedure already in the WV package
SETRESLT(RESULT,WVIEN,WVRESULT,COMMENT,TIMESTMP,VISIT,NOTE,WV79023) ; Update the RESULTS/DIAGNOSIS field (.05)
;
N CNT,FIELD,NUM,OUTPUT,TMP,WVERR,WVDXFLAG,WVFAC,WVFDA,WVNODE,WVPAT
I $G(WVIEN)'>0 Q
D UPDATE^WVALERTS(WVIEN) ;mark procedure as processed by CR
;I $G(WVRESULT)'>0 Q
; Check 'update results/dx?' parameter
S WVNODE=$G(^WV(790.1,+WVIEN,0))
S WVFAC=+$P(WVNODE,U,10)
S WVDXFLAG=$P($G(^WV(790.02,+WVFAC,0)),U,11)
Q:'WVDXFLAG
I $P(WVNODE,U,5)="" S WVFDA(790.1,WVIEN_",",.05)=WVRESULT
S WVFDA(790.1,WVIEN_",",.14)="c"
I COMMENT'="" S WVFDA(790.1,WVIEN_",",3.01)=COMMENT
I $D(WV79023) D ADDITEMS(.WV79023,.WVFDA,WVIEN,TIMESTMP,VISIT,NOTE,0)
D UPDATE^DIE("","WVFDA","","WVERR")
I $D(WVERR) D Q
.S RESULT(1)="-1^Error updating procedure data"
.S NUM=0
.S NUM=NUM+1,^TMP("PXRMXMZ",$J,NUM,0)="Error adding Women's Health Procedure to the WV PROCEDURE FILE."
.D BLDMSG^WVRPCGF1(PAT,"ERROR Updating WV PROCEDURE File",.NUM)
S WVPAT=$P($G(^WV(790.1,WVIEN,0)),U,2) Q:WVPAT'>0
;update existing Episode TODO: needs to be replace with sometype of file driver eventually
D ADD^PXRMEOC(WVPAT,TIMESTMP,WVIEN_";WV(790.1,",1,0,"BREAST CARE",.WVERR)
I '$D(WVERR) Q
S NUM=0
S NUM=NUM+1,^TMP("PXRMXMZ",$J,NUM,0)="Error adding Women's Health Procedure to the patient episode file."
D BLDMSG^WVRPCGF1(PAT,"ERROR Updating Episode of Care File.",.NUM)
Q
;
UPRESLT(RESULT,WVIEN,COMMENT,TIMESTMP,NOTE,WV79023) ;
N NUM,WVERR,WVFDA
I $G(WVIEN)'>0 Q
I COMMENT'="" S WVFDA(790.1,WVIEN_",",3.01)=COMMENT
I $D(WV79023) D ADDITEMS(.WV79023,.WVFDA,WVIEN,TIMESTMP,VISIT,NOTE,0)
D UPDATE^DIE("","WVFDA","","WVERR")
I $D(WVERR) D Q
.S RESULT(1)="-1^Error updating procedure data"
.S NUM=0
.S NUM=NUM+1,^TMP("PXRMXMZ",$J,NUM,0)="Error adding Women's Health Procedure to the WV PROCEDURE FILE."
.D BLDMSG^WVRPCGF1(PAT,"ERROR Updating WV PROCEDURE File",.NUM)
Q
;check to see if notifications should be added, loop through each notification
ADDNOTS(RESULT,INPUTS,ID,WVIEN,WVDFN,PURARR) ;
;
N DFN,NODE,WVERRADD,WVFAC,WVNODE,WVNPFLAG,WVPDATE,WVPURP
N WVTYPE,WVOUTCOM,WVPRINTR,WVFUDATE,WVCONWHO,WVCONDTE
;TYPE_U_OUTCOME_U_CONTDATE_U_CONTWHO
;process each procedure
S WVPURP=0 F S WVPURP=$O(PURARR(WVPURP)) Q:WVPURP'>0 D
.I '$D(^WV(790.404,+$G(WVPURP),0)) Q ;purpose
.S NODE=PURARR(WVPURP)
.S WVTYPE=$P(NODE,U),WVOUTCOM=$P(NODE,U,2)
.S WVCONDTE=$P(NODE,U,3),WVCONWHO=$P(NODE,U,4)
.S WVPRINTR=$P(NODE,U,5)
.I WVIEN'>0 Q
.D SETNOT(.RESULT,.INPUTS,.WVTRMTS,WVIEN,WVPURP,WVTYPE,WVOUTCOM,WVPRINTR,WVDFN,WVCONWHO,WVCONDTE)
; if a purpose and type, check other notification in the Episode for lack of type of notification. If found update
I $D(PURARR),WVTYPE'="" D SETNOTO(.RESULT,ID,.INPUTS,WVDFN,WVTYPE)
Q
;
;add the notification record to file 790.4
SETNOT(RESULT,INPUTS,WVTRMTS,WVIEN,WVPURP,WVTYPE,WVOUTCUM,WVPRINTR,WVDFN,WVCONWHO,WVCONDTE,WVPDATE) ;
N DLAYGO
N WVDA7904,WVDXFLAG,WVERR,WVFAC,WVFDA,WVFDAIEN,WVLDAT,WVLPRG,WVTXFLAG,WVTYPARR
;
S WVTYPARR("CONVERSATION WITH PATIENT")=""
S WVTYPARR("PHONE CALL, 1ST")=""
S WVTYPARR("PHONE CALL, 2ND")=""
S WVTYPARR("PHONE CALL, 3RD")=""
S WVTYPARR("SECURE MESSAGING")=""
;
I '$G(WVFAC) S WVFAC=DUZ(2) ;facility ien
S WVDXFLAG=$P($G(^WV(790.02,+WVFAC,0)),U,11,12)
S WVTXFLAG=$P(WVDXFLAG,U,2) ;update treatment needs?
S WVDXFLAG=$P(WVDXFLAG,U,1) ;update results/dx?
S:$G(WVPDATE)'>0 WVPDATE=DT ;use today if no procedure date
I $G(WVPRINTR)]"" S WVOUTCUM=$$GETOIEN^WVRPCNO1("Letter Sent")
; create File 790.4 entry
S WVFDA(790.4,"+1,",.01)=WVDFN ;DFN
S WVFDA(790.4,"+1,",.02)=DT ;date opened
I $G(WVTYPE)'="" S WVFDA(790.4,"+1,",.03)=WVTYPE ;type
S WVFDA(790.4,"+1,",.04)=WVPURP ;purpose
S WVFDA(790.4,"+1,",.05)=WVOUTCUM ;outcome
I +$G(WVIEN)>0 S WVFDA(790.4,"+1,",.06)=$G(WVIEN) ;wh accession #
S WVFDA(790.4,"+1,",.07)=$S($G(WVFAC):$G(WVFAC),1:DUZ(2)) ;facility
;I $G(WVTYPE)'="" S WVFDA(790.4,"+1,",.08)=DT ;date closed
I WVCONWHO'="" S WVFDA(790.4,"+1,",1)=WVCONWHO
I WVCONDTE'="" S WVFDA(790.4,"+1,",2)=WVCONDTE
I $P($G(^WV(790.403,+$G(WVTYPE),0)),U,2)=1 S WVFDA(790.4,"+1,",.11)=DT ;print date
S WVFDA(790.4,"+1,",.13)=DT ;complete by date
I $G(WVTYPE)'="" S WVFDA(790.4,"+1,",.14)="c" ;status
I $G(WVTYPE)'="",$D(WVTYPARR(WVTYPE)) D
.S WVFDA(790.4,"+1,",.14)="c"
.S WVFDA(790.4,"+1,",.08)=DT
D UPDATE^DIE("","WVFDA","WVFDAIEN","WVERR")
I $D(WVERR) D
.S RESULT(1)="-1^Error updating the notification data"
.S NUM=0
.S NUM=NUM+1,^TMP("PXRMXMZ",$J,NUM,0)="Error adding Women's Health Notifications to the WV NOTIFICATION FILE."
.D BLDMSG^WVRPCGF1(PAT,"ERROR Updating WV PROCEDURE File.",.NUM)
S WVDA7904=WVFDAIEN(1)
;
Q:$G(WVPRINTR)="" ;no printer defined
Q:$P($G(^WV(790.403,+$G(WVTYPE),0)),U,2)'=1 ;not printable
S WVPRINTR=$P(WVPRINTR,";",2)
Q:WVPRINTR=""
D DEVICE^WVRPCNO1(WVDA7904,WVPRINTR) ;print letter
Q
;
;update any open notification link to the pass in 790.1 IEN
SETOPNOT(RESULT,WVDATA,NOTTYPE,INPUTS,PAT) ;
N TYPE,WHEN,WHO,WVIEN
S TYPE=$G(NOTTYPE("TYPE")) I TYPE="" Q
S WHO=$G(NOTTYPE("WHO")),WHEN=$G(NOTTYPE("WHEN"))
S WVIEN=0 F S WVIEN=$O(WVDATA(WVIEN)) Q:WVIEN'>0 D
.D TYPEONLY(.RESULT,WVIEN,WHO,WHEN,TYPE,.INPUTS)
Q
;
;find any open notification for the pass in Cascade name
SETNOTO(RESULT,ID,INPUTS,WVDFN,WVTYPE) ;
N CONTWHO,CONTDATE,ITEM,WVARRAY,WVIEN
I $G(INPUTS("DATA",790.1,ID,"NAME"))="" Q
D GETOLIST^PXRMEOC(.WVARRAY,WVDFN,INPUTS("DATA",790.1,ID,"NAME"))
S CONTWHO=$G(INPUTS("DATA",790.4,"+1,",1)),CONTDATE=$G(INPUTS("DATA",790.4,"+1,",2))
S ITEM="" F S ITEM=$O(WVARRAY(ITEM)) Q:ITEM="" D
.Q:ITEM'["WV(790.1"
.S WVIEN=+ITEM Q:WVIEN'>0
.D TYPEONLY(.RESULT,WVIEN,CONTWHO,CONTDATE,WVTYPE,.INPUTS)
Q
;
TYPEONLY(RESULT,WVIEN,WVCONWHO,WVCONDTE,TYPE,INPUTS) ;
N ACCESS,IEN,NODE,NUM,TMP,WVFDA,WVERR
S NODE=$G(^WV(790.1,WVIEN,0)) Q:NODE=""
S ACCESS=$P(NODE,U)
S IEN=0 F S IEN=$O(^WV(790.4,"C",ACCESS,IEN)) Q:IEN'>0!($D(WVERR)) D
.K WVFDA
.S NODE=$G(^WV(790.4,IEN,0))
.I +$P(NODE,U,3)>0 Q
.I +$P(NODE,U,4)=0 Q
.I $P(NODE,U,14)="c" Q
.S WVFDA(790.4,IEN_",",.03)=TYPE
.S WVFDA(790.4,IEN_",",.14)="c"
.I WVCONWHO'="" S WVFDA(790.4,IEN_",",1)=WVCONWHO
.I WVCONDTE'="" S WVFDA(790.4,IEN_",",2)=WVCONDTE
.I '$D(WVFDA) Q
.D UPDATE^DIE("","WVFDA","","WVERR")
.I $D(WVERR) D
..S RESULT(1)="-1^Error updating the notification data"
..S NUM=0
..S NUM=NUM+1,^TMP("PXRMXMZ",$J,NUM,0)="Error adding Women's Health Notifications to the WV NOTIFICATION FILE."
..D BLDMSG^WVRPCGF1(PAT,"ERROR Updating WV PROCEDURE File.",.NUM)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HWVRPCGF 15874 printed Oct 16, 2024@18:48:05 Page 2
WVRPCGF ;ISP/AGP - APIs for Clinical Reminders ;11/05/2020
+1 ;;1.0;WOMEN'S HEALTH;**24,26**;Sep 30, 1998;Build 624
+2 ; This routine uses the following IAs:
+3 ; #10035 - FILE 2 (supported)
+4 ;
+5 ; This routine supports the following IAs:
+6 ; NEW - 4104
+7 ;
+8 ;
FPRONNOT(RESULT,TYPE,FDATE,PAT) ;
+1 NEW DATE,IEN,NODE,PROV
+2 SET IEN=0
FOR
SET IEN=$ORDER(^WV(790.1,"S","o",IEN))
if IEN'>0
QUIT
Begin DoDot:1
+3 SET NODE=$GET(^WV(790.1,IEN,0))
+4 IF $PIECE(NODE,U,2)'=PAT
QUIT
+5 SET DATE=+$PIECE(NODE,U,12)
if DATE'>0
QUIT
+6 IF +FDATE>0
IF DATE'=FDATE
QUIT
+7 IF TYPE="BR"
IF $PIECE(NODE,U,15)=""
QUIT
+8 IF TYPE="CX"
IF $PIECE(NODE,U,15)'=""
QUIT
+9 SET RESULT(IEN)=$PIECE(NODE,U,7)
End DoDot:1
+10 QUIT
+11 ;
FNDOPNOT(RESULT,TYPE,START,END) ;
+1 NEW ACCESS,IEN,NODE,PAT,PROCLIST
+2 DO FINDOPEN(.RESULT,TYPE,START,END)
+3 QUIT
+4 ;
FINDOPEN(RESULT,TYPE,START,END) ;
+1 NEW DATE,IEN,WNNODE,WPNODE,WNIEN,WVIEN
+2 SET DATE=START
FOR
SET DATE=$ORDER(^WV(790.4,"AOPEN",DATE))
if DATE'>0!(DATE>END)
QUIT
Begin DoDot:1
+3 SET WNIEN=0
FOR
SET WNIEN=$ORDER(^WV(790.4,"AOPEN",DATE,WNIEN))
if WNIEN'>0
QUIT
Begin DoDot:2
+4 SET WNNODE=$GET(^WV(790.4,WNIEN,0))
if WNNODE=""
QUIT
+5 IF $PIECE(WNNODE,U,3)>0
QUIT
+6 IF $PIECE(WNNODE,U,14)="C"
QUIT
+7 SET WVIEN=$PIECE(WNNODE,U,6)
if WVIEN'>0
QUIT
+8 SET WPNODE=$GET(^WV(790.1,WVIEN,0))
+9 IF TYPE="BR"
IF $PIECE(WPNODE,U,15)=""
QUIT
+10 IF TYPE="CX"
IF $PIECE(WPNODE,U,15)'=""
QUIT
+11 IF +$PIECE(WPNODE,U,5)=0
QUIT
+12 IF $PIECE(WPNODE,U,36)=1
QUIT
+13 SET RESULT($PIECE(WPNODE,U,2),WVIEN)=WPNODE
End DoDot:2
End DoDot:1
+14 QUIT
+15 ;
FORMTX(PAT,WVTRMTS,INPUTS,CLEARNXT) ;
+1 NEW DAYS,FIELD,FUDATE,ID,PROCIEN
+2 SET ID=""
FOR
SET ID=$ORDER(INPUTS("DATA",790,ID))
if ID=""
QUIT
Begin DoDot:1
+3 SET PROCIEN=0
SET DAYS=""
+4 FOR FIELD=.18,.19
Begin DoDot:2
+5 KILL VALUE
+6 SET VALUE=$GET(INPUTS("DATA",790,ID,FIELD))
+7 IF FIELD=.18
IF VALUE'=""
SET PROCIEN=$SELECT(VALUE'="DELETE":$ORDER(^WV(790.51,"B",VALUE,"")),1:"DELETE")
QUIT
+8 SET DAYS=VALUE
End DoDot:2
+9 IF PROCIEN=0
QUIT
+10 IF PROCIEN="DELETE"
IF DAYS="DELETE"
SET CLEARNXT=1
QUIT
+11 IF +DAYS>0
SET FUDATE=$$FMADD^XLFDT(DT,DAYS)
+12 IF +DAYS=0
IF +PROCIEN>0
DO TERMEVAL^WVRPCGF2(PAT,.FUDATE)
+13 IF FUDATE<DT
SET FUDATE=0
+14 IF FUDATE>0
SET WVTRMTS("BR",+$GET(FUDATE))=PROCIEN
End DoDot:1
+15 QUIT
+16 ;
FORMNOT(PAT,PURARR,WVTRMTS,INPUTS,NOTTYPE,WVDATA) ;
+1 NEW AGE,CONTDATE,CONTWHO,DIFF,DIFFDAYS,DOB,FUDATE,INC,OUTCOME,PROCDATE,PRINTER,PURIEN,TMP,TYPE,X
+2 SET TYPE=""
SET OUTCOME=""
SET CONTDATE=""
SET CONTWHO=""
SET PRINTER=""
+3 SET INC=""
FOR
SET INC=$ORDER(INPUTS("DATA",790.4,INC))
if INC=""
QUIT
Begin DoDot:1
+4 ; find purpose
+5 SET TMP=$GET(INPUTS("DATA",790.4,INC,.04))
+6 SET PURIEN=0
+7 IF TMP'=""
Begin DoDot:2
+8 SET PURIEN=$ORDER(^WV(790.404,"B",TMP,""))
+9 IF PURIEN>0
SET PURARR(PURIEN)=""
End DoDot:2
+10 ;notification type
+11 SET TMP=$GET(INPUTS("DATA",790.4,INC,.03))
IF TMP'=""
SET TYPE=$ORDER(^WV(790.403,"B",TMP,""))
SET NOTTYPE("TYPE")=TYPE
+12 ;notification outcome
+13 SET TMP=$GET(INPUTS("DATA",790.4,INC,.05))
IF TMP'=""
SET OUTCOME=$ORDER(^WV(790.405,"B",TMP,""))
+14 ;printer
+15 SET PRINTER=$GET(INPUTS("DATA",790.4,INC,"PRINTER"))
+16 ; who was notified only updated for Phone Call and In-Person
+17 SET CONTWHO=$GET(INPUTS("DATA",790.4,INC,1))
SET CONTDATE=$GET(INPUTS("DATA",790.4,INC,2))
+18 IF CONTWHO'=""
SET NOTTYPE("WHO")=CONTWHO
+19 IF CONTDATE'=""
SET NOTTYPE("WHEN")=CONTDATE
+20 ;set the next treatment date (F/U Date)
+21 IF $DATA(INPUTS("DATA",790.4,INC,"BRTXD"))
SET FUDATE=INPUTS("DATA",790.4,INC,"BRTXD")
+22 SET PROCDATE=DT
+23 ;WVDATA(0)="160^1^28^^3171101"
+24 IF $DATA(WVDATA)
Begin DoDot:2
+25 SET X=""
FOR
SET X=$ORDER(WVDATA(X))
if X=""
QUIT
Begin DoDot:3
+26 IF +$PIECE($GET(WVDATA(X)),U,5)'>0
QUIT
+27 IF +$PIECE($GET(WVDATA(X)),U,5)<PROCDATE
SET PROCDATE=+$PIECE($GET(WVDATA(X)),U,5)
End DoDot:3
End DoDot:2
+28 DO GETDATES^WVRPCGF2(.WVTRMTS,PURIEN,PAT,.FUDATE,PROCDATE)
End DoDot:1
+29 SET INC=0
FOR
SET INC=$ORDER(PURARR(INC))
if INC'>0
QUIT
SET PURARR(INC)=TYPE_U_OUTCOME_U_CONTDATE_U_CONTWHO_U_PRINTER
+30 QUIT
+31 ;
FORMRES(RESULTS,ID,INPUTS) ;
+1 NEW COMMENT,DATE,ISHIST,PROCIEN,TMP,WVDX,WVIEN,X
+2 SET ISHIST=0
SET X=""
SET DATE=0
+3 FOR
SET X=$ORDER(INPUTS("DATA",790.1,X))
if X=""!(ISHIST=1)
QUIT
Begin DoDot:1
+4 IF +X=0
QUIT
+5 IF $GET(INPUTS("DATA",790.1,X,.36))="TRUE"
SET ISHIST=1
QUIT
+6 SET TMP=+$PIECE($GET(^WV(790.1,+X,0)),U,12)
+7 IF DATE=0
SET DATE=TMP
QUIT
+8 IF TMP<DATE
SET DATE=TMP
End DoDot:1
+9 IF ISHIST
DO FORMHRES(.RESULTS,.INPUTS)
QUIT
+10 SET COMMENT=""
SET ISHIST=0
SET PROCIEN=0
SET WVDX=0
+11 ; get diagnosis
+12 SET TMP=$GET(INPUTS("DATA",790.1,ID,.05))
IF TMP'=""
SET WVDX=$ORDER(^WV(790.31,"B",TMP,""))
+13 ;I $G(INPUTS("DATA",790.1,ID,.36))="TRUE" D
+14 ;.S ISHIST=1
+15 ;.S DATE=+$G(INPUTS("DATA",790.1,ID,.12))
+16 ;.;find WV Procedure for historical updates
+17 ;.S TMP=$G(INPUTS("DATA",790.1,ID,.04)) I TMP="" Q
+18 ;.S PROCIEN=+$O(^WV(790.2,"B",TMP,""))
+19 ;I ISHIST=1,PROCIEN>0 S RESULTS(0)=WVDX_U_ISHIST_U_PROCIEN_U_COMMENT_U_DATE Q
+20 SET COMMENT=$GET(INPUTS("DATA",790.1,ID,3.01))
+21 FOR X=1:1:$LENGTH(ID,":")
Begin DoDot:1
+22 SET WVIEN=+$PIECE(ID,":",X)
+23 SET RESULTS(WVIEN)=WVDX_U_ISHIST_U_PROCIEN_U_COMMENT_U_DATE
End DoDot:1
+24 QUIT
+25 ;
FORMHRES(RESULTS,INPUTS) ;
+1 NEW CNT,COMMENT,DATE,ID,PROC,PROCARR,PROCIEN,TMP,WVDX
+2 SET WVDX=""
SET COMMENT=""
+3 SET ID=""
FOR
SET ID=$ORDER(INPUTS("DATA",790.1,ID))
if ID=""
QUIT
Begin DoDot:1
+4 SET PROCIEN=0
+5 SET TMP=$GET(INPUTS("DATA",790.1,ID,.04))
IF TMP'=""
Begin DoDot:2
+6 SET PROCIEN=+$ORDER(^WV(790.2,"B",TMP,""))
End DoDot:2
+7 IF WVDX=""
Begin DoDot:2
+8 SET TMP=$GET(INPUTS("DATA",790.1,ID,.05))
IF TMP=""
QUIT
+9 SET WVDX=$ORDER(^WV(790.31,"B",TMP,""))
+10 IF COMMENT=""
SET COMMENT=$GET(INPUTS("DATA",790.1,ID,3.01))
End DoDot:2
+11 if PROCIEN=0
QUIT
+12 SET DATE=INPUTS("DATA",790.1,ID,.12)
+13 SET PROCARR(PROCIEN)=DATE
End DoDot:1
+14 SET CNT=0
SET PROCIEN=0
+15 FOR
SET PROCIEN=$ORDER(PROCARR(PROCIEN))
if PROCIEN'>0
QUIT
Begin DoDot:1
+16 SET DATE=PROCARR(PROCIEN)
+17 SET CNT=CNT+1
SET RESULTS(CNT)=WVDX_U_1_U_PROCIEN_U_COMMENT_U_DATE
End DoDot:1
+18 QUIT
+19 ;
NEW(RESULTS,INPUTS) ;
+1 NEW CLEAR,ENCPROV,ID,NOTE,NOTTYPE,PAT,PURARR,REG,USER,TMP,VISIT,WVDATA,WVIEN,WVTRMTS,WV79023,X
+2 NEW UPSTATUS
+3 SET TMP=$GET(INPUTS("VISIT"))
SET WVDX=""
+4 SET NOTE=+$GET(INPUTS("DOCUMENT"))
+5 SET PAT=INPUTS("DFN")
+6 SET ENCPROV=$GET(INPUTS("ENCOUNTER PROVIDER"))
+7 SET USER=$GET(INPUTS("USER"))
+8 SET ID=$GET(INPUTS("DATA",790.1,"MASTER ID"))
+9 IF ID=""
SET ID="+1,"
+10 SET VISIT=$SELECT(TMP'="":$$GETENC^PXAPI(PAT,$PIECE(TMP,";",2),$PIECE(TMP,";")),1:"")
+11 IF VISIT<1
SET VISIT=""
+12 SET CLEARNXT=0
+13 IF $DATA(INPUTS("DATA",790))
DO FORMTX(PAT,.WVTRMTS,.INPUTS,.CLEARNXT)
+14 IF $DATA(INPUTS("DATA",790.1))
DO FORMRES(.WVDATA,ID,.INPUTS)
+15 DO FORMNOT(PAT,.PURARR,.WVTRMTS,.INPUTS,.NOTTYPE,.WVDATA)
+16 IF '$DATA(PURARR)
IF $DATA(NOTTYPE)
DO SETOPNOT(.RESULT,.WVDATA,.NOTTYPE,.INPUTS,PAT)
IF $GET(RESULT(1))=""
SET RESULT(1)=1
QUIT
+17 MERGE WV79023=INPUTS("DATA",790.23)
+18 SET WVIEN=""
FOR
SET WVIEN=$ORDER(WVDATA(WVIEN))
if WVIEN=""
QUIT
Begin DoDot:1
+19 DO PROCESS(.RESULT,PAT,VISIT,NOTE,ID,WVIEN,USER,ENCPROV,.WVDATA,.PURARR,.WV79023)
End DoDot:1
+20 DO SETDATES^WVRPCGF2(.RESULT,.WVTRMTS,PAT,.CLEARNXT)
+21 IF $GET(RESULT(1))=""
Begin DoDot:1
+22 SET UPSTATUS=""
+23 SET ID=""
FOR
SET ID=$ORDER(INPUTS("DATA",790.1,ID))
if ID=""!(UPSTATUS'="")
QUIT
Begin DoDot:2
+24 IF $DATA(INPUTS("DATA",790.1,ID,"STATUS"))
SET UPSTATUS=ID
End DoDot:2
+25 IF UPSTATUS'=""
DO CASCADE^WVRPCGF2(.RESULT,.INPUTS,UPSTATUS,PAT)
End DoDot:1
+26 IF $GET(RESULT(1))=""
SET RESULT(1)=1
+27 QUIT
+28 ;
PROCESS(RESULT,PAT,VISIT,NOTE,ID,WVIEN,USER,ENCPROV,WVDATA,PURARR,WV79023) ;
+1 NEW COMMENT,DATE,ISHIST,NODE,PROCIEN,WVDX,TIMESTAMP
+2 SET TIMESTMP=$$NOW^XLFDT
+3 ;WVDX_U_ISHIST_U_PROCIEN_U_COMMENT
+4 SET NODE=WVDATA(WVIEN)
+5 SET WVDX=$PIECE(NODE,U)
SET ISHIST=$PIECE(NODE,U,2)
+6 SET PROCIEN=$PIECE(NODE,U,3)
SET COMMENT=$PIECE(NODE,U,4)
SET DATE=$PIECE(NODE,U,5)
+7 ;set results non-historical entry, WV Procedure already exist
+8 IF +WVDX>0
IF WVIEN>0
IF ISHIST=0
DO SETRESLT(.RESULT,WVIEN,WVDX,COMMENT,$GET(TIMESTMP),$GET(VISIT),NOTE,.WV79023)
+9 ;set results historical entry, WV Procedure does not exist
+10 IF +WVDX=0
IF WVIEN>0
IF ISHIST=0
IF $DATA(WV79023)
DO UPRESLT(.RESULT,WVIEN,COMMENT,$GET(TIMESTMP),$GET(NOTE),.WV79023)
+11 IF +WVDX>0
IF PROCIEN>0
IF ISHIST=1
DO ADDHRSLT(.RESULT,.WVIEN,PAT,PROCIEN,WVDX,COMMENT,$GET(TIMESTMP),$GET(VISIT),NOTE,ISHIST,.WV79023,DATE,USER,ENCPROV)
+12 ;
+13 ;notification type
+14 DO ADDNOTS(.RESULT,.INPUTS,ID,WVIEN,PAT,.PURARR)
PROCESSX ;
+1 QUIT
+2 ;
ADDITEMS(WV79023,WVFDA,WVIEN,TIMESTMP,VISIT,NOTE,ISHIST) ;
+1 NEW CNT,FIELD,IENS,TMP
+2 SET CNT=""
FOR
SET CNT=$ORDER(WV79023(CNT))
if CNT=""
QUIT
Begin DoDot:1
+3 SET FIELD=""
FOR
SET FIELD=$ORDER(WV79023(CNT,FIELD))
if FIELD=""
QUIT
Begin DoDot:2
+4 SET TMP=$GET(WV79023(CNT,FIELD))
IF TMP=""
QUIT
+5 SET IENS=$SELECT(ISHIST=0:CNT_WVIEN_",",ISHIST=1:+CNT+1_",+1,",1:"")
+6 IF IENS=""
QUIT
+7 IF ISHIST=1
SET IENS="+"_IENS
+8 SET WVFDA(790.23,IENS,FIELD)=TMP
+9 IF TIMESTMP'=""
SET WVFDA(790.23,IENS,1)=TIMESTMP
+10 IF VISIT'=""
SET WVFDA(790.23,IENS,2)=VISIT
+11 IF NOTE>0
SET WVFDA(790.23,IENS,3)=NOTE
End DoDot:2
End DoDot:1
+12 QUIT
+13 ;
+14 ;add outside report procedure
ADDHRSLT(RESULT,WVIEN,PAT,PROCIEN,WVRESULT,COMMENT,TIMESTMP,VISIT,NOTE,ISHIST,WV79023,DATE,USER,ENCPROV) ;
+1 NEW ACCESS,WVERR,WVFDA,WVAIEN,WVNEWP,PERSON
+2 SET PERSON=$SELECT(ENCPROV'="":ENCPROV,1:USER)
+3 SET ACCESS=$$ACCSSN^WVUTL5(PROCIEN)
+4 SET WVFDA(790.1,"+1,",.01)=ACCESS
+5 SET WVFDA(790.1,"+1,",.02)=PAT
+6 SET WVFDA(790.1,"+1,",.04)=PROCIEN
+7 SET WVFDA(790.1,"+1,",.05)=WVRESULT
+8 IF $GET(PERSON)'=""
SET WVFDA(790.1,"+1,",.07)=PERSON
+9 SET WVFDA(790.1,"+1,",.12)=DATE
+10 SET WVFDA(790.1,"+1,",.14)="c"
+11 IF COMMENT'=""
SET WVFDA(790.1,"+1,",3.01)=COMMENT
+12 IF $DATA(WV79023)
DO ADDITEMS(.WV79023,.WVFDA,0,TIMESTMP,VISIT,NOTE,1)
+13 SET WVFDA(790.1,"+1,",.36)=$SELECT(ISHIST="1":1,1:"0")
+14 DO UPDATE^DIE("","WVFDA","WVAIEN","WVERR")
+15 IF $DATA(WVERR)
Begin DoDot:1
+16 SET RESULT(1)="-1^Error updating the procedure data"
+17 SET NUM=0
+18 SET NUM=NUM+1
SET ^TMP("PXRMXMZ",$JOB,NUM,0)="Error adding Women's Health Procedure to the WV PROCEDURE FILE."
+19 DO BLDMSG^WVRPCGF1(PAT,"ERROR Updating WV PROCEDURE File",.NUM)
End DoDot:1
QUIT
+20 SET WVIEN=WVAIEN(1)
+21 ;update existing Episode TODO: needs to be replace with sometype of file driver eventually
+22 KILL WVERR
+23 DO ADD^PXRMEOC(PAT,TIMESTMP,WVIEN_";WV(790.1,",1,0,"BREAST CARE",.WVERR)
+24 IF '$DATA(WVERR)
QUIT
+25 SET NUM=0
+26 SET NUM=NUM+1
SET ^TMP("PXRMXMZ",$JOB,NUM,0)="Error adding Women's Health Procedure to the patient episode file."
+27 DO BLDMSG^WVRPCGF1(PAT,"ERROR Updating Episode of Care File.",.NUM)
+28 QUIT
+29 ;
+30 ;set result for procedure already in the WV package
SETRESLT(RESULT,WVIEN,WVRESULT,COMMENT,TIMESTMP,VISIT,NOTE,WV79023) ; Update the RESULTS/DIAGNOSIS field (.05)
+1 ;
+2 NEW CNT,FIELD,NUM,OUTPUT,TMP,WVERR,WVDXFLAG,WVFAC,WVFDA,WVNODE,WVPAT
+3 IF $GET(WVIEN)'>0
QUIT
+4 ;mark procedure as processed by CR
DO UPDATE^WVALERTS(WVIEN)
+5 ;I $G(WVRESULT)'>0 Q
+6 ; Check 'update results/dx?' parameter
+7 SET WVNODE=$GET(^WV(790.1,+WVIEN,0))
+8 SET WVFAC=+$PIECE(WVNODE,U,10)
+9 SET WVDXFLAG=$PIECE($GET(^WV(790.02,+WVFAC,0)),U,11)
+10 if 'WVDXFLAG
QUIT
+11 IF $PIECE(WVNODE,U,5)=""
SET WVFDA(790.1,WVIEN_",",.05)=WVRESULT
+12 SET WVFDA(790.1,WVIEN_",",.14)="c"
+13 IF COMMENT'=""
SET WVFDA(790.1,WVIEN_",",3.01)=COMMENT
+14 IF $DATA(WV79023)
DO ADDITEMS(.WV79023,.WVFDA,WVIEN,TIMESTMP,VISIT,NOTE,0)
+15 DO UPDATE^DIE("","WVFDA","","WVERR")
+16 IF $DATA(WVERR)
Begin DoDot:1
+17 SET RESULT(1)="-1^Error updating procedure data"
+18 SET NUM=0
+19 SET NUM=NUM+1
SET ^TMP("PXRMXMZ",$JOB,NUM,0)="Error adding Women's Health Procedure to the WV PROCEDURE FILE."
+20 DO BLDMSG^WVRPCGF1(PAT,"ERROR Updating WV PROCEDURE File",.NUM)
End DoDot:1
QUIT
+21 SET WVPAT=$PIECE($GET(^WV(790.1,WVIEN,0)),U,2)
if WVPAT'>0
QUIT
+22 ;update existing Episode TODO: needs to be replace with sometype of file driver eventually
+23 DO ADD^PXRMEOC(WVPAT,TIMESTMP,WVIEN_";WV(790.1,",1,0,"BREAST CARE",.WVERR)
+24 IF '$DATA(WVERR)
QUIT
+25 SET NUM=0
+26 SET NUM=NUM+1
SET ^TMP("PXRMXMZ",$JOB,NUM,0)="Error adding Women's Health Procedure to the patient episode file."
+27 DO BLDMSG^WVRPCGF1(PAT,"ERROR Updating Episode of Care File.",.NUM)
+28 QUIT
+29 ;
UPRESLT(RESULT,WVIEN,COMMENT,TIMESTMP,NOTE,WV79023) ;
+1 NEW NUM,WVERR,WVFDA
+2 IF $GET(WVIEN)'>0
QUIT
+3 IF COMMENT'=""
SET WVFDA(790.1,WVIEN_",",3.01)=COMMENT
+4 IF $DATA(WV79023)
DO ADDITEMS(.WV79023,.WVFDA,WVIEN,TIMESTMP,VISIT,NOTE,0)
+5 DO UPDATE^DIE("","WVFDA","","WVERR")
+6 IF $DATA(WVERR)
Begin DoDot:1
+7 SET RESULT(1)="-1^Error updating procedure data"
+8 SET NUM=0
+9 SET NUM=NUM+1
SET ^TMP("PXRMXMZ",$JOB,NUM,0)="Error adding Women's Health Procedure to the WV PROCEDURE FILE."
+10 DO BLDMSG^WVRPCGF1(PAT,"ERROR Updating WV PROCEDURE File",.NUM)
End DoDot:1
QUIT
+11 QUIT
+12 ;check to see if notifications should be added, loop through each notification
ADDNOTS(RESULT,INPUTS,ID,WVIEN,WVDFN,PURARR) ;
+1 ;
+2 NEW DFN,NODE,WVERRADD,WVFAC,WVNODE,WVNPFLAG,WVPDATE,WVPURP
+3 NEW WVTYPE,WVOUTCOM,WVPRINTR,WVFUDATE,WVCONWHO,WVCONDTE
+4 ;TYPE_U_OUTCOME_U_CONTDATE_U_CONTWHO
+5 ;process each procedure
+6 SET WVPURP=0
FOR
SET WVPURP=$ORDER(PURARR(WVPURP))
if WVPURP'>0
QUIT
Begin DoDot:1
+7 ;purpose
IF '$DATA(^WV(790.404,+$GET(WVPURP),0))
QUIT
+8 SET NODE=PURARR(WVPURP)
+9 SET WVTYPE=$PIECE(NODE,U)
SET WVOUTCOM=$PIECE(NODE,U,2)
+10 SET WVCONDTE=$PIECE(NODE,U,3)
SET WVCONWHO=$PIECE(NODE,U,4)
+11 SET WVPRINTR=$PIECE(NODE,U,5)
+12 IF WVIEN'>0
QUIT
+13 DO SETNOT(.RESULT,.INPUTS,.WVTRMTS,WVIEN,WVPURP,WVTYPE,WVOUTCOM,WVPRINTR,WVDFN,WVCONWHO,WVCONDTE)
End DoDot:1
+14 ; if a purpose and type, check other notification in the Episode for lack of type of notification. If found update
+15 IF $DATA(PURARR)
IF WVTYPE'=""
DO SETNOTO(.RESULT,ID,.INPUTS,WVDFN,WVTYPE)
+16 QUIT
+17 ;
+18 ;add the notification record to file 790.4
SETNOT(RESULT,INPUTS,WVTRMTS,WVIEN,WVPURP,WVTYPE,WVOUTCUM,WVPRINTR,WVDFN,WVCONWHO,WVCONDTE,WVPDATE) ;
+1 NEW DLAYGO
+2 NEW WVDA7904,WVDXFLAG,WVERR,WVFAC,WVFDA,WVFDAIEN,WVLDAT,WVLPRG,WVTXFLAG,WVTYPARR
+3 ;
+4 SET WVTYPARR("CONVERSATION WITH PATIENT")=""
+5 SET WVTYPARR("PHONE CALL, 1ST")=""
+6 SET WVTYPARR("PHONE CALL, 2ND")=""
+7 SET WVTYPARR("PHONE CALL, 3RD")=""
+8 SET WVTYPARR("SECURE MESSAGING")=""
+9 ;
+10 ;facility ien
IF '$GET(WVFAC)
SET WVFAC=DUZ(2)
+11 SET WVDXFLAG=$PIECE($GET(^WV(790.02,+WVFAC,0)),U,11,12)
+12 ;update treatment needs?
SET WVTXFLAG=$PIECE(WVDXFLAG,U,2)
+13 ;update results/dx?
SET WVDXFLAG=$PIECE(WVDXFLAG,U,1)
+14 ;use today if no procedure date
if $GET(WVPDATE)'>0
SET WVPDATE=DT
+15 IF $GET(WVPRINTR)]""
SET WVOUTCUM=$$GETOIEN^WVRPCNO1("Letter Sent")
+16 ; create File 790.4 entry
+17 ;DFN
SET WVFDA(790.4,"+1,",.01)=WVDFN
+18 ;date opened
SET WVFDA(790.4,"+1,",.02)=DT
+19 ;type
IF $GET(WVTYPE)'=""
SET WVFDA(790.4,"+1,",.03)=WVTYPE
+20 ;purpose
SET WVFDA(790.4,"+1,",.04)=WVPURP
+21 ;outcome
SET WVFDA(790.4,"+1,",.05)=WVOUTCUM
+22 ;wh accession #
IF +$GET(WVIEN)>0
SET WVFDA(790.4,"+1,",.06)=$GET(WVIEN)
+23 ;facility
SET WVFDA(790.4,"+1,",.07)=$SELECT($GET(WVFAC):$GET(WVFAC),1:DUZ(2))
+24 ;I $G(WVTYPE)'="" S WVFDA(790.4,"+1,",.08)=DT ;date closed
+25 IF WVCONWHO'=""
SET WVFDA(790.4,"+1,",1)=WVCONWHO
+26 IF WVCONDTE'=""
SET WVFDA(790.4,"+1,",2)=WVCONDTE
+27 ;print date
IF $PIECE($GET(^WV(790.403,+$GET(WVTYPE),0)),U,2)=1
SET WVFDA(790.4,"+1,",.11)=DT
+28 ;complete by date
SET WVFDA(790.4,"+1,",.13)=DT
+29 ;status
IF $GET(WVTYPE)'=""
SET WVFDA(790.4,"+1,",.14)="c"
+30 IF $GET(WVTYPE)'=""
IF $DATA(WVTYPARR(WVTYPE))
Begin DoDot:1
+31 SET WVFDA(790.4,"+1,",.14)="c"
+32 SET WVFDA(790.4,"+1,",.08)=DT
End DoDot:1
+33 DO UPDATE^DIE("","WVFDA","WVFDAIEN","WVERR")
+34 IF $DATA(WVERR)
Begin DoDot:1
+35 SET RESULT(1)="-1^Error updating the notification data"
+36 SET NUM=0
+37 SET NUM=NUM+1
SET ^TMP("PXRMXMZ",$JOB,NUM,0)="Error adding Women's Health Notifications to the WV NOTIFICATION FILE."
+38 DO BLDMSG^WVRPCGF1(PAT,"ERROR Updating WV PROCEDURE File.",.NUM)
End DoDot:1
+39 SET WVDA7904=WVFDAIEN(1)
+40 ;
+41 ;no printer defined
if $GET(WVPRINTR)=""
QUIT
+42 ;not printable
if $PIECE($GET(^WV(790.403,+$GET(WVTYPE),0)),U,2)'=1
QUIT
+43 SET WVPRINTR=$PIECE(WVPRINTR,";",2)
+44 if WVPRINTR=""
QUIT
+45 ;print letter
DO DEVICE^WVRPCNO1(WVDA7904,WVPRINTR)
+46 QUIT
+47 ;
+48 ;update any open notification link to the pass in 790.1 IEN
SETOPNOT(RESULT,WVDATA,NOTTYPE,INPUTS,PAT) ;
+1 NEW TYPE,WHEN,WHO,WVIEN
+2 SET TYPE=$GET(NOTTYPE("TYPE"))
IF TYPE=""
QUIT
+3 SET WHO=$GET(NOTTYPE("WHO"))
SET WHEN=$GET(NOTTYPE("WHEN"))
+4 SET WVIEN=0
FOR
SET WVIEN=$ORDER(WVDATA(WVIEN))
if WVIEN'>0
QUIT
Begin DoDot:1
+5 DO TYPEONLY(.RESULT,WVIEN,WHO,WHEN,TYPE,.INPUTS)
End DoDot:1
+6 QUIT
+7 ;
+8 ;find any open notification for the pass in Cascade name
SETNOTO(RESULT,ID,INPUTS,WVDFN,WVTYPE) ;
+1 NEW CONTWHO,CONTDATE,ITEM,WVARRAY,WVIEN
+2 IF $GET(INPUTS("DATA",790.1,ID,"NAME"))=""
QUIT
+3 DO GETOLIST^PXRMEOC(.WVARRAY,WVDFN,INPUTS("DATA",790.1,ID,"NAME"))
+4 SET CONTWHO=$GET(INPUTS("DATA",790.4,"+1,",1))
SET CONTDATE=$GET(INPUTS("DATA",790.4,"+1,",2))
+5 SET ITEM=""
FOR
SET ITEM=$ORDER(WVARRAY(ITEM))
if ITEM=""
QUIT
Begin DoDot:1
+6 if ITEM'["WV(790.1"
QUIT
+7 SET WVIEN=+ITEM
if WVIEN'>0
QUIT
+8 DO TYPEONLY(.RESULT,WVIEN,CONTWHO,CONTDATE,WVTYPE,.INPUTS)
End DoDot:1
+9 QUIT
+10 ;
TYPEONLY(RESULT,WVIEN,WVCONWHO,WVCONDTE,TYPE,INPUTS) ;
+1 NEW ACCESS,IEN,NODE,NUM,TMP,WVFDA,WVERR
+2 SET NODE=$GET(^WV(790.1,WVIEN,0))
if NODE=""
QUIT
+3 SET ACCESS=$PIECE(NODE,U)
+4 SET IEN=0
FOR
SET IEN=$ORDER(^WV(790.4,"C",ACCESS,IEN))
if IEN'>0!($DATA(WVERR))
QUIT
Begin DoDot:1
+5 KILL WVFDA
+6 SET NODE=$GET(^WV(790.4,IEN,0))
+7 IF +$PIECE(NODE,U,3)>0
QUIT
+8 IF +$PIECE(NODE,U,4)=0
QUIT
+9 IF $PIECE(NODE,U,14)="c"
QUIT
+10 SET WVFDA(790.4,IEN_",",.03)=TYPE
+11 SET WVFDA(790.4,IEN_",",.14)="c"
+12 IF WVCONWHO'=""
SET WVFDA(790.4,IEN_",",1)=WVCONWHO
+13 IF WVCONDTE'=""
SET WVFDA(790.4,IEN_",",2)=WVCONDTE
+14 IF '$DATA(WVFDA)
QUIT
+15 DO UPDATE^DIE("","WVFDA","","WVERR")
+16 IF $DATA(WVERR)
Begin DoDot:2
+17 SET RESULT(1)="-1^Error updating the notification data"
+18 SET NUM=0
+19 SET NUM=NUM+1
SET ^TMP("PXRMXMZ",$JOB,NUM,0)="Error adding Women's Health Notifications to the WV NOTIFICATION FILE."
+20 DO BLDMSG^WVRPCGF1(PAT,"ERROR Updating WV PROCEDURE File.",.NUM)
End DoDot:2
End DoDot:1
+21 QUIT
+22 ;
