WVRPCPT1 ;ISP/RFR - WV PATIENT FILE (790) APIS AND RPCS ;Jun 15, 2021@12:11
;;1.0;WOMEN'S HEALTH;**24,26**;Sep 30, 1998;Build 624
Q
GETFINDS(RESULT,WVDFN,WVVISIT,WVNIEN) ;RETURN DATA NEEDED TO IDENTIFY GENERAL FINDINGS
; INPUT: RESULT - SUBSCRIPT UNDER WHICH TO RETURN DATA OR ERROR MESSAGES
; [OPTIONAL; DEFAULT IS "WVDATA"]
; WVDFN - IEN OF PATIENT IN WV PATIENT FILE [REQUIRED]
; WVVISIT - IEN IN VISIT FILE OR TIU VISIT STRING [OPTIONAL]
; WVNIEN - IEN IN TIU DOCUMENT FILE [OPTIONAL]
; NOTE: ONE OF WVVISIT OR WVNIEN IS REQUIRED; BOTH CANNOT BE NULL
; OUTPUT: ^TMP(RESULT,$J)=NUMBER OF ENTRIES RETURNED
; -1^Error message
; FOR NON-MULTIPLES:
; ^TMP(RESULT,$J,"PACKAGE","FILE NUMBER","FIELD NUMBER")=EXTERNAL FORMAT
; FOR MULTIPLES:
; ^TMP(RESULT,$J,"PACKAGE","FILE NUMBER","FIELD NUMBER",IEN)=EXTERNAL FORMAT
I $G(RESULT)="" S RESULT="WVDATA"
K ^TMP(RESULT,$J)
I $G(WVDFN)'?1.N D Q
.S ^TMP(RESULT,$J)="-1"_U_"Invalid parameter: WVDFN="_$G(WVDFN)
I '$D(^WV(790,WVDFN)) D Q
.S ^TMP(RESULT,$J)="-1"_U_"The specified patient is not in the WV PATIENT file"
N VISIT,WVLOOP
S VISIT=$G(WVVISIT)
I VISIT'="" D Q:$D(^TMP(RESULT,$J))
.I VISIT[";" S VISIT=$$VISITIEN^WVUTL11(WVDFN,VISIT)
.I VISIT<1 D Q
..S ^TMP(RESULT,$J)="-1"_U_"Invalid parameter: WVVISIT="_$G(WVVISIT)
.S WVLOOP=$NA(^WV(790,WVDFN,0,"C",VISIT))
N NOTE
S NOTE=$G(WVNIEN)
I NOTE'="" S WVLOOP=$NA(^WV(790,WVDFN,0,"D",NOTE))
I VISIT="",NOTE="" D Q
.S ^TMP(RESULT,$J)="-1"_U_"Missing parameter: One of WVVISIT or WVNIEN is required"
N WVPKG,WVERROR
S WVPKG=+$$FIND1^DIC(9.4,,,"WOMEN'S HEALTH",,"I $P($G(^(0)),U,2)=""WV""","WVERROR")
I WVPKG<1 D Q
.S ^TMP(RESULT,$J)="-1"_U_"Could not find the WOMEN'S HEALTH entry in the PACKAGE FILE"
.I $D(WVERROR) S ^TMP(RESULT,$J)=^TMP(RESULT,$J)_" "_$$FMERROR^WVUTL11(.WVERROR)
.S ^TMP(RESULT,$J)=^TMP(RESULT,$J)_"."
N WVSUB1,WVIEN1,WVSUB2,WVIEN2,WVPIECE,WVCOUNT,WVFILES,WVFIELD,WVNODE
S WVFILES(4)=790.05,WVFILES(4,3)=790.17,WVFILES(5)=790.16
F WVSUB1=4,5 D
.S $P(WVLOOP,",",3)=WVSUB1,WVIEN1=0
.F S WVIEN1=$O(@WVLOOP@(WVIEN1)) Q:'+WVIEN1 D
..S WVNODE=$G(^WV(790,WVDFN,WVSUB1,WVIEN1,0))
..S ^TMP(RESULT,$J,WVPKG,WVFILES(WVSUB1),3)=$$EXTERNAL^DILFD(WVFILES(WVSUB1),3,"",$P(WVNODE,U,3))
..S WVCOUNT=1+$G(WVCOUNT) F WVSUB2=2:1:4 I $D(^WV(790,WVDFN,WVSUB1,WVIEN1,WVSUB2)) D
...I $D(^WV(790,WVDFN,WVSUB1,WVIEN1,WVSUB2))=1 S WVNODE=$G(^(WVSUB2)) F WVPIECE=1:1:$L(WVNODE,U) I $P(WVNODE,U,WVPIECE)'="" D
....S WVFIELD=WVSUB2_WVPIECE,^TMP(RESULT,$J,WVPKG,WVFILES(WVSUB1),WVFIELD)=$$EXTERNAL^DILFD(WVFILES(WVSUB1),WVFIELD,"",$P(WVNODE,U,WVPIECE))
...I $D(^WV(790,WVDFN,WVSUB1,WVIEN1,WVSUB2))>9 S WVIEN2=0 F S WVIEN2=$O(^WV(790,WVDFN,WVSUB1,WVIEN1,WVSUB2,WVIEN2)) Q:'+WVIEN2 D
....S ^TMP(RESULT,$J,WVPKG,WVFILES(WVSUB1,WVSUB2),.01,WVIEN2)=$$EXTERNAL^DILFD(WVFILES(WVSUB1,WVSUB2),.01,"",$P($G(^WV(790,WVDFN,WVSUB1,WVIEN1,WVSUB2,WVIEN2,0)),U))
;check smart
N DX,INDEX,ITEM,LOOKUP,NODE,WVIEN,WVNODE
S INDEX="V",LOOKUP=$G(VISIT)
I $G(NOTE)>0 S INDEX="NOTE",LOOKUP=NOTE
S WVIEN=0 F S WVIEN=$O(^WV(790.1,INDEX,LOOKUP,WVIEN)) Q:WVIEN'>0 D
.S WVNODE=$G(^WV(790.1,WVIEN,0))
.S WVCOUNT=1+$G(WVCOUNT)
.I $P(WVNODE,U,5)>0 D
..S DX=$P($G(^WV(790.31,+$P(WVNODE,U,5),0)),U)
..S ^TMP(RESULT,$J,WVPKG,790.1,.05)=DX
.I $P($G(^WV(790.1,WVIEN,3)),U)'="" S ^TMP(RESULT,$J,WVPKG,790.1,3.01)=$P($G(^WV(790.1,WVIEN,3)),U)
.S ITEM=0 F S ITEM=$O(^WV(790.1,INDEX,LOOKUP,WVIEN,ITEM)) Q:ITEM'>0 D
..S NODE=$G(^WV(790.1,WVIEN,10,ITEM,0)) I $P(NODE,U)="" Q
..S ^TMP(RESULT,$J,WVPKG,790.23,.01,ITEM)=$P(NODE,U)
S ^TMP(RESULT,$J)=+$G(WVCOUNT)
Q
SHOVISIT ;RETURN MESSAGE FOR TIU USER ABOUT PRESENCE OF PREGNANCY/LACTATION STATUS DATA
N WVCNT,WVDFN,WVVISIT,WVSUB1,WVDATA,WVTEXT,WVTMP,WVDOC,WVACT
S WVDFN=$G(^TMP("TIUDOCDIS",$J,"PATIENT")),WVVISIT=+$G(^("VISIT")),WVDOC=+$G(^("DOCUMENT")),WVACT=$G(^("ACTION"))
S WVCNT=0
F WVSUB1=4,5 D
.I +$O(^WV(790,WVDFN,WVSUB1,"D",WVDOC,0))>0 S WVDATA("DOCUMENT")=WVSUB1+$G(WVDATA("DOCUMENT")) Q
.I +$O(^WV(790,WVDFN,WVSUB1,"C",WVVISIT,0))>0 S WVDATA("VISIT")=WVSUB1+$G(WVDATA("VISIT"))
S WVDATA=$S($G(WVDATA("DOCUMENT"))>0:WVDATA("DOCUMENT")_U_$P($G(^TMP("TIUDOCDIS",$J,"DOCUMENT")),U,2)_" (#"_WVDOC_") document",1:+$G(WVDATA("VISIT"))_U_$P($G(^TMP("TIUDOCDIS",$J,"DOCUMENT")),U,2)_" (#"_WVDOC_") document's visit")
S WVDATA=WVDATA_" that will remain in the database after deletion of this document."
I $P(WVDATA,U)>0,WVACT="RETRACT" D
.D WRAP^ORUTL("There is "_$S(+WVDATA=4:"pregnancy",+WVDATA=5:"lactation",+WVDATA=9:"pregnancy and lactation",1:"")_" status data associated with the "_$P(WVDATA,U,2),"WVTMP",0,,,.WVCNT)
D FINDPROC^WVRPCPT2(.WVTMP,.WVCNT,WVDFN,WVVISIT,WVDOC,0,0,0)
I WVCNT=0 Q
I $G(DUZ(2))?1.N S WVTEXT=$P($G(^WV(790.02,DUZ(2),44)),U)
I $G(WVTEXT)'="" S WVCNT=WVCNT+1,WVTMP(WVCNT)=" ",WVCNT=WVCNT+1,WVTMP(WVCNT)=WVTEXT
S ^TMP("TIUDOCDIS",$J,"MESSAGES","WOMEN'S HEALTH")=WVCNT
M ^TMP("TIUDOCDIS",$J,"MESSAGES","WOMEN'S HEALTH")=WVTMP
Q
;
GETORDRS(WVDFN,WVTYPE,WVCCACHE) ;GET HARMFUL ORDERS FOR A GIVEN CONTEXT
; INPUT: WVDFN - INTERNAL ENTRY NUMBER (IEN) OF PATIENT IN WV PATIENT FILE (#790)
; WVTYPE - CONTEXT OF ORDERS [REQUIRED]:
; "P": PREGNANT
; "L": LACTATING
; WVCCACHE - STORE RETURNED TEXT IN CACHE [OPTIONAL]:
; 1: STORE TEXT IN CACHE
; 0 OR UNDEFINED: DO NOT STORE TEXT IN CACHE
S WVCCACHE=+$G(WVCCACHE)
N WVRESULT,WVCACHE,WVLINE
S WVRESULT=$NA(^TMP("WVPTO",$J)),WVCACHE=$NA(^TMP("WVPTOCACHE",$J,WVTYPE))
K @WVRESULT
I '$$VERDFN(.WVDFN,0,WVRESULT) D Q "~@"_WVRESULT
.S WVLINE=2 D WRAP^ORUTL(@WVRESULT@(1,0),WVRESULT,0,,,.WVLINE,80,1)
.S @WVRESULT@(1,0)="An automated review of this patient's chart for potentially harmful orders"
.S @WVRESULT@(2,0)="failed. A manual review is required."
I $D(@WVCACHE) D Q "~@"_WVRESULT
.M @WVRESULT=@WVCACHE
.K @WVCACHE
N WVFKST,WVRETURN,WVLEN,WVCNT,WVORN,WVOCRNM
S WVTYPE=$G(WVTYPE),WVFKST=1,WVLINE=7,WVCNT=0
S WVRETURN=$$GETORDRS^WVUTL12(WVDFN,$S(WVTYPE="L":1,1:0))
I $P(@WVRETURN@(0),U)=-1 D
.S @WVRESULT@(1,0)="An automated review of this patient's chart for potentially harmful orders"
.S @WVRESULT@(2,0)="failed. A manual review is required.",@WVRESULT@(3,0)=""
.S WVLINE=3 D WRAP^ORUTL("Error: "_$P(@WVRETURN@(0),U,2),WVRESULT,1,,,.WVLINE,80,1)
S WVORN=0 F S WVORN=$O(@WVRETURN@(WVORN)) Q:'+WVORN D
.N WVCONT
.S WVOCRNM="" F S WVOCRNM=$O(@WVRETURN@(WVORN,"RULES",WVOCRNM)) Q:WVOCRNM=""!($G(WVCONT)) I ((WVTYPE="P")&(WVOCRNM["PREG"))!((WVTYPE="L")&(WVOCRNM["LACT")) S WVCONT=1
.Q:'$G(WVCONT)
.N WVOI,WVSTART,WVSTOP
.S WVOI=$G(@WVRETURN@(WVORN,"TX",1)),@WVRESULT@(WVLINE,0)=WVOI,WVLINE=WVLINE+1,WVCNT=1+WVCNT
.I $L(WVOI)>$G(WVLEN) S WVLEN=$L(WVOI)
.S @WVRESULT@(WVLINE,0)=" "_$$LJ^XLFSTR($P($G(@WVRETURN@(WVORN)),U,6),20)_" "
.S WVSTART=$P($G(@WVRETURN@(WVORN)),U,4)
.I WVSTART'="" S @WVRESULT@(WVLINE,0)=@WVRESULT@(WVLINE,0)_$$FMTE^XLFDT(WVSTART,"5DZ")
.S WVSTOP=$P($G(@WVRETURN@(WVORN)),U,5)
.I WVSTOP'="" D
..I WVSTART="" S @WVRESULT@(WVLINE,0)=@WVRESULT@(WVLINE,0)_$$REPEAT^XLFSTR(" ",10)
..S @WVRESULT@(WVLINE,0)=@WVRESULT@(WVLINE,0)_" "_$$FMTE^XLFDT(WVSTOP,"5DZ")
.S WVLINE=WVLINE+1
I '$P(@WVRETURN@(0),U)!(WVCNT=0) D
.S @WVRESULT@(1,0)="An automated review of this patient's chart indicates there are no"
.S @WVRESULT@(2,0)="potentially harmful orders to review."
K @WVRETURN
I WVCNT>0 D
.S @WVRESULT@(WVLINE,0)=" ",WVLINE=1
.S @WVRESULT@(WVLINE,0)="An automated review of this patient's chart indicates the following",WVLINE=WVLINE+1
.S @WVRESULT@(WVLINE,0)="order"_$S(WVCNT=1:" is",1:"s are")_" potentially harmful:",WVLINE=WVLINE+1
.S @WVRESULT@(WVLINE,0)="",WVLINE=WVLINE+1
.S @WVRESULT@(WVLINE,0)="Orderable Item",WVLINE=WVLINE+1
.S @WVRESULT@(WVLINE,0)=" Status Start Stop",WVLINE=WVLINE+1
.S WVLEN=$G(WVLEN)+1,@WVRESULT@(WVLINE,0)=$$REPEAT^XLFSTR("=",$S(WVLEN>78:78,WVLEN<46:46,1:WVLEN))
I WVCCACHE D
.M @WVCACHE=@WVRESULT
.S ^TMP("WVGETORDERS",$J,WVTYPE)=WVCNT
Q "~@"_WVRESULT
GETMRST(WVDFN,WVTYPE) ;GET MOST RECENT STATUS
; INPUT: WVDFN - INTERNAL ENTRY NUMBER (IEN) OF PATIENT IN WV PATIENT FILE (#790)
; WVTYPE - TYPE OF STATUS TO RETURN; P FOR PREGNANCY, L FOR LACTATION
N WVRESULT,WVPATNM,WVNUM,WVLINE,WVVALUE,WVSUB
S WVRESULT=$NA(^TMP("WVPTO",$J)),WVLINE=1
K @WVRESULT
I '$$VERDFN(.WVDFN,1,WVRESULT) Q "~@"_WVRESULT
I "^L^P^"'[(U_WVTYPE_U) D Q "~@"_WVRESULT
.S @WVRESULT@(1,0)="Invalid type specified: """_$G(WVTYPE)_""""
D GETDATA^WVRPCPT("WVSTATS",WVDFN,WVTYPE)
S WVSUB=$S(WVTYPE="P":"PREGNANCY",1:"LACTATION")
F WVNUM=1:1:$G(^TMP("WVSTATS",$J)) Q:WVLINE>1 D
.Q:'$D(^TMP("WVSTATS",$J,WVNUM))
.Q:+$G(^TMP("WVSTATS",$J,WVNUM,WVSUB_" STATE"))'=1
.S @WVRESULT@(WVLINE,0)=$$LJ^XLFSTR("DATE",23)_WVSUB_" STATE",WVLINE=WVLINE+1
.S @WVRESULT@(WVLINE,0)=" DETAILS",WVLINE=WVLINE+1
.S @WVRESULT@(WVLINE,0)=$$REPEAT^XLFSTR("=",50),WVLINE=WVLINE+1
.S @WVRESULT@(WVLINE,0)=$$LJ^XLFSTR($P($G(^TMP("WVSTATS",$J,WVNUM,WVSUB_" STATUS D/T ENTERED")),U,2),23)
.S @WVRESULT@(WVLINE,0)=@WVRESULT@(WVLINE,0)_$P($G(^TMP("WVSTATS",$J,WVNUM,WVSUB_" STATE")),U,2)
.S WVLINE=WVLINE+1
.I WVTYPE="P" D
..S WVVALUE=$P($G(^TMP("WVSTATS",$J,WVNUM,"LAST MENSTRUAL PERIOD DATE")),U,2)
..I WVVALUE'="" S @WVRESULT@(WVLINE,0)=" LAST MENSTRUAL PERIOD DATE: "_WVVALUE,WVLINE=WVLINE+1
..S WVVALUE=$P($G(^TMP("WVSTATS",$J,WVNUM,"EDD")),U,2)
..I WVVALUE'="" S @WVRESULT@(WVLINE,0)=" EXPECTED DUE DATE: "_WVVALUE,WVLINE=WVLINE+1
..S WVVALUE=$P($G(^TMP("WVSTATS",$J,WVNUM,"OVERRIDE CALCULATED EDD REASON")),U,2)
..I WVVALUE'="" D WRAP^ORUTL(" REASON WHY CALCULATED EDD WAS OVERRIDDEN: "_WVVALUE,WVRESULT,1,,,.WVLINE,80,1) S WVLINE=WVLINE+1
K ^TMP("WVSTATS",$J)
I '$D(@WVRESULT) S @WVRESULT@(1,0)="There is no status of "_$S(WVTYPE="P":"pregnant",1:"lactating")_" on file."
Q "~@"_WVRESULT
GETMUCRT(WVDFN) ;GET MOST RECENT MEDICALLY UNABLE TO CONCEIVE REASON
N WVRESULT,WVSTATS,WVNUM
S WVRESULT=$NA(^TMP("WVMUCRT",$J))
K @WVRESULT
D GETDATA^WVRPCPT("WVSTATS",WVDFN,"P",,,1)
I +$G(^TMP("WVSTATS",$J,1,"MEDICALLY UNABLE TO CONCEIVE")) D
.S @WVRESULT@(1,0)=$P($G(^TMP("WVSTATS",$J,1,"MEDICAL REASON")),U,2)
I '+$G(^TMP("WVSTATS",$J,1,"MEDICALLY UNABLE TO CONCEIVE")) D
.S @WVRESULT@(1,0)="The patient is not currently documented as medically unable to conceive."
K ^TMP("WVSTATS",$J)
Q "~@"_WVRESULT
VERDFN(WVDFN,WVCHKREG,WVRESULT) ;VERIFY DFN IS IN WV PATIENT FILE (#790)
I +$G(WVDFN)<1 S @WVRESULT@(1,0)="Invalid patient selected: """_$G(WVDFN)_"""" Q 0
I +$G(WVCHKREG),'$D(^WV(790,WVDFN)) D Q 0
.S WVPATNM=$P($G(^DPT(WVDFN,0)),U)
.S @WVRESULT@(1,0)=$S(WVPATNM'="":WVPATNM,1:"Patient #"_WVDFN)_" is not registered in the Women's Health package."
Q 1
SAVESRND(WVDATA) ;SAVE EVENT THAT TRIGGERED STATUS REVIEW NOTIFICATION
;INPUT: WVDATA - ARRAY OF DATA FOR THE EVENT
; WVDATA("LAB")="Observation D/T|Observation ID|Observation Sub-ID|Observation Value|Units|Reference Range"
; WVDATA("CODE")="Coding System|Code|Date of Interest|Date Recorded"
; WVDATA("ID")="IEN in file #790^Status Type"
; Status Type: P for Pregnancy or L for Lactation
;OUTPUT: $$SAVESRND - 1=Successfully saved the event
; 0=Did not save the event
; -1^Message=Error^Error message
N WVFDA,WVIEN,WVSTAT,WVDESC,WVLINES,WVDFN,WVEXIT,WVINDEX,WVMAP,WVVER,WVLAB
N WVCODE,WVDATE,WVADATE,WVSTART,WVSTOP,WVNODE
S WVLINES=0
I $L($G(WVDATA("ID")),U)=2 D
.S WVDFN=$P(WVDATA("ID"),U),WVFDA(790.9,"+1,",2)=WVDFN
.S WVFDA(790.9,"+1,",3)=$P(WVDATA("ID"),U,2)
I $L($G(WVDATA("LAB")),"|")=6 D
.D WRAP^ORUTL("Laboratory Test: "_$P($P(WVDATA("LAB"),"|",2),U,5),"WVDESC",,,,.WVLINES,,1)
.D WRAP^ORUTL("Collected On: "_$$FMTE^XLFDT($P(WVDATA("LAB"),"|"),1),"WVDESC",,,,.WVLINES,,1)
.D WRAP^ORUTL("Result: "_$P(WVDATA("LAB"),"|",4)_" "_$P(WVDATA("LAB"),"|",5),"WVDESC",,,,.WVLINES,,1)
.D WRAP^ORUTL("Reference Range: "_$P(WVDATA("LAB"),"|",6),"WVDESC",,,,.WVLINES,,1)
.S WVDATE=$$NOW^XLFDT
I $L($G(WVDATA("CODE")),"|")>=2 D Q:$G(WVEXIT) 0
.S WVDATE=$P(WVDATA("CODE"),"|",3)
.I WVDATE'="" D Q:$G(WVEXIT)
..S WVADATE=$P(WVDATE,".",1)
..I $P(WVDATA("ID"),U,2)="P" S WVINDEX="APREG",WVNODE=4
..E S WVINDEX="ALACT",WVNODE=5
..S WVSTART=0 F S WVSTART=$O(^WV(790,WVDFN,WVNODE,WVINDEX,WVSTART)) Q:('+WVSTART)!($G(WVEXIT)) D
...S WVSTOP=$O(^WV(790,WVDFN,WVNODE,WVINDEX,WVSTART,0))
...I WVADATE>=WVSTART,WVADATE<=WVSTOP,$O(^WV(790,WVDFN,WVNODE,WVINDEX,WVSTART))>0 S WVEXIT=1
.I WVDATE="" S WVDATE=$$DT^XLFDT
.S WVCODE("C")=$P(WVDATA("CODE"),"|",2),WVCODE("S")=$P(WVDATA("CODE"),"|")
.S WVIEN=+$O(^WV(790.9,"C",WVDFN,$P(WVDATE,"."),WVCODE("S"),WVCODE("C"),0))
.I WVIEN>0,$D(^WV(790.9,WVIEN,0)) S WVEXIT=1 Q
.K WVIEN
.S WVFDA(790.9,"+1,",4)=WVCODE("S"),WVFDA(790.9,"+1,",5)=WVCODE("C")
.S WVSTAT=$$EXP^LEXCODE(WVCODE("C"),WVCODE("S"),WVDATE)
.I +WVSTAT=-1 D WRAP^ORUTL("Description for code "_WVCODE("C")_" in coding system "_WVCODE("S")_" not found: "_$P(WVSTAT,U,2),"WVDESC",,,,.WVLINES,,1)
.I +WVSTAT>-1 D WRAP^ORUTL("Code: "_$P(WVSTAT,U,2)_" ("_WVCODE("C")_")","WVDESC",,,,.WVLINES,,1)
.D WRAP^ORUTL("Visit/Admit Date/Time: "_$$FMTE^XLFDT(WVDATE,1),"WVDESC",,,,.WVLINES,,1)
.S WVFDA(790.9,"+1,",6)=WVDATE
.S WVDATE=$P(WVDATA("CODE"),"|",4)
.I WVDATE'?7N.1".".6N S WVDATE=$$NOW^XLFDT
I '$D(WVFDA(790.9,"+1,",2))!('$D(WVDESC)) Q -1_U_"Incomplete input."
S WVFDA(790.9,"+1,",.01)=WVDATE
D UPDATE^DIE("","WVFDA","WVIEN","WVERROR")
I $D(WVERROR) Q -1_U_$$FMERROR^WVUTL11(.WVERROR)
I $G(WVIEN(1))<1 Q -1_U_"A record number was not returned."
D WP^DIE(790.9,WVIEN(1)_",",10,"","WVDESC","WVERROR")
I $D(WVERROR) Q -1_U_$$FMERROR^WVUTL11(.WVERROR)
Q 1
GETSRND(WVDFN,WVTYPE) ;GET EVENT THAT TRIGGERED STATUS REVIEW NOTIFICATION
;INPUT: WVDFN - IEN IN FILE #790
; WVTYPE - STATUS TYPE FIELD (#3) IN WV PREGNANCY/LACTATION STATUS CONFLICT EVENTS FILE (#790.9)
N WVIEN,WVRETURN,WVLINE,WVCNT
S WVRETURN=$NA(^TMP("WVPTO",$J)),WVCNT=0
K @WVRETURN
I '$$VERDFN(.WVDFN,0,WVRETURN) Q "~@"_WVRETURN
S WVIEN=0 F S WVIEN=$O(^WV(790.9,"AC",WVDFN,WVTYPE,WVIEN)) Q:'+WVIEN D
.I WVCNT=0 M @WVRETURN=^WV(790.9,WVIEN,1) K @WVRETURN@(0) S WVCNT=+$P($G(^WV(790.9,WVIEN,1,0)),U,4) Q
.I WVCNT>0 S WVLINE=0 F S WVLINE=$O(^WV(790.9,WVIEN,1,WVLINE)) Q:'+WVLINE S WVCNT=1+WVCNT M @WVRETURN@(WVCNT)=^WV(790.9,WVIEN,1,WVLINE)
I WVCNT=0 D WRAP^ORUTL("There is no "_$S(WVTYPE="P":"pregnancy",WVTYPE="L":"lactation",1:"")_" status review event for "_$P($G(^DPT(WVDFN,0)),U)_".",WVRETURN,1,,,.WVCNT,80,1)
Q "~@"_WVRETURN
PATMGR(RESULTS,PAT,WHO,IDEN,DIV) ;RETURN HEALTHCARE MANAGERS FOR PATIENT
; INPUT: RESULTS - REFERENCE TO ARRAY IN WHICH TO RETURN DATA [REQUIRED]
; PAT - IEN OF PATIENT IN WV PATIENT FILE [REQUIRED]
; WHO - TYPE OF MANAGER TO RETURN; VALUES INCLUDE:
; "C" FOR CASE MANAGER
; "M" FOR MATERNITY CARE COORDINATOR
; "CM" FOR CASE MANAGER AND MATERNITY CARE COORDINATOR
; IDEN - WHETHER TO IDENTIFY THE PROVIDER'S ROLE IN THE RETURN ARRAY [OPTIONAL]
; 1 TO RETURN THE ROLE [DEFAULT], 0 TO NOT RETURN THE ROLE
; DIV - IEN OF THE INSTITUTION FOR THE PATIENT [REQUIRED]
N IEN,NODE
S IDEN=$G(IDEN,1),WHO=$G(WHO)
I "^C^M^CM^"'[(U_WHO_U) S RESULTS(0)="-1^Invalid healthcare manager specified" Q
S IEN=+$O(^WV(790,"B",PAT,""))
I IEN=0 D Q
.I WHO="M" S RESULTS(0)="-1^Patient record not found" Q
.I +$G(DIV)=0 S RESULTS(0)="-1^Patient record not found and invalid institution parameter" Q
.I '$D(^WV(790.02,DIV,0)) S RESULTS(0)="-1^Patient record not found and institution is not configured in site parameters" Q
.S NODE=$G(^WV(790.02,DIV,0))
.I WHO["C" D
..I $P(NODE,U,2)>0 S RESULTS($P(NODE,U,2))=$S(IDEN:$$NAME^XUAF4(DIV)_" DEFAULT CASE MANAGER",1:"")
..I +$P(NODE,U,2)=0 S RESULTS(0)="-1^Patient record not found and default case manager not set"
S NODE=$G(^WV(790,IEN,0))
I WHO["C",$P(NODE,U,10)>0 S RESULTS(+$P(NODE,U,10))=$S(IDEN:"ASSIGNED CASE MANAGER",1:"")
I WHO["M",$P(NODE,U,29)>0 S RESULTS(+$P(NODE,U,29))=$S(IDEN:"MATERNITY CARE COORDINATOR",1:"")
Q
GETRECIPS(RESULTS,PAT,SOURCE,TYPE,IDEN,DIV) ;RETURN STATUS CONFLICT NOTIFICATION RECIPIENTS
; INPUT: RESULTS - REFERENCE TO ARRAY IN WHICH TO RETURN RECIPIENT LIST
; [REQUIRED]
; PAT - IEN OF PATIENT IN WV PATIENT FILE [REQUIRED]
; SOURCE - TYPE OF CONFLICT SOURCE [REQUIRED]; VALUES INCLUDE:
; "CODE" FOR ICD AND SNOMED CODES
; "LAB" FOR LABORATORY TEST
; TYPE - TYPE OF STATUS CONFLICT [REQUIRED]; VALUES INCLUDE:
; "P" FOR PREGNANCY
; "L" FOR LACTATION
; IDEN - WHETHER TO IDENTIFY THE PROVIDER'S ROLE IN THE RETURN ARRAY [OPTIONAL]
; 1 TO RETURN THE ROLE, 0 TO NOT RETURN THE ROLE [DEFAULT]
; DIV - IEN OF THE INSTITUTION FOR THE PATIENT [REQUIRED]
N RECIPS,PCP
S RECIPS="CM",PCP=0,IDEN=+$G(IDEN)
I TYPE="P",$$REM^WVUTL11(PAT,"VA-WH MEDICALLY UNABLE TO CONCEIVE")="DUE NOW" D
.I SOURCE="CODE" S RECIPS="M"
.E S RECIPS=""
.S PCP=+$P($$OUTPTPR^SDUTL3(PAT,$$DT^XLFDT),U)
I RECIPS'="" D PATMGR(.RESULTS,PAT,RECIPS,IDEN,DIV)
I ('IDEN),($P($G(RESULTS(0)),U,2)["Patient record not found") K RESULTS
I PCP>0 S RESULTS(PCP)=$S(IDEN:"PRIMARY CARE PROVIDER",1:"")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HWVRPCPT1 17736 printed Oct 16, 2024@18:48:17 Page 2
WVRPCPT1 ;ISP/RFR - WV PATIENT FILE (790) APIS AND RPCS ;Jun 15, 2021@12:11
+1 ;;1.0;WOMEN'S HEALTH;**24,26**;Sep 30, 1998;Build 624
+2 QUIT
GETFINDS(RESULT,WVDFN,WVVISIT,WVNIEN) ;RETURN DATA NEEDED TO IDENTIFY GENERAL FINDINGS
+1 ; INPUT: RESULT - SUBSCRIPT UNDER WHICH TO RETURN DATA OR ERROR MESSAGES
+2 ; [OPTIONAL; DEFAULT IS "WVDATA"]
+3 ; WVDFN - IEN OF PATIENT IN WV PATIENT FILE [REQUIRED]
+4 ; WVVISIT - IEN IN VISIT FILE OR TIU VISIT STRING [OPTIONAL]
+5 ; WVNIEN - IEN IN TIU DOCUMENT FILE [OPTIONAL]
+6 ; NOTE: ONE OF WVVISIT OR WVNIEN IS REQUIRED; BOTH CANNOT BE NULL
+7 ; OUTPUT: ^TMP(RESULT,$J)=NUMBER OF ENTRIES RETURNED
+8 ; -1^Error message
+9 ; FOR NON-MULTIPLES:
+10 ; ^TMP(RESULT,$J,"PACKAGE","FILE NUMBER","FIELD NUMBER")=EXTERNAL FORMAT
+11 ; FOR MULTIPLES:
+12 ; ^TMP(RESULT,$J,"PACKAGE","FILE NUMBER","FIELD NUMBER",IEN)=EXTERNAL FORMAT
+13 IF $GET(RESULT)=""
SET RESULT="WVDATA"
+14 KILL ^TMP(RESULT,$JOB)
+15 IF $GET(WVDFN)'?1.N
Begin DoDot:1
+16 SET ^TMP(RESULT,$JOB)="-1"_U_"Invalid parameter: WVDFN="_$GET(WVDFN)
End DoDot:1
QUIT
+17 IF '$DATA(^WV(790,WVDFN))
Begin DoDot:1
+18 SET ^TMP(RESULT,$JOB)="-1"_U_"The specified patient is not in the WV PATIENT file"
End DoDot:1
QUIT
+19 NEW VISIT,WVLOOP
+20 SET VISIT=$GET(WVVISIT)
+21 IF VISIT'=""
Begin DoDot:1
+22 IF VISIT[";"
SET VISIT=$$VISITIEN^WVUTL11(WVDFN,VISIT)
+23 IF VISIT<1
Begin DoDot:2
+24 SET ^TMP(RESULT,$JOB)="-1"_U_"Invalid parameter: WVVISIT="_$GET(WVVISIT)
End DoDot:2
QUIT
+25 SET WVLOOP=$NAME(^WV(790,WVDFN,0,"C",VISIT))
End DoDot:1
if $DATA(^TMP(RESULT,$JOB))
QUIT
+26 NEW NOTE
+27 SET NOTE=$GET(WVNIEN)
+28 IF NOTE'=""
SET WVLOOP=$NAME(^WV(790,WVDFN,0,"D",NOTE))
+29 IF VISIT=""
IF NOTE=""
Begin DoDot:1
+30 SET ^TMP(RESULT,$JOB)="-1"_U_"Missing parameter: One of WVVISIT or WVNIEN is required"
End DoDot:1
QUIT
+31 NEW WVPKG,WVERROR
+32 SET WVPKG=+$$FIND1^DIC(9.4,,,"WOMEN'S HEALTH",,"I $P($G(^(0)),U,2)=""WV""","WVERROR")
+33 IF WVPKG<1
Begin DoDot:1
+34 SET ^TMP(RESULT,$JOB)="-1"_U_"Could not find the WOMEN'S HEALTH entry in the PACKAGE FILE"
+35 IF $DATA(WVERROR)
SET ^TMP(RESULT,$JOB)=^TMP(RESULT,$JOB)_" "_$$FMERROR^WVUTL11(.WVERROR)
+36 SET ^TMP(RESULT,$JOB)=^TMP(RESULT,$JOB)_"."
End DoDot:1
QUIT
+37 NEW WVSUB1,WVIEN1,WVSUB2,WVIEN2,WVPIECE,WVCOUNT,WVFILES,WVFIELD,WVNODE
+38 SET WVFILES(4)=790.05
SET WVFILES(4,3)=790.17
SET WVFILES(5)=790.16
+39 FOR WVSUB1=4,5
Begin DoDot:1
+40 SET $PIECE(WVLOOP,",",3)=WVSUB1
SET WVIEN1=0
+41 FOR
SET WVIEN1=$ORDER(@WVLOOP@(WVIEN1))
if '+WVIEN1
QUIT
Begin DoDot:2
+42 SET WVNODE=$GET(^WV(790,WVDFN,WVSUB1,WVIEN1,0))
+43 SET ^TMP(RESULT,$JOB,WVPKG,WVFILES(WVSUB1),3)=$$EXTERNAL^DILFD(WVFILES(WVSUB1),3,"",$PIECE(WVNODE,U,3))
+44 SET WVCOUNT=1+$GET(WVCOUNT)
FOR WVSUB2=2:1:4
IF $DATA(^WV(790,WVDFN,WVSUB1,WVIEN1,WVSUB2))
Begin DoDot:3
+45 IF $DATA(^WV(790,WVDFN,WVSUB1,WVIEN1,WVSUB2))=1
SET WVNODE=$GET(^(WVSUB2))
FOR WVPIECE=1:1:$LENGTH(WVNODE,U)
IF $PIECE(WVNODE,U,WVPIECE)'=""
Begin DoDot:4
+46 SET WVFIELD=WVSUB2_WVPIECE
SET ^TMP(RESULT,$JOB,WVPKG,WVFILES(WVSUB1),WVFIELD)=$$EXTERNAL^DILFD(WVFILES(WVSUB1),WVFIELD,"",$PIECE(WVNODE,U,WVPIECE))
End DoDot:4
+47 IF $DATA(^WV(790,WVDFN,WVSUB1,WVIEN1,WVSUB2))>9
SET WVIEN2=0
FOR
SET WVIEN2=$ORDER(^WV(790,WVDFN,WVSUB1,WVIEN1,WVSUB2,WVIEN2))
if '+WVIEN2
QUIT
Begin DoDot:4
+48 SET ^TMP(RESULT,$JOB,WVPKG,WVFILES(WVSUB1,WVSUB2),.01,WVIEN2)=$$EXTERNAL^DILFD(WVFILES(WVSUB1,WVSUB2),.01,"",$PIECE($GET(^WV(790,WVDFN,WVSUB1,WVIEN1,WVSUB2,WVIEN2,0)),U))
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+49 ;check smart
+50 NEW DX,INDEX,ITEM,LOOKUP,NODE,WVIEN,WVNODE
+51 SET INDEX="V"
SET LOOKUP=$GET(VISIT)
+52 IF $GET(NOTE)>0
SET INDEX="NOTE"
SET LOOKUP=NOTE
+53 SET WVIEN=0
FOR
SET WVIEN=$ORDER(^WV(790.1,INDEX,LOOKUP,WVIEN))
if WVIEN'>0
QUIT
Begin DoDot:1
+54 SET WVNODE=$GET(^WV(790.1,WVIEN,0))
+55 SET WVCOUNT=1+$GET(WVCOUNT)
+56 IF $PIECE(WVNODE,U,5)>0
Begin DoDot:2
+57 SET DX=$PIECE($GET(^WV(790.31,+$PIECE(WVNODE,U,5),0)),U)
+58 SET ^TMP(RESULT,$JOB,WVPKG,790.1,.05)=DX
End DoDot:2
+59 IF $PIECE($GET(^WV(790.1,WVIEN,3)),U)'=""
SET ^TMP(RESULT,$JOB,WVPKG,790.1,3.01)=$PIECE($GET(^WV(790.1,WVIEN,3)),U)
+60 SET ITEM=0
FOR
SET ITEM=$ORDER(^WV(790.1,INDEX,LOOKUP,WVIEN,ITEM))
if ITEM'>0
QUIT
Begin DoDot:2
+61 SET NODE=$GET(^WV(790.1,WVIEN,10,ITEM,0))
IF $PIECE(NODE,U)=""
QUIT
+62 SET ^TMP(RESULT,$JOB,WVPKG,790.23,.01,ITEM)=$PIECE(NODE,U)
End DoDot:2
End DoDot:1
+63 SET ^TMP(RESULT,$JOB)=+$GET(WVCOUNT)
+64 QUIT
SHOVISIT ;RETURN MESSAGE FOR TIU USER ABOUT PRESENCE OF PREGNANCY/LACTATION STATUS DATA
+1 NEW WVCNT,WVDFN,WVVISIT,WVSUB1,WVDATA,WVTEXT,WVTMP,WVDOC,WVACT
+2 SET WVDFN=$GET(^TMP("TIUDOCDIS",$JOB,"PATIENT"))
SET WVVISIT=+$GET(^("VISIT"))
SET WVDOC=+$GET(^("DOCUMENT"))
SET WVACT=$GET(^("ACTION"))
+3 SET WVCNT=0
+4 FOR WVSUB1=4,5
Begin DoDot:1
+5 IF +$ORDER(^WV(790,WVDFN,WVSUB1,"D",WVDOC,0))>0
SET WVDATA("DOCUMENT")=WVSUB1+$GET(WVDATA("DOCUMENT"))
QUIT
+6 IF +$ORDER(^WV(790,WVDFN,WVSUB1,"C",WVVISIT,0))>0
SET WVDATA("VISIT")=WVSUB1+$GET(WVDATA("VISIT"))
End DoDot:1
+7 SET WVDATA=$SELECT($GET(WVDATA("DOCUMENT"))>0:WVDATA("DOCUMENT")_U_$PIECE($GET(^TMP("TIUDOCDIS",$JOB,"DOCUMENT")),U,2)_" (#"_WVDOC_") document",1:+$GET(WVDATA("VISIT"))_U_$PIECE(...
... $GET(^TMP("TIUDOCDIS",$JOB,"DOCUMENT")),U,2)_" (#"_WVDOC_") document's visit")
+8 SET WVDATA=WVDATA_" that will remain in the database after deletion of this document."
+9 IF $PIECE(WVDATA,U)>0
IF WVACT="RETRACT"
Begin DoDot:1
+10 DO WRAP^ORUTL("There is "_$SELECT(+WVDATA=4:"pregnancy",+WVDATA=5:"lactation",+WVDATA=9:"pregnancy and lactation",1:"")_" status data associated with the "_$PIECE(WVDATA,U,2),"WVTMP",0,,,.WVCNT)
End DoDot:1
+11 DO FINDPROC^WVRPCPT2(.WVTMP,.WVCNT,WVDFN,WVVISIT,WVDOC,0,0,0)
+12 IF WVCNT=0
QUIT
+13 IF $GET(DUZ(2))?1.N
SET WVTEXT=$PIECE($GET(^WV(790.02,DUZ(2),44)),U)
+14 IF $GET(WVTEXT)'=""
SET WVCNT=WVCNT+1
SET WVTMP(WVCNT)=" "
SET WVCNT=WVCNT+1
SET WVTMP(WVCNT)=WVTEXT
+15 SET ^TMP("TIUDOCDIS",$JOB,"MESSAGES","WOMEN'S HEALTH")=WVCNT
+16 MERGE ^TMP("TIUDOCDIS",$JOB,"MESSAGES","WOMEN'S HEALTH")=WVTMP
+17 QUIT
+18 ;
GETORDRS(WVDFN,WVTYPE,WVCCACHE) ;GET HARMFUL ORDERS FOR A GIVEN CONTEXT
+1 ; INPUT: WVDFN - INTERNAL ENTRY NUMBER (IEN) OF PATIENT IN WV PATIENT FILE (#790)
+2 ; WVTYPE - CONTEXT OF ORDERS [REQUIRED]:
+3 ; "P": PREGNANT
+4 ; "L": LACTATING
+5 ; WVCCACHE - STORE RETURNED TEXT IN CACHE [OPTIONAL]:
+6 ; 1: STORE TEXT IN CACHE
+7 ; 0 OR UNDEFINED: DO NOT STORE TEXT IN CACHE
+8 SET WVCCACHE=+$GET(WVCCACHE)
+9 NEW WVRESULT,WVCACHE,WVLINE
+10 SET WVRESULT=$NAME(^TMP("WVPTO",$JOB))
SET WVCACHE=$NAME(^TMP("WVPTOCACHE",$JOB,WVTYPE))
+11 KILL @WVRESULT
+12 IF '$$VERDFN(.WVDFN,0,WVRESULT)
Begin DoDot:1
+13 SET WVLINE=2
DO WRAP^ORUTL(@WVRESULT@(1,0),WVRESULT,0,,,.WVLINE,80,1)
+14 SET @WVRESULT@(1,0)="An automated review of this patient's chart for potentially harmful orders"
+15 SET @WVRESULT@(2,0)="failed. A manual review is required."
End DoDot:1
QUIT "~@"_WVRESULT
+16 IF $DATA(@WVCACHE)
Begin DoDot:1
+17 MERGE @WVRESULT=@WVCACHE
+18 KILL @WVCACHE
End DoDot:1
QUIT "~@"_WVRESULT
+19 NEW WVFKST,WVRETURN,WVLEN,WVCNT,WVORN,WVOCRNM
+20 SET WVTYPE=$GET(WVTYPE)
SET WVFKST=1
SET WVLINE=7
SET WVCNT=0
+21 SET WVRETURN=$$GETORDRS^WVUTL12(WVDFN,$SELECT(WVTYPE="L":1,1:0))
+22 IF $PIECE(@WVRETURN@(0),U)=-1
Begin DoDot:1
+23 SET @WVRESULT@(1,0)="An automated review of this patient's chart for potentially harmful orders"
+24 SET @WVRESULT@(2,0)="failed. A manual review is required."
SET @WVRESULT@(3,0)=""
+25 SET WVLINE=3
DO WRAP^ORUTL("Error: "_$PIECE(@WVRETURN@(0),U,2),WVRESULT,1,,,.WVLINE,80,1)
End DoDot:1
+26 SET WVORN=0
FOR
SET WVORN=$ORDER(@WVRETURN@(WVORN))
if '+WVORN
QUIT
Begin DoDot:1
+27 NEW WVCONT
+28 SET WVOCRNM=""
FOR
SET WVOCRNM=$ORDER(@WVRETURN@(WVORN,"RULES",WVOCRNM))
if WVOCRNM=""!($GET(WVCONT))
QUIT
IF ((WVTYPE="P")&(WVOCRNM["PREG"))!((WVTYPE="L")&(WVOCRNM["LACT"))
SET WVCONT=1
+29 if '$GET(WVCONT)
QUIT
+30 NEW WVOI,WVSTART,WVSTOP
+31 SET WVOI=$GET(@WVRETURN@(WVORN,"TX",1))
SET @WVRESULT@(WVLINE,0)=WVOI
SET WVLINE=WVLINE+1
SET WVCNT=1+WVCNT
+32 IF $LENGTH(WVOI)>$GET(WVLEN)
SET WVLEN=$LENGTH(WVOI)
+33 SET @WVRESULT@(WVLINE,0)=" "_$$LJ^XLFSTR($PIECE($GET(@WVRETURN@(WVORN)),U,6),20)_" "
+34 SET WVSTART=$PIECE($GET(@WVRETURN@(WVORN)),U,4)
+35 IF WVSTART'=""
SET @WVRESULT@(WVLINE,0)=@WVRESULT@(WVLINE,0)_$$FMTE^XLFDT(WVSTART,"5DZ")
+36 SET WVSTOP=$PIECE($GET(@WVRETURN@(WVORN)),U,5)
+37 IF WVSTOP'=""
Begin DoDot:2
+38 IF WVSTART=""
SET @WVRESULT@(WVLINE,0)=@WVRESULT@(WVLINE,0)_$$REPEAT^XLFSTR(" ",10)
+39 SET @WVRESULT@(WVLINE,0)=@WVRESULT@(WVLINE,0)_" "_$$FMTE^XLFDT(WVSTOP,"5DZ")
End DoDot:2
+40 SET WVLINE=WVLINE+1
End DoDot:1
+41 IF '$PIECE(@WVRETURN@(0),U)!(WVCNT=0)
Begin DoDot:1
+42 SET @WVRESULT@(1,0)="An automated review of this patient's chart indicates there are no"
+43 SET @WVRESULT@(2,0)="potentially harmful orders to review."
End DoDot:1
+44 KILL @WVRETURN
+45 IF WVCNT>0
Begin DoDot:1
+46 SET @WVRESULT@(WVLINE,0)=" "
SET WVLINE=1
+47 SET @WVRESULT@(WVLINE,0)="An automated review of this patient's chart indicates the following"
SET WVLINE=WVLINE+1
+48 SET @WVRESULT@(WVLINE,0)="order"_$SELECT(WVCNT=1:" is",1:"s are")_" potentially harmful:"
SET WVLINE=WVLINE+1
+49 SET @WVRESULT@(WVLINE,0)=""
SET WVLINE=WVLINE+1
+50 SET @WVRESULT@(WVLINE,0)="Orderable Item"
SET WVLINE=WVLINE+1
+51 SET @WVRESULT@(WVLINE,0)=" Status Start Stop"
SET WVLINE=WVLINE+1
+52 SET WVLEN=$GET(WVLEN)+1
SET @WVRESULT@(WVLINE,0)=$$REPEAT^XLFSTR("=",$SELECT(WVLEN>78:78,WVLEN<46:46,1:WVLEN))
End DoDot:1
+53 IF WVCCACHE
Begin DoDot:1
+54 MERGE @WVCACHE=@WVRESULT
+55 SET ^TMP("WVGETORDERS",$JOB,WVTYPE)=WVCNT
End DoDot:1
+56 QUIT "~@"_WVRESULT
GETMRST(WVDFN,WVTYPE) ;GET MOST RECENT STATUS
+1 ; INPUT: WVDFN - INTERNAL ENTRY NUMBER (IEN) OF PATIENT IN WV PATIENT FILE (#790)
+2 ; WVTYPE - TYPE OF STATUS TO RETURN; P FOR PREGNANCY, L FOR LACTATION
+3 NEW WVRESULT,WVPATNM,WVNUM,WVLINE,WVVALUE,WVSUB
+4 SET WVRESULT=$NAME(^TMP("WVPTO",$JOB))
SET WVLINE=1
+5 KILL @WVRESULT
+6 IF '$$VERDFN(.WVDFN,1,WVRESULT)
QUIT "~@"_WVRESULT
+7 IF "^L^P^"'[(U_WVTYPE_U)
Begin DoDot:1
+8 SET @WVRESULT@(1,0)="Invalid type specified: """_$GET(WVTYPE)_""""
End DoDot:1
QUIT "~@"_WVRESULT
+9 DO GETDATA^WVRPCPT("WVSTATS",WVDFN,WVTYPE)
+10 SET WVSUB=$SELECT(WVTYPE="P":"PREGNANCY",1:"LACTATION")
+11 FOR WVNUM=1:1:$GET(^TMP("WVSTATS",$JOB))
if WVLINE>1
QUIT
Begin DoDot:1
+12 if '$DATA(^TMP("WVSTATS",$JOB,WVNUM))
QUIT
+13 if +$GET(^TMP("WVSTATS",$JOB,WVNUM,WVSUB_" STATE"))'=1
QUIT
+14 SET @WVRESULT@(WVLINE,0)=$$LJ^XLFSTR("DATE",23)_WVSUB_" STATE"
SET WVLINE=WVLINE+1
+15 SET @WVRESULT@(WVLINE,0)=" DETAILS"
SET WVLINE=WVLINE+1
+16 SET @WVRESULT@(WVLINE,0)=$$REPEAT^XLFSTR("=",50)
SET WVLINE=WVLINE+1
+17 SET @WVRESULT@(WVLINE,0)=$$LJ^XLFSTR($PIECE($GET(^TMP("WVSTATS",$JOB,WVNUM,WVSUB_" STATUS D/T ENTERED")),U,2),23)
+18 SET @WVRESULT@(WVLINE,0)=@WVRESULT@(WVLINE,0)_$PIECE($GET(^TMP("WVSTATS",$JOB,WVNUM,WVSUB_" STATE")),U,2)
+19 SET WVLINE=WVLINE+1
+20 IF WVTYPE="P"
Begin DoDot:2
+21 SET WVVALUE=$PIECE($GET(^TMP("WVSTATS",$JOB,WVNUM,"LAST MENSTRUAL PERIOD DATE")),U,2)
+22 IF WVVALUE'=""
SET @WVRESULT@(WVLINE,0)=" LAST MENSTRUAL PERIOD DATE: "_WVVALUE
SET WVLINE=WVLINE+1
+23 SET WVVALUE=$PIECE($GET(^TMP("WVSTATS",$JOB,WVNUM,"EDD")),U,2)
+24 IF WVVALUE'=""
SET @WVRESULT@(WVLINE,0)=" EXPECTED DUE DATE: "_WVVALUE
SET WVLINE=WVLINE+1
+25 SET WVVALUE=$PIECE($GET(^TMP("WVSTATS",$JOB,WVNUM,"OVERRIDE CALCULATED EDD REASON")),U,2)
+26 IF WVVALUE'=""
DO WRAP^ORUTL(" REASON WHY CALCULATED EDD WAS OVERRIDDEN: "_WVVALUE,WVRESULT,1,,,.WVLINE,80,1)
SET WVLINE=WVLINE+1
End DoDot:2
End DoDot:1
+27 KILL ^TMP("WVSTATS",$JOB)
+28 IF '$DATA(@WVRESULT)
SET @WVRESULT@(1,0)="There is no status of "_$SELECT(WVTYPE="P":"pregnant",1:"lactating")_" on file."
+29 QUIT "~@"_WVRESULT
GETMUCRT(WVDFN) ;GET MOST RECENT MEDICALLY UNABLE TO CONCEIVE REASON
+1 NEW WVRESULT,WVSTATS,WVNUM
+2 SET WVRESULT=$NAME(^TMP("WVMUCRT",$JOB))
+3 KILL @WVRESULT
+4 DO GETDATA^WVRPCPT("WVSTATS",WVDFN,"P",,,1)
+5 IF +$GET(^TMP("WVSTATS",$JOB,1,"MEDICALLY UNABLE TO CONCEIVE"))
Begin DoDot:1
+6 SET @WVRESULT@(1,0)=$PIECE($GET(^TMP("WVSTATS",$JOB,1,"MEDICAL REASON")),U,2)
End DoDot:1
+7 IF '+$GET(^TMP("WVSTATS",$JOB,1,"MEDICALLY UNABLE TO CONCEIVE"))
Begin DoDot:1
+8 SET @WVRESULT@(1,0)="The patient is not currently documented as medically unable to conceive."
End DoDot:1
+9 KILL ^TMP("WVSTATS",$JOB)
+10 QUIT "~@"_WVRESULT
VERDFN(WVDFN,WVCHKREG,WVRESULT) ;VERIFY DFN IS IN WV PATIENT FILE (#790)
+1 IF +$GET(WVDFN)<1
SET @WVRESULT@(1,0)="Invalid patient selected: """_$GET(WVDFN)_""""
QUIT 0
+2 IF +$GET(WVCHKREG)
IF '$DATA(^WV(790,WVDFN))
Begin DoDot:1
+3 SET WVPATNM=$PIECE($GET(^DPT(WVDFN,0)),U)
+4 SET @WVRESULT@(1,0)=$SELECT(WVPATNM'="":WVPATNM,1:"Patient #"_WVDFN)_" is not registered in the Women's Health package."
End DoDot:1
QUIT 0
+5 QUIT 1
SAVESRND(WVDATA) ;SAVE EVENT THAT TRIGGERED STATUS REVIEW NOTIFICATION
+1 ;INPUT: WVDATA - ARRAY OF DATA FOR THE EVENT
+2 ; WVDATA("LAB")="Observation D/T|Observation ID|Observation Sub-ID|Observation Value|Units|Reference Range"
+3 ; WVDATA("CODE")="Coding System|Code|Date of Interest|Date Recorded"
+4 ; WVDATA("ID")="IEN in file #790^Status Type"
+5 ; Status Type: P for Pregnancy or L for Lactation
+6 ;OUTPUT: $$SAVESRND - 1=Successfully saved the event
+7 ; 0=Did not save the event
+8 ; -1^Message=Error^Error message
+9 NEW WVFDA,WVIEN,WVSTAT,WVDESC,WVLINES,WVDFN,WVEXIT,WVINDEX,WVMAP,WVVER,WVLAB
+10 NEW WVCODE,WVDATE,WVADATE,WVSTART,WVSTOP,WVNODE
+11 SET WVLINES=0
+12 IF $LENGTH($GET(WVDATA("ID")),U)=2
Begin DoDot:1
+13 SET WVDFN=$PIECE(WVDATA("ID"),U)
SET WVFDA(790.9,"+1,",2)=WVDFN
+14 SET WVFDA(790.9,"+1,",3)=$PIECE(WVDATA("ID"),U,2)
End DoDot:1
+15 IF $LENGTH($GET(WVDATA("LAB")),"|")=6
Begin DoDot:1
+16 DO WRAP^ORUTL("Laboratory Test: "_$PIECE($PIECE(WVDATA("LAB"),"|",2),U,5),"WVDESC",,,,.WVLINES,,1)
+17 DO WRAP^ORUTL("Collected On: "_$$FMTE^XLFDT($PIECE(WVDATA("LAB"),"|"),1),"WVDESC",,,,.WVLINES,,1)
+18 DO WRAP^ORUTL("Result: "_$PIECE(WVDATA("LAB"),"|",4)_" "_$PIECE(WVDATA("LAB"),"|",5),"WVDESC",,,,.WVLINES,,1)
+19 DO WRAP^ORUTL("Reference Range: "_$PIECE(WVDATA("LAB"),"|",6),"WVDESC",,,,.WVLINES,,1)
+20 SET WVDATE=$$NOW^XLFDT
End DoDot:1
+21 IF $LENGTH($GET(WVDATA("CODE")),"|")>=2
Begin DoDot:1
+22 SET WVDATE=$PIECE(WVDATA("CODE"),"|",3)
+23 IF WVDATE'=""
Begin DoDot:2
+24 SET WVADATE=$PIECE(WVDATE,".",1)
+25 IF $PIECE(WVDATA("ID"),U,2)="P"
SET WVINDEX="APREG"
SET WVNODE=4
+26 IF '$TEST
SET WVINDEX="ALACT"
SET WVNODE=5
+27 SET WVSTART=0
FOR
SET WVSTART=$ORDER(^WV(790,WVDFN,WVNODE,WVINDEX,WVSTART))
if ('+WVSTART)!($GET(WVEXIT))
QUIT
Begin DoDot:3
+28 SET WVSTOP=$ORDER(^WV(790,WVDFN,WVNODE,WVINDEX,WVSTART,0))
+29 IF WVADATE>=WVSTART
IF WVADATE<=WVSTOP
IF $ORDER(^WV(790,WVDFN,WVNODE,WVINDEX,WVSTART))>0
SET WVEXIT=1
End DoDot:3
End DoDot:2
if $GET(WVEXIT)
QUIT
+30 IF WVDATE=""
SET WVDATE=$$DT^XLFDT
+31 SET WVCODE("C")=$PIECE(WVDATA("CODE"),"|",2)
SET WVCODE("S")=$PIECE(WVDATA("CODE"),"|")
+32 SET WVIEN=+$ORDER(^WV(790.9,"C",WVDFN,$PIECE(WVDATE,"."),WVCODE("S"),WVCODE("C"),0))
+33 IF WVIEN>0
IF $DATA(^WV(790.9,WVIEN,0))
SET WVEXIT=1
QUIT
+34 KILL WVIEN
+35 SET WVFDA(790.9,"+1,",4)=WVCODE("S")
SET WVFDA(790.9,"+1,",5)=WVCODE("C")
+36 SET WVSTAT=$$EXP^LEXCODE(WVCODE("C"),WVCODE("S"),WVDATE)
+37 IF +WVSTAT=-1
DO WRAP^ORUTL("Description for code "_WVCODE("C")_" in coding system "_WVCODE("S")_" not found: "_$PIECE(WVSTAT,U,2),"WVDESC",,,,.WVLINES,,1)
+38 IF +WVSTAT>-1
DO WRAP^ORUTL("Code: "_$PIECE(WVSTAT,U,2)_" ("_WVCODE("C")_")","WVDESC",,,,.WVLINES,,1)
+39 DO WRAP^ORUTL("Visit/Admit Date/Time: "_$$FMTE^XLFDT(WVDATE,1),"WVDESC",,,,.WVLINES,,1)
+40 SET WVFDA(790.9,"+1,",6)=WVDATE
+41 SET WVDATE=$PIECE(WVDATA("CODE"),"|",4)
+42 IF WVDATE'?7N.1".".6N
SET WVDATE=$$NOW^XLFDT
End DoDot:1
if $GET(WVEXIT)
QUIT 0
+43 IF '$DATA(WVFDA(790.9,"+1,",2))!('$DATA(WVDESC))
QUIT -1_U_"Incomplete input."
+44 SET WVFDA(790.9,"+1,",.01)=WVDATE
+45 DO UPDATE^DIE("","WVFDA","WVIEN","WVERROR")
+46 IF $DATA(WVERROR)
QUIT -1_U_$$FMERROR^WVUTL11(.WVERROR)
+47 IF $GET(WVIEN(1))<1
QUIT -1_U_"A record number was not returned."
+48 DO WP^DIE(790.9,WVIEN(1)_",",10,"","WVDESC","WVERROR")
+49 IF $DATA(WVERROR)
QUIT -1_U_$$FMERROR^WVUTL11(.WVERROR)
+50 QUIT 1
GETSRND(WVDFN,WVTYPE) ;GET EVENT THAT TRIGGERED STATUS REVIEW NOTIFICATION
+1 ;INPUT: WVDFN - IEN IN FILE #790
+2 ; WVTYPE - STATUS TYPE FIELD (#3) IN WV PREGNANCY/LACTATION STATUS CONFLICT EVENTS FILE (#790.9)
+3 NEW WVIEN,WVRETURN,WVLINE,WVCNT
+4 SET WVRETURN=$NAME(^TMP("WVPTO",$JOB))
SET WVCNT=0
+5 KILL @WVRETURN
+6 IF '$$VERDFN(.WVDFN,0,WVRETURN)
QUIT "~@"_WVRETURN
+7 SET WVIEN=0
FOR
SET WVIEN=$ORDER(^WV(790.9,"AC",WVDFN,WVTYPE,WVIEN))
if '+WVIEN
QUIT
Begin DoDot:1
+8 IF WVCNT=0
MERGE @WVRETURN=^WV(790.9,WVIEN,1)
KILL @WVRETURN@(0)
SET WVCNT=+$PIECE($GET(^WV(790.9,WVIEN,1,0)),U,4)
QUIT
+9 IF WVCNT>0
SET WVLINE=0
FOR
SET WVLINE=$ORDER(^WV(790.9,WVIEN,1,WVLINE))
if '+WVLINE
QUIT
SET WVCNT=1+WVCNT
MERGE @WVRETURN@(WVCNT)=^WV(790.9,WVIEN,1,WVLINE)
End DoDot:1
+10 IF WVCNT=0
DO WRAP^ORUTL("There is no "_$SELECT(WVTYPE="P":"pregnancy",WVTYPE="L":"lactation",1:"")_" status review event for "_$PIECE($GET(^DPT(WVDFN,0)),U)_".",WVRETURN,1,,,.WVCNT,80,1)
+11 QUIT "~@"_WVRETURN
PATMGR(RESULTS,PAT,WHO,IDEN,DIV) ;RETURN HEALTHCARE MANAGERS FOR PATIENT
+1 ; INPUT: RESULTS - REFERENCE TO ARRAY IN WHICH TO RETURN DATA [REQUIRED]
+2 ; PAT - IEN OF PATIENT IN WV PATIENT FILE [REQUIRED]
+3 ; WHO - TYPE OF MANAGER TO RETURN; VALUES INCLUDE:
+4 ; "C" FOR CASE MANAGER
+5 ; "M" FOR MATERNITY CARE COORDINATOR
+6 ; "CM" FOR CASE MANAGER AND MATERNITY CARE COORDINATOR
+7 ; IDEN - WHETHER TO IDENTIFY THE PROVIDER'S ROLE IN THE RETURN ARRAY [OPTIONAL]
+8 ; 1 TO RETURN THE ROLE [DEFAULT], 0 TO NOT RETURN THE ROLE
+9 ; DIV - IEN OF THE INSTITUTION FOR THE PATIENT [REQUIRED]
+10 NEW IEN,NODE
+11 SET IDEN=$GET(IDEN,1)
SET WHO=$GET(WHO)
+12 IF "^C^M^CM^"'[(U_WHO_U)
SET RESULTS(0)="-1^Invalid healthcare manager specified"
QUIT
+13 SET IEN=+$ORDER(^WV(790,"B",PAT,""))
+14 IF IEN=0
Begin DoDot:1
+15 IF WHO="M"
SET RESULTS(0)="-1^Patient record not found"
QUIT
+16 IF +$GET(DIV)=0
SET RESULTS(0)="-1^Patient record not found and invalid institution parameter"
QUIT
+17 IF '$DATA(^WV(790.02,DIV,0))
SET RESULTS(0)="-1^Patient record not found and institution is not configured in site parameters"
QUIT
+18 SET NODE=$GET(^WV(790.02,DIV,0))
+19 IF WHO["C"
Begin DoDot:2
+20 IF $PIECE(NODE,U,2)>0
SET RESULTS($PIECE(NODE,U,2))=$SELECT(IDEN:$$NAME^XUAF4(DIV)_" DEFAULT CASE MANAGER",1:"")
+21 IF +$PIECE(NODE,U,2)=0
SET RESULTS(0)="-1^Patient record not found and default case manager not set"
End DoDot:2
End DoDot:1
QUIT
+22 SET NODE=$GET(^WV(790,IEN,0))
+23 IF WHO["C"
IF $PIECE(NODE,U,10)>0
SET RESULTS(+$PIECE(NODE,U,10))=$SELECT(IDEN:"ASSIGNED CASE MANAGER",1:"")
+24 IF WHO["M"
IF $PIECE(NODE,U,29)>0
SET RESULTS(+$PIECE(NODE,U,29))=$SELECT(IDEN:"MATERNITY CARE COORDINATOR",1:"")
+25 QUIT
GETRECIPS(RESULTS,PAT,SOURCE,TYPE,IDEN,DIV) ;RETURN STATUS CONFLICT NOTIFICATION RECIPIENTS
+1 ; INPUT: RESULTS - REFERENCE TO ARRAY IN WHICH TO RETURN RECIPIENT LIST
+2 ; [REQUIRED]
+3 ; PAT - IEN OF PATIENT IN WV PATIENT FILE [REQUIRED]
+4 ; SOURCE - TYPE OF CONFLICT SOURCE [REQUIRED]; VALUES INCLUDE:
+5 ; "CODE" FOR ICD AND SNOMED CODES
+6 ; "LAB" FOR LABORATORY TEST
+7 ; TYPE - TYPE OF STATUS CONFLICT [REQUIRED]; VALUES INCLUDE:
+8 ; "P" FOR PREGNANCY
+9 ; "L" FOR LACTATION
+10 ; IDEN - WHETHER TO IDENTIFY THE PROVIDER'S ROLE IN THE RETURN ARRAY [OPTIONAL]
+11 ; 1 TO RETURN THE ROLE, 0 TO NOT RETURN THE ROLE [DEFAULT]
+12 ; DIV - IEN OF THE INSTITUTION FOR THE PATIENT [REQUIRED]
+13 NEW RECIPS,PCP
+14 SET RECIPS="CM"
SET PCP=0
SET IDEN=+$GET(IDEN)
+15 IF TYPE="P"
IF $$REM^WVUTL11(PAT,"VA-WH MEDICALLY UNABLE TO CONCEIVE")="DUE NOW"
Begin DoDot:1
+16 IF SOURCE="CODE"
SET RECIPS="M"
+17 IF '$TEST
SET RECIPS=""
+18 SET PCP=+$PIECE($$OUTPTPR^SDUTL3(PAT,$$DT^XLFDT),U)
End DoDot:1
+19 IF RECIPS'=""
DO PATMGR(.RESULTS,PAT,RECIPS,IDEN,DIV)
+20 IF ('IDEN)
IF ($PIECE($GET(RESULTS(0)),U,2)["Patient record not found")
KILL RESULTS
+21 IF PCP>0
SET RESULTS(PCP)=$SELECT(IDEN:"PRIMARY CARE PROVIDER",1:"")
+22 QUIT
