WVTIU ;ISP/RFR - TIU DOCUMENT ACTION PROCESSOR ;Jul 29, 2020@14:38
;;1.0;WOMEN'S HEALTH;**24,26**;Sep 30, 1998;Build 624
Q
DOCACT ;PROCESSOR FOR TIU DOCUMENT ACTION
Q:'$D(^TMP("TIUDOCACT",$J))
N $ETRAP,$ESTACK
S $ETRAP="G UNEXPERR^WVTIU"
N WVODFN,WVNDFN,WVVISIT,WVNVISIT,WVALERT,WVOPDAT,WVNPDAT,WVERROR,WVACT,WVLINE,WVSRC,WVACTIEN,WVNODE
N WVTIU,WVNTIU,WVIEN,WVSIEN,WVREASON,WVSNODE,WVPNUM,WVDAT,WVFILE,WVFIELD,WVFDA,WVNIEN,WVDA,WVCNT
N WVNCON,WVVDFN,WVVALUE,XQA,XQAID,XQAMSG,XQAROU,WVSTATUS,WVDATA,WVINDEX,WVMTCH,WVPIEN,WVRETURN
N WVPVISIT,WVPROCS,WVSCNT,WVSTMP,WVOVRIDE,WVCM,WVDUZ,WVADT,WVDUP,WVSUB
S WVADT=$$NOW^XLFDT,WVSUB="TIUDOCACT"
I $G(^TMP(WVSUB,$J,"PATIENT"))'="" S WVODFN=+^("PATIENT")
E S WVODFN=+$G(^TMP(WVSUB,$J,"PATIENT","OLD")),WVNDFN=+$G(^("NEW"))
I 'WVODFN G DOCACTX
S WVACT=$G(^TMP(WVSUB,$J,"ACTION")) I WVACT="" G DOCACTX
S WVACT("INTERNAL")=$S(WVACT="REASSIGN":"R",WVACT="RETRACT"!(WVACT="DELETE"):"D",1:"")
;FIND STATUS DATA
;WVDATA(STATUS_GLOBAL_NODE_#,STATUS_IEN)=MATCH_TYPE^ACTIVITY_IEN
I $G(^TMP(WVSUB,$J,"DOCUMENT"))'="" S WVTIU=+^("DOCUMENT"),WVSRC=$P(^("DOCUMENT"),U,2)_" ("_WVTIU_")"
E S WVTIU=+$G(^TMP(WVSUB,$J,"DOCUMENT","OLD")),WVSRC=$P(^("OLD"),U,2)_" ("_WVTIU_")",WVNTIU=+$G(^("NEW"))
;FIRST BY DOCUMENT
F WVNODE=4,5 S WVIEN=0 F S WVIEN=$O(^WV(790,WVODFN,WVNODE,"D",WVTIU,WVIEN)) Q:'+WVIEN D
.I $D(^WV(790,WVODFN,WVNODE,WVIEN,0)) S WVDATA(WVNODE,WVIEN)="DOCUMENT"_U
I $G(^TMP(WVSUB,$J,"VISIT"))'="" S WVVISIT=+^("VISIT")
E S WVVISIT=+$G(^TMP(WVSUB,$J,"VISIT","OLD")),WVNVISIT=+$G(^("NEW"))
;SMART section
S WVSCNT=0 D FINDPROC^WVRPCPT2(.WVSTMP,.WVSCNT,WVODFN,WVVISIT,WVTIU,+$G(WVNDFN),1,1)
I $D(WVSTMP) D SMAIL(.WVSTMP)
;NOTHING FOUND, THEN FIND STATUS DATA BY VISIT
I '$D(WVDATA) D
.F WVNODE=4,5 S WVIEN=0 F S WVIEN=$O(^WV(790,WVODFN,WVNODE,"C",WVVISIT,WVIEN)) Q:'+WVIEN D
..I $D(^WV(790,WVODFN,WVNODE,WVIEN,0)) S WVDATA(WVNODE,WVIEN)="VISIT"_U
.I $D(WVDATA) Q
.S WVACTIEN=0 F S WVACTIEN=$O(^WV(790.8,"C",WVVISIT,WVACTIEN)) Q:'+WVACTIEN D
..I '$D(^WV(790.8,WVACTIEN,0)) Q
..S WVVDFN=$P($G(^WV(790.8,WVACTIEN,0)),U),WVNODE=$P($G(^WV(790.8,WVACTIEN,0)),U,4)
..S WVPVISIT=$P($G(^WV(790.8,WVACTIEN,0)),U,2)
..S WVIEN=0 F S WVIEN=$O(^WV(790,WVVDFN,WVNODE,"C",WVPVISIT,WVIEN)) Q:'+WVIEN D
...I $D(^WV(790,WVVDFN,WVNODE,WVIEN,0)) S WVDATA(WVNODE,WVIEN)="VISIT"_U_WVACTIEN
S WVALERT=0,WVOVRIDE=1
;DELETE AND REASSIGN ACTIONS ON DOCUMENT MATCHES MARK STATUS DATA AS ENTERED IN ERROR
;ALL OTHER ACTIONS AND ALL VISIT MATCHES ARE SAVED FOR LATER REVIEW
F WVNODE=4,5 S WVIEN=0 F S WVIEN=$O(WVDATA(WVNODE,WVIEN)) Q:'+WVIEN!($D(WVERROR)) D
.S WVMTCH=$P(WVDATA(WVNODE,WVIEN),U)
.I "^DELETE^REASSIGN^"[(U_WVACT_U),WVMTCH="DOCUMENT" D Q
..I WVACT="REASSIGN" D Q:$D(WVERROR)
...S WVERROR=$$ISREG^WVUTL11(WVNDFN) Q:'+WVERROR
...K WVERROR
...F WVSNODE=0,2,4 D
....S WVDAT=$G(^WV(790,WVODFN,WVNODE,WVIEN,WVSNODE)) Q:WVDAT=""
....I WVSNODE=0 S $P(WVDAT,U)=$$NOW^XLFDT,$P(WVDAT,U,4,5)=WVNVISIT_U_WVNTIU
....F WVPNUM=1:1:$L(WVDAT,U) D
.....S WVFILE=$S(WVNODE=4:790.05,WVNODE=5:790.16,1:0) Q:'WVFILE
.....S WVFIELD=$S(('WVSNODE)&(WVPNUM=1):.01,('WVSNODE):WVPNUM,1:WVSNODE_WVPNUM)
.....S WVFDA(WVFILE,"+1,"_WVNDFN_",",WVFIELD)=$P(WVDAT,U,WVPNUM)
...K WVNIEN
...D UPDATE^DIE("","WVFDA","WVNIEN","WVERROR")
...I (WVNODE'=4)!($D(WVERROR)) Q
...S WVDA=WVNIEN(1),WVDA(1)=WVNDFN
...S WVSIEN=0,WVCNT=1 F S WVSIEN=$O(^WV(790,WVODFN,WVNODE,WVIEN,3,WVSIEN)) Q:'+WVSIEN D
....S WVNCON(790.17,"+"_WVCNT_","_WVDA_","_WVNDFN_",",.01)="`"_$P($G(^WV(790,WVODFN,WVNODE,WVIEN,3,WVSIEN,0)),U),WVCNT=WVCNT+1
...I $D(WVNCON) D METHOD^WVTDALRT(WVNDFN,.WVDA,1,.WVNCON)
..S WVREASON(1)="Document "_WVSRC_" was "_$S(WVACT="DELETE":"deleted",1:"reassigned to patient "_$$GET1^DIQ(2,WVNDFN,.01))_"."
..D EIE^WVRPCOR1(.WVRETURN,WVNODE_";"_WVIEN_","_WVODFN_",",.WVREASON)
..I +WVRETURN<1 S WVERROR=WVRETURN
.;FIND PARENT RECORD - FOR VISIT MATCHES: ^WV(790.8,"D",PATIENT,VISIT,LOCATION OF DATA,DA)="" OR ^WV(790.8,"C",NEW VISIT,790.8 IEN,ACTIVITIES IEN)="" WHERE DA(1)=790.8 IEN
.; FOR DOC MATCHES: ^WV(790.8,"E",PATIENT,DOCUMENT,LOCATION OF DATA,DA)=""
.I WVMTCH="VISIT" S WVVALUE=WVVISIT,WVINDEX="D",WVFIELD=2
.E S WVVALUE=WVTIU,WVINDEX="E",WVFIELD=3
.S WVPIEN=+$O(^WV(790.8,WVINDEX,WVODFN,WVVALUE,WVNODE,0))
.I WVPIEN>0 S WVPIEN("ROOT ACTIVITY")=1
.I 'WVPIEN,WVMTCH="VISIT" S WVPIEN=+$O(^WV(790.8,"C",WVVALUE,0)) I WVPIEN>0 S WVPIEN("ACTIVITY")=+$O(^WV(790.8,"C",WVVALUE,WVPIEN,"?"),-1)
.;OR CREATE PARENT RECORD
.I 'WVPIEN D Q:$D(WVERROR)
..S WVFDA(790.8,"+1,",.01)=WVODFN,WVFDA(790.8,"+1,",WVFIELD)=WVVALUE
..S WVFDA(790.8,"+1,",4)=WVNODE
..K WVNIEN
..D UPDATE^DIE(,"WVFDA","WVNIEN","WVERROR")
..I $D(WVERROR) Q
..S WVPIEN=WVNIEN(1),WVPIEN("ROOT ACTIVITY")=1
.I 'WVPIEN Q
.K WVNIEN
.I WVALERT<WVNODE S WVALERT=WVNODE+WVALERT
.;SEARCH FOR DUPLICATE ACTIVITY
.S (WVNIEN,WVDUP)=0 F S WVNIEN=$O(^WV(790.8,WVPIEN,1,WVNIEN)) Q:'+WVNIEN!(WVDUP) D
..S WVNODE=$G(^WV(790.8,WVPIEN,1,WVNIEN,0))
..I +$P(WVNODE,U)=WVADT,$P(WVNODE,U,2)=WVSRC,$P(WVNODE,U,3)=WVACT("INTERNAL"),+$P(WVNODE,U,4)=+WVPIEN("ROOT ACTIVITY") S WVDUP=0.5
..I WVACT="REASSIGN",WVDUP=0.5 D
...S WVNODE=$G(^WV(790.8,WVPIEN,1,WVNIEN,1))
...I $P(WVNODE,U)=WVNDFN,$P(WVNODE,U,2)=WVNVISIT S WVDUP=1
...E S WVDUP=0
..I WVACT'="REASSIGN",WVDUP=0.5 S WVDUP=1
.I WVDUP Q
.;NO DUPLICATE, CREATE ACTIVITY
.S WVNIEN="+1,"_WVPIEN_","
.S WVFDA(790.801,WVNIEN,.01)=WVADT,WVFDA(790.801,WVNIEN,2)=WVSRC
.S WVFDA(790.801,WVNIEN,3)=WVACT("INTERNAL")
.I $G(WVPIEN("ROOT ACTIVITY")) S WVFDA(790.801,WVNIEN,4)=1
.I WVACT="REASSIGN" S WVFDA(790.801,WVNIEN,11)=WVNDFN,WVFDA(790.801,WVNIEN,12)=WVNVISIT
.K WVNIEN
.D UPDATE^DIE(,"WVFDA","WVNIEN","WVERROR")
.I $D(WVERROR) Q
.;IF PARENT FOUND ON "C" CROSS-REF, POPULATE NEXT ACTIVITY FIELD
.I '+$G(WVPIEN("ROOT ACTIVITY")),+$G(WVPIEN("ACTIVITY"))>0 D Q:$D(WVERROR)
..S WVFDA(790.802,"+1,"_WVPIEN("ACTIVITY")_","_WVPIEN_",",.01)=WVNIEN(1)
..D UPDATE^DIE(,"WVFDA","WVERROR")
I $D(WVERROR) G DOCACTX
I $G(WVALERT)>0 D I $D(WVERROR) G DOCACTX
.D PATMGR^WVRPCPT1(.WVCM,WVODFN,"CM",0)
.D GETS^DIQ(2,WVODFN_",",".01;.09",,"WVOPDAT","WVERROR") Q:$D(WVERROR)
.I $D(WVOPDAT) S WVOPDAT(2,WVODFN_",",.0905)=$E($G(WVOPDAT(2,WVODFN_",",.01)),1)_$E($G(WVOPDAT(2,WVODFN_",",.09)),6,9)
.D COMDUPS(.WVCM,"WV,"_WVODFN_",1",WVALERT,$G(WVOPDAT(2,WVODFN_",",.01))_" ("_$G(WVOPDAT(2,WVODFN_",",.0905))_")")
.S WVDUZ=0 F S WVDUZ=$O(WVCM(WVDUZ)) Q:'+WVDUZ D
..S XQA(WVDUZ)="",XQAMSG=WVCM(WVDUZ),XQAID="WV,"_WVODFN_",1",XQAROU="PLSDATA^WVMGRP"
..S WVSTATUS=$$SETUP1^XQALERT
..K XQA
DOCACTX ;CLEAN-UP FOR DOCACTQ LINE TAG
I $D(WVERROR) D
.N %ZT
.S %ZT($NA(^TMP(WVSUB,$J)))=""
.D APPERROR^%ZTER("DOCACT-WVTIU ERROR")
Q
;
COMDUPS(WVRECIPS,WVID,WVNALERT,WVPAT) ;COMBINE DUPLICATE ALERTS
N WVDUZ,WVALERTS,WVALERT,WVEALERT,WVFALERT,WVMSG,XQAID,XQAKILL
S WVDUZ=0 F S WVDUZ=$O(WVRECIPS(WVDUZ)) Q:'+WVDUZ D
.D USER^XQALERT("WVALERTS",WVDUZ)
.S WVEALERT=0,WVFALERT=WVNALERT
.F WVALERT=1:1:WVALERTS I $P($P($G(WVALERTS(WVALERT)),U,2),";")=WVID D
..I WVALERTS(WVALERT)["pregnancy",WVEALERT'=4,WVEALERT<9 S WVEALERT=4+WVEALERT
..I WVALERTS(WVALERT)["lactation",WVEALERT'=5,WVEALERT<9 S WVEALERT=5+WVEALERT
..I WVEALERT=0 Q
..I WVEALERT=WVNALERT K WVRECIPS(WVDUZ) S WVALERT=WVALERTS Q
..S XQAID=$P(WVALERTS(WVALERT),U,2)
..D DELETE^XQALERT
.I '$D(WVRECIPS(WVDUZ)) Q
.I WVFALERT<9 S WVFALERT=$S(WVEALERT<9:WVEALERT+WVFALERT,1:9)
.S WVMSG="Review "_$S(WVFALERT=4:"pregnancy",WVFALERT=5:"lactation",WVFALERT=9:"pregnancy and lactation",1:"pregnancy and/or lactation")
.S WVRECIPS(WVDUZ)=WVMSG_" status for "_WVPAT_"."
Q
SMAIL(WVSTMP) ;
K ^TMP("WV MSG",$J),XMY
N CNT,XMDUZ,XMSUB,XMTEXT,Y
S CNT=0,XMDUZ="WV NOTE MANAGER",XMSUB="Women's Health SMART Note Deletion Message",XMTEXT="^TMP(""WV MSG"",$J,",XMY(DUZ)="",XMY("G.OR CACS")=""
F S CNT=$O(WVSTMP(CNT)) Q:CNT'>0 S ^TMP("WV MSG",$J,CNT,0)=WVSTMP(CNT)
D ^XMD
Q
UNEXPERR ;unexpected error handler
N %ZT,%ZTERROR
S %ZT($NA(^TMP(WVSUB,$J)))=""
D ^%ZTER ;file error
S $ECODE=""
Q ""
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HWVTIU 8211 printed Apr 09, 2024@21:49:15 Page 2
WVTIU ;ISP/RFR - TIU DOCUMENT ACTION PROCESSOR ;Jul 29, 2020@14:38
+1 ;;1.0;WOMEN'S HEALTH;**24,26**;Sep 30, 1998;Build 624
+2 QUIT
DOCACT ;PROCESSOR FOR TIU DOCUMENT ACTION
+1 if '$DATA(^TMP("TIUDOCACT",$JOB))
QUIT
+2 NEW $ETRAP,$ESTACK
+3 SET $ETRAP="G UNEXPERR^WVTIU"
+4 NEW WVODFN,WVNDFN,WVVISIT,WVNVISIT,WVALERT,WVOPDAT,WVNPDAT,WVERROR,WVACT,WVLINE,WVSRC,WVACTIEN,WVNODE
+5 NEW WVTIU,WVNTIU,WVIEN,WVSIEN,WVREASON,WVSNODE,WVPNUM,WVDAT,WVFILE,WVFIELD,WVFDA,WVNIEN,WVDA,WVCNT
+6 NEW WVNCON,WVVDFN,WVVALUE,XQA,XQAID,XQAMSG,XQAROU,WVSTATUS,WVDATA,WVINDEX,WVMTCH,WVPIEN,WVRETURN
+7 NEW WVPVISIT,WVPROCS,WVSCNT,WVSTMP,WVOVRIDE,WVCM,WVDUZ,WVADT,WVDUP,WVSUB
+8 SET WVADT=$$NOW^XLFDT
SET WVSUB="TIUDOCACT"
+9 IF $GET(^TMP(WVSUB,$JOB,"PATIENT"))'=""
SET WVODFN=+^("PATIENT")
+10 IF '$TEST
SET WVODFN=+$GET(^TMP(WVSUB,$JOB,"PATIENT","OLD"))
SET WVNDFN=+$GET(^("NEW"))
+11 IF 'WVODFN
GOTO DOCACTX
+12 SET WVACT=$GET(^TMP(WVSUB,$JOB,"ACTION"))
IF WVACT=""
GOTO DOCACTX
+13 SET WVACT("INTERNAL")=$SELECT(WVACT="REASSIGN":"R",WVACT="RETRACT"!(WVACT="DELETE"):"D",1:"")
+14 ;FIND STATUS DATA
+15 ;WVDATA(STATUS_GLOBAL_NODE_#,STATUS_IEN)=MATCH_TYPE^ACTIVITY_IEN
+16 IF $GET(^TMP(WVSUB,$JOB,"DOCUMENT"))'=""
SET WVTIU=+^("DOCUMENT")
SET WVSRC=$PIECE(^("DOCUMENT"),U,2)_" ("_WVTIU_")"
+17 IF '$TEST
SET WVTIU=+$GET(^TMP(WVSUB,$JOB,"DOCUMENT","OLD"))
SET WVSRC=$PIECE(^("OLD"),U,2)_" ("_WVTIU_")"
SET WVNTIU=+$GET(^("NEW"))
+18 ;FIRST BY DOCUMENT
+19 FOR WVNODE=4,5
SET WVIEN=0
FOR
SET WVIEN=$ORDER(^WV(790,WVODFN,WVNODE,"D",WVTIU,WVIEN))
if '+WVIEN
QUIT
Begin DoDot:1
+20 IF $DATA(^WV(790,WVODFN,WVNODE,WVIEN,0))
SET WVDATA(WVNODE,WVIEN)="DOCUMENT"_U
End DoDot:1
+21 IF $GET(^TMP(WVSUB,$JOB,"VISIT"))'=""
SET WVVISIT=+^("VISIT")
+22 IF '$TEST
SET WVVISIT=+$GET(^TMP(WVSUB,$JOB,"VISIT","OLD"))
SET WVNVISIT=+$GET(^("NEW"))
+23 ;SMART section
+24 SET WVSCNT=0
DO FINDPROC^WVRPCPT2(.WVSTMP,.WVSCNT,WVODFN,WVVISIT,WVTIU,+$GET(WVNDFN),1,1)
+25 IF $DATA(WVSTMP)
DO SMAIL(.WVSTMP)
+26 ;NOTHING FOUND, THEN FIND STATUS DATA BY VISIT
+27 IF '$DATA(WVDATA)
Begin DoDot:1
+28 FOR WVNODE=4,5
SET WVIEN=0
FOR
SET WVIEN=$ORDER(^WV(790,WVODFN,WVNODE,"C",WVVISIT,WVIEN))
if '+WVIEN
QUIT
Begin DoDot:2
+29 IF $DATA(^WV(790,WVODFN,WVNODE,WVIEN,0))
SET WVDATA(WVNODE,WVIEN)="VISIT"_U
End DoDot:2
+30 IF $DATA(WVDATA)
QUIT
+31 SET WVACTIEN=0
FOR
SET WVACTIEN=$ORDER(^WV(790.8,"C",WVVISIT,WVACTIEN))
if '+WVACTIEN
QUIT
Begin DoDot:2
+32 IF '$DATA(^WV(790.8,WVACTIEN,0))
QUIT
+33 SET WVVDFN=$PIECE($GET(^WV(790.8,WVACTIEN,0)),U)
SET WVNODE=$PIECE($GET(^WV(790.8,WVACTIEN,0)),U,4)
+34 SET WVPVISIT=$PIECE($GET(^WV(790.8,WVACTIEN,0)),U,2)
+35 SET WVIEN=0
FOR
SET WVIEN=$ORDER(^WV(790,WVVDFN,WVNODE,"C",WVPVISIT,WVIEN))
if '+WVIEN
QUIT
Begin DoDot:3
+36 IF $DATA(^WV(790,WVVDFN,WVNODE,WVIEN,0))
SET WVDATA(WVNODE,WVIEN)="VISIT"_U_WVACTIEN
End DoDot:3
End DoDot:2
End DoDot:1
+37 SET WVALERT=0
SET WVOVRIDE=1
+38 ;DELETE AND REASSIGN ACTIONS ON DOCUMENT MATCHES MARK STATUS DATA AS ENTERED IN ERROR
+39 ;ALL OTHER ACTIONS AND ALL VISIT MATCHES ARE SAVED FOR LATER REVIEW
+40 FOR WVNODE=4,5
SET WVIEN=0
FOR
SET WVIEN=$ORDER(WVDATA(WVNODE,WVIEN))
if '+WVIEN!($DATA(WVERROR))
QUIT
Begin DoDot:1
+41 SET WVMTCH=$PIECE(WVDATA(WVNODE,WVIEN),U)
+42 IF "^DELETE^REASSIGN^"[(U_WVACT_U)
IF WVMTCH="DOCUMENT"
Begin DoDot:2
+43 IF WVACT="REASSIGN"
Begin DoDot:3
+44 SET WVERROR=$$ISREG^WVUTL11(WVNDFN)
if '+WVERROR
QUIT
+45 KILL WVERROR
+46 FOR WVSNODE=0,2,4
Begin DoDot:4
+47 SET WVDAT=$GET(^WV(790,WVODFN,WVNODE,WVIEN,WVSNODE))
if WVDAT=""
QUIT
+48 IF WVSNODE=0
SET $PIECE(WVDAT,U)=$$NOW^XLFDT
SET $PIECE(WVDAT,U,4,5)=WVNVISIT_U_WVNTIU
+49 FOR WVPNUM=1:1:$LENGTH(WVDAT,U)
Begin DoDot:5
+50 SET WVFILE=$SELECT(WVNODE=4:790.05,WVNODE=5:790.16,1:0)
if 'WVFILE
QUIT
+51 SET WVFIELD=$SELECT(('WVSNODE)&(WVPNUM=1):.01,('WVSNODE):WVPNUM,1:WVSNODE_WVPNUM)
+52 SET WVFDA(WVFILE,"+1,"_WVNDFN_",",WVFIELD)=$PIECE(WVDAT,U,WVPNUM)
End DoDot:5
End DoDot:4
+53 KILL WVNIEN
+54 DO UPDATE^DIE("","WVFDA","WVNIEN","WVERROR")
+55 IF (WVNODE'=4)!($DATA(WVERROR))
QUIT
+56 SET WVDA=WVNIEN(1)
SET WVDA(1)=WVNDFN
+57 SET WVSIEN=0
SET WVCNT=1
FOR
SET WVSIEN=$ORDER(^WV(790,WVODFN,WVNODE,WVIEN,3,WVSIEN))
if '+WVSIEN
QUIT
Begin DoDot:4
+58 SET WVNCON(790.17,"+"_WVCNT_","_WVDA_","_WVNDFN_",",.01)="`"_$PIECE($GET(^WV(790,WVODFN,WVNODE,WVIEN,3,WVSIEN,0)),U)
SET WVCNT=WVCNT+1
End DoDot:4
+59 IF $DATA(WVNCON)
DO METHOD^WVTDALRT(WVNDFN,.WVDA,1,.WVNCON)
End DoDot:3
if $DATA(WVERROR)
QUIT
+60 SET WVREASON(1)="Document "_WVSRC_" was "_$SELECT(WVACT="DELETE":"deleted",1:"reassigned to patient "_$$GET1^DIQ(2,WVNDFN,.01))_"."
+61 DO EIE^WVRPCOR1(.WVRETURN,WVNODE_";"_WVIEN_","_WVODFN_",",.WVREASON)
+62 IF +WVRETURN<1
SET WVERROR=WVRETURN
End DoDot:2
QUIT
+63 ;FIND PARENT RECORD - FOR VISIT MATCHES: ^WV(790.8,"D",PATIENT,VISIT,LOCATION OF DATA,DA)="" OR ^WV(790.8,"C",NEW VISIT,790.8 IEN,ACTIVITIES IEN)="" WHERE DA(1)=790.8 IEN
+64 ; FOR DOC MATCHES: ^WV(790.8,"E",PATIENT,DOCUMENT,LOCATION OF DATA,DA)=""
+65 IF WVMTCH="VISIT"
SET WVVALUE=WVVISIT
SET WVINDEX="D"
SET WVFIELD=2
+66 IF '$TEST
SET WVVALUE=WVTIU
SET WVINDEX="E"
SET WVFIELD=3
+67 SET WVPIEN=+$ORDER(^WV(790.8,WVINDEX,WVODFN,WVVALUE,WVNODE,0))
+68 IF WVPIEN>0
SET WVPIEN("ROOT ACTIVITY")=1
+69 IF 'WVPIEN
IF WVMTCH="VISIT"
SET WVPIEN=+$ORDER(^WV(790.8,"C",WVVALUE,0))
IF WVPIEN>0
SET WVPIEN("ACTIVITY")=+$ORDER(^WV(790.8,"C",WVVALUE,WVPIEN,"?"),-1)
+70 ;OR CREATE PARENT RECORD
+71 IF 'WVPIEN
Begin DoDot:2
+72 SET WVFDA(790.8,"+1,",.01)=WVODFN
SET WVFDA(790.8,"+1,",WVFIELD)=WVVALUE
+73 SET WVFDA(790.8,"+1,",4)=WVNODE
+74 KILL WVNIEN
+75 DO UPDATE^DIE(,"WVFDA","WVNIEN","WVERROR")
+76 IF $DATA(WVERROR)
QUIT
+77 SET WVPIEN=WVNIEN(1)
SET WVPIEN("ROOT ACTIVITY")=1
End DoDot:2
if $DATA(WVERROR)
QUIT
+78 IF 'WVPIEN
QUIT
+79 KILL WVNIEN
+80 IF WVALERT<WVNODE
SET WVALERT=WVNODE+WVALERT
+81 ;SEARCH FOR DUPLICATE ACTIVITY
+82 SET (WVNIEN,WVDUP)=0
FOR
SET WVNIEN=$ORDER(^WV(790.8,WVPIEN,1,WVNIEN))
if '+WVNIEN!(WVDUP)
QUIT
Begin DoDot:2
+83 SET WVNODE=$GET(^WV(790.8,WVPIEN,1,WVNIEN,0))
+84 IF +$PIECE(WVNODE,U)=WVADT
IF $PIECE(WVNODE,U,2)=WVSRC
IF $PIECE(WVNODE,U,3)=WVACT("INTERNAL")
IF +$PIECE(WVNODE,U,4)=+WVPIEN("ROOT ACTIVITY")
SET WVDUP=0.5
+85 IF WVACT="REASSIGN"
IF WVDUP=0.5
Begin DoDot:3
+86 SET WVNODE=$GET(^WV(790.8,WVPIEN,1,WVNIEN,1))
+87 IF $PIECE(WVNODE,U)=WVNDFN
IF $PIECE(WVNODE,U,2)=WVNVISIT
SET WVDUP=1
+88 IF '$TEST
SET WVDUP=0
End DoDot:3
+89 IF WVACT'="REASSIGN"
IF WVDUP=0.5
SET WVDUP=1
End DoDot:2
+90 IF WVDUP
QUIT
+91 ;NO DUPLICATE, CREATE ACTIVITY
+92 SET WVNIEN="+1,"_WVPIEN_","
+93 SET WVFDA(790.801,WVNIEN,.01)=WVADT
SET WVFDA(790.801,WVNIEN,2)=WVSRC
+94 SET WVFDA(790.801,WVNIEN,3)=WVACT("INTERNAL")
+95 IF $GET(WVPIEN("ROOT ACTIVITY"))
SET WVFDA(790.801,WVNIEN,4)=1
+96 IF WVACT="REASSIGN"
SET WVFDA(790.801,WVNIEN,11)=WVNDFN
SET WVFDA(790.801,WVNIEN,12)=WVNVISIT
+97 KILL WVNIEN
+98 DO UPDATE^DIE(,"WVFDA","WVNIEN","WVERROR")
+99 IF $DATA(WVERROR)
QUIT
+100 ;IF PARENT FOUND ON "C" CROSS-REF, POPULATE NEXT ACTIVITY FIELD
+101 IF '+$GET(WVPIEN("ROOT ACTIVITY"))
IF +$GET(WVPIEN("ACTIVITY"))>0
Begin DoDot:2
+102 SET WVFDA(790.802,"+1,"_WVPIEN("ACTIVITY")_","_WVPIEN_",",.01)=WVNIEN(1)
+103 DO UPDATE^DIE(,"WVFDA","WVERROR")
End DoDot:2
if $DATA(WVERROR)
QUIT
End DoDot:1
+104 IF $DATA(WVERROR)
GOTO DOCACTX
+105 IF $GET(WVALERT)>0
Begin DoDot:1
+106 DO PATMGR^WVRPCPT1(.WVCM,WVODFN,"CM",0)
+107 DO GETS^DIQ(2,WVODFN_",",".01;.09",,"WVOPDAT","WVERROR")
if $DATA(WVERROR)
QUIT
+108 IF $DATA(WVOPDAT)
SET WVOPDAT(2,WVODFN_",",.0905)=$EXTRACT($GET(WVOPDAT(2,WVODFN_",",.01)),1)_$EXTRACT($GET(WVOPDAT(2,WVODFN_",",.09)),6,9)
+109 DO COMDUPS(.WVCM,"WV,"_WVODFN_",1",WVALERT,$GET(WVOPDAT(2,WVODFN_",",.01))_" ("_$GET(WVOPDAT(2,WVODFN_",",.0905))_")")
+110 SET WVDUZ=0
FOR
SET WVDUZ=$ORDER(WVCM(WVDUZ))
if '+WVDUZ
QUIT
Begin DoDot:2
+111 SET XQA(WVDUZ)=""
SET XQAMSG=WVCM(WVDUZ)
SET XQAID="WV,"_WVODFN_",1"
SET XQAROU="PLSDATA^WVMGRP"
+112 SET WVSTATUS=$$SETUP1^XQALERT
+113 KILL XQA
End DoDot:2
End DoDot:1
IF $DATA(WVERROR)
GOTO DOCACTX
DOCACTX ;CLEAN-UP FOR DOCACTQ LINE TAG
+1 IF $DATA(WVERROR)
Begin DoDot:1
+2 NEW %ZT
+3 SET %ZT($NAME(^TMP(WVSUB,$JOB)))=""
+4 DO APPERROR^%ZTER("DOCACT-WVTIU ERROR")
End DoDot:1
+5 QUIT
+6 ;
COMDUPS(WVRECIPS,WVID,WVNALERT,WVPAT) ;COMBINE DUPLICATE ALERTS
+1 NEW WVDUZ,WVALERTS,WVALERT,WVEALERT,WVFALERT,WVMSG,XQAID,XQAKILL
+2 SET WVDUZ=0
FOR
SET WVDUZ=$ORDER(WVRECIPS(WVDUZ))
if '+WVDUZ
QUIT
Begin DoDot:1
+3 DO USER^XQALERT("WVALERTS",WVDUZ)
+4 SET WVEALERT=0
SET WVFALERT=WVNALERT
+5 FOR WVALERT=1:1:WVALERTS
IF $PIECE($PIECE($GET(WVALERTS(WVALERT)),U,2),";")=WVID
Begin DoDot:2
+6 IF WVALERTS(WVALERT)["pregnancy"
IF WVEALERT'=4
IF WVEALERT<9
SET WVEALERT=4+WVEALERT
+7 IF WVALERTS(WVALERT)["lactation"
IF WVEALERT'=5
IF WVEALERT<9
SET WVEALERT=5+WVEALERT
+8 IF WVEALERT=0
QUIT
+9 IF WVEALERT=WVNALERT
KILL WVRECIPS(WVDUZ)
SET WVALERT=WVALERTS
QUIT
+10 SET XQAID=$PIECE(WVALERTS(WVALERT),U,2)
+11 DO DELETE^XQALERT
End DoDot:2
+12 IF '$DATA(WVRECIPS(WVDUZ))
QUIT
+13 IF WVFALERT<9
SET WVFALERT=$SELECT(WVEALERT<9:WVEALERT+WVFALERT,1:9)
+14 SET WVMSG="Review "_$SELECT(WVFALERT=4:"pregnancy",WVFALERT=5:"lactation",WVFALERT=9:"pregnancy and lactation",1:"pregnancy and/or lactation")
+15 SET WVRECIPS(WVDUZ)=WVMSG_" status for "_WVPAT_"."
End DoDot:1
+16 QUIT
SMAIL(WVSTMP) ;
+1 KILL ^TMP("WV MSG",$JOB),XMY
+2 NEW CNT,XMDUZ,XMSUB,XMTEXT,Y
+3 SET CNT=0
SET XMDUZ="WV NOTE MANAGER"
SET XMSUB="Women's Health SMART Note Deletion Message"
SET XMTEXT="^TMP(""WV MSG"",$J,"
SET XMY(DUZ)=""
SET XMY("G.OR CACS")=""
+4 FOR
SET CNT=$ORDER(WVSTMP(CNT))
if CNT'>0
QUIT
SET ^TMP("WV MSG",$JOB,CNT,0)=WVSTMP(CNT)
+5 DO ^XMD
+6 QUIT
UNEXPERR ;unexpected error handler
+1 NEW %ZT,%ZTERROR
+2 SET %ZT($NAME(^TMP(WVSUB,$JOB)))=""
+3 ;file error
DO ^%ZTER
+4 SET $ECODE=""
+5 QUIT ""
