Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: WVTIU

WVTIU.m

Go to the documentation of this file.
WVTIU ;ISP/RFR - TIU DOCUMENT ACTION PROCESSOR ;Feb 18, 2020@16:13
 ;;1.0;WOMEN'S HEALTH;**24**;Sep 30, 1998;Build 582
 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^WVRPCPT1(.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 ""