WVMGRP2 ;ISP/RFR - MANAGER'S PATIENT EDITS;06/13/2017 15:49
;;1.0;WOMEN'S HEALTH;**24**;Sep 30, 1998;Build 582
Q
PACT(WVNODE,WVACTION,WVRIENS,WVNPAT,WVNVISIT,WVADESC,WVSRC,WVNPATNM) ;PERFORM AN ACTION ON THE DATA
; INPUT: WVNODE: GLOBAL NODE NUMBER IN ^WV(790,D0, WHERE THE DATA RESIDES [REQUIRED]
; WVACTION: THE ACTION TO TAKE [REQUIRED]
; 1 TO REASSIGN, 2 TO MARK AS ENTERED IN ERROR
; WVRIENS: IENS OF CURRENT ENTRY IN ACTIVITIES MULTIPLE IN WV DATA NEEDING REVIEW FILE [OPTIONAL]
; WVNPAT: IEN IN WV PATIENT FILE OF PATIENT TO REASSIGN DATA TO [OPTIONAL]
; WVNVISIT: IEN IN VISIT FILE TO ASSOCIATE WITH REASSIGNED DATA [OPTIONAL]
; WVADESC: EXTERNAL FORM OF THE ACTION TO TAKE [OPTIONAL]
; WVSRC: THE OBJECT THE ACTION WAS TAKEN ON [OPTIONAL]
; WVNPATNM: THE NEW PATIENT'S NAME [OPTIONAL]
; OUTPUT: $$PACT: WHETHER THE ACTION WAS SUCCESSFULLY TAKEN, -1 FOR AN ERROR
N WVDIENS,WVDATA,WVERROR,WVFDA,WVFILE,WVFIELD,WVIENS,WVRESULT,WVENTRIS,WVIEN
I '$G(WVPROMPT) D Q:$G(WVRESULT)=-1 -1
.S WVIEN=0 F S WVIEN=$O(^WV(790,WVPAT,WVNODE,$P(WVTYPE,U,2),WVITEM,WVIEN)) Q:'+WVIEN S WVENTRIS(WVIEN_","_WVPAT_",")=""
.I $D(WVENTRIS)<10 S WVRESULT=$$ERROR^WVMGRP("determining the data record ID(s)",,"There is a problem with the "_$P(WVTYPE,U,2)_" cross-reference on the^"_$S(WVNODE=4:"PREGNANCY",1:"LACTATION")_" STATUSES multiple in the WV PATIENT file.")
I $G(WVPROMPT) S WVENTRIS(WVPROMPT)=""
S WVFILE=$S(WVNODE=4:790.05,1:790.16)
I WVACTION=1 D Q:$G(WVRESULT)=-1 -1
.D GETS^DIQ(WVFILE,WVDIENS,"**","IN","WVDATA","WVERROR")
.I $D(WVERROR) S WVRESULT=$$ERROR^WVMGRP("retrieving existing data",.WVERROR) Q
.S WVFIELD="" F S WVFIELD=$O(WVDATA(WVFILE,WVDIENS,WVFIELD)) Q:WVFIELD="" S WVFDA(WVFILE,"+1,"_WVNPAT_",",WVFIELD)=WVDATA(WVFILE,WVDIENS,WVFIELD,"I")
.S WVFDA(WVFILE,"+1,"_WVNPAT_",",4)=$G(WVNVISIT),WVFDA(WVFILE,"+1,"_WVNPAT_",",.01)=$$NOW^XLFDT
.D UPDATE^DIE("","WVFDA","WVIEN","WVERROR")
.I $D(WVERROR) S WVRESULT=$$ERROR^WVMGRP("copying existing data",.WVERROR) Q
.I WVNODE=4 D Q:$G(WVRESULT)=-1
..N WVCNT
..S WVIENS="" F S WVIENS=$O(WVDATA(790.17,WVIENS)) Q:WVIENS="" S WVFIELD="" F S WVFIELD=$O(WVDATA(790.17,WVIENS,WVFIELD)) Q:WVFIELD="" D
...S WVCNT=1+$G(WVCNT),WVFDA(790.17,"+"_WVCNT_","_WVIEN(1)_","_WVNPAT_",",WVFIELD)="`"_WVDATA(790.17,WVIENS,WVFIELD,"I")
..Q:'$D(WVFDA)
..S WVRESULT=$$METHOD^WVTDALRT(WVNPAT,,.WVFDA)
..I $P(WVRESULT,U)=-1 S WVRESULT=$$ERROR^WVMGRP("copying existing contraceptive methods",,$P(WVRESULT,U,2))
.K WVDATA
S WVDIENS=0 F S WVDIENS=$O(WVENTRIS(WVDIENS)) Q:WVDIENS=""!($G(WVRESULT)=-1) D
.S WVFILE=$S(WVNODE=4:790.05,1:790.16)
.S WVFDA(WVFILE,WVDIENS,6)=1
.D FILE^DIE("K","WVFDA","WVERROR")
.I $D(WVERROR) S WVRESULT=$$ERROR^WVMGRP("marking the "_$S(WVACTION=1:"incorrect ",1:"")_"entry as entered in error",.WVERROR) Q
.S WVFILE=$S(WVNODE=4:790.15,1:790.18)
.I '$G(WVPROMPT) D Q:$G(WVRESULT)=-1
..I +WVRIENS>0 D Q:$G(WVRESULT)=-1
...D GETS^DIQ(790.801,WVRIENS,"2;3;11","","WVDATA","WVERROR")
...I $D(WVERROR) S WVRESULT=$$ERROR^WVMGRP("retrieving WV DATA NEEDING REVIEW data",.WVERROR) Q
...S WVADESC=WVDATA(790.801,WVRIENS,3),WVSRC=WVDATA(790.801,WVRIENS,2),WVNPATNM=WVDATA(790.801,WVRIENS,11)
..I +WVRIENS=0 S WVSRC=$P(WVSRC," (")
..S WVFDA(WVFILE,"+1,"_WVDIENS,.01)="A "_WVADESC_" action taken on the "_WVSRC_" document prompted a chart review."
.I $G(WVPROMPT) D Q:$G(WVRESULT)=-1
..K DIR,DIRUT,DIROUT,Y
..S DIR(0)=WVFILE_",.01"
..D ^DIR
..I $D(DIRUT)!($D(DIROUT)) S WVRESULT=-1 Q
..S WVFDA(WVFILE,"+1,"_WVDIENS,.01)=$P($G(Y),U)
.I WVACTION=1 S WVFDA(WVFILE,"+1,"_WVDIENS,.01)=WVFDA(WVFILE,"+1,"_WVDIENS,.01)_" The data was moved to "_WVNPATNM_"'s chart."
.D UPDATE^DIE("","WVFDA",,"WVERROR")
.I $D(WVERROR) S WVRESULT=$$ERROR^WVMGRP("storing the reason why the "_$S(WVACTION=1:"incorrect",1:"")_" entry was marked as entered in error",.WVERROR)
I $G(WVRESULT)=-1 Q -1
W !!,"ACTION TAKEN.",!
H 4
I $G(WVRIENS)'="" D Q:$G(WVRESULT)=-1 -1
.S WVRIENS=$P(WVRIENS,",",2)_","
.I +WVRIENS=0 S WVRESULT=$$ERROR^WVMGRP("deleting the review record",,"Unable to determine the proper IENS value.") Q
.S WVFDA(790.8,WVRIENS,.01)="@"
.D FILE^DIE(,"WVFDA","WVERROR")
.I $D(WVERROR) S WVRESULT=$$ERROR^WVMGRP("deleting the review record",.WVERROR) Q
.K WVRTACTS
Q 1
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HWVMGRP2 4412 printed Oct 16, 2024@18:47:44 Page 2
WVMGRP2 ;ISP/RFR - MANAGER'S PATIENT EDITS;06/13/2017 15:49
+1 ;;1.0;WOMEN'S HEALTH;**24**;Sep 30, 1998;Build 582
+2 QUIT
PACT(WVNODE,WVACTION,WVRIENS,WVNPAT,WVNVISIT,WVADESC,WVSRC,WVNPATNM) ;PERFORM AN ACTION ON THE DATA
+1 ; INPUT: WVNODE: GLOBAL NODE NUMBER IN ^WV(790,D0, WHERE THE DATA RESIDES [REQUIRED]
+2 ; WVACTION: THE ACTION TO TAKE [REQUIRED]
+3 ; 1 TO REASSIGN, 2 TO MARK AS ENTERED IN ERROR
+4 ; WVRIENS: IENS OF CURRENT ENTRY IN ACTIVITIES MULTIPLE IN WV DATA NEEDING REVIEW FILE [OPTIONAL]
+5 ; WVNPAT: IEN IN WV PATIENT FILE OF PATIENT TO REASSIGN DATA TO [OPTIONAL]
+6 ; WVNVISIT: IEN IN VISIT FILE TO ASSOCIATE WITH REASSIGNED DATA [OPTIONAL]
+7 ; WVADESC: EXTERNAL FORM OF THE ACTION TO TAKE [OPTIONAL]
+8 ; WVSRC: THE OBJECT THE ACTION WAS TAKEN ON [OPTIONAL]
+9 ; WVNPATNM: THE NEW PATIENT'S NAME [OPTIONAL]
+10 ; OUTPUT: $$PACT: WHETHER THE ACTION WAS SUCCESSFULLY TAKEN, -1 FOR AN ERROR
+11 NEW WVDIENS,WVDATA,WVERROR,WVFDA,WVFILE,WVFIELD,WVIENS,WVRESULT,WVENTRIS,WVIEN
+12 IF '$GET(WVPROMPT)
Begin DoDot:1
+13 SET WVIEN=0
FOR
SET WVIEN=$ORDER(^WV(790,WVPAT,WVNODE,$PIECE(WVTYPE,U,2),WVITEM,WVIEN))
if '+WVIEN
QUIT
SET WVENTRIS(WVIEN_","_WVPAT_",")=""
+14 IF $DATA(WVENTRIS)<10
SET WVRESULT=$$ERROR^WVMGRP("determining the data record ID(s)",,"There is a problem with the "_$PIECE(WVTYPE,U,2)_" cross-reference on the^"_$SELECT(WVNODE=4:"PREGNANCY",1:"LACTATION")_" STATUSES multiple in the WV PATIENT file.")
End DoDot:1
if $GET(WVRESULT)=-1
QUIT -1
+15 IF $GET(WVPROMPT)
SET WVENTRIS(WVPROMPT)=""
+16 SET WVFILE=$SELECT(WVNODE=4:790.05,1:790.16)
+17 IF WVACTION=1
Begin DoDot:1
+18 DO GETS^DIQ(WVFILE,WVDIENS,"**","IN","WVDATA","WVERROR")
+19 IF $DATA(WVERROR)
SET WVRESULT=$$ERROR^WVMGRP("retrieving existing data",.WVERROR)
QUIT
+20 SET WVFIELD=""
FOR
SET WVFIELD=$ORDER(WVDATA(WVFILE,WVDIENS,WVFIELD))
if WVFIELD=""
QUIT
SET WVFDA(WVFILE,"+1,"_WVNPAT_",",WVFIELD)=WVDATA(WVFILE,WVDIENS,WVFIELD,"I")
+21 SET WVFDA(WVFILE,"+1,"_WVNPAT_",",4)=$GET(WVNVISIT)
SET WVFDA(WVFILE,"+1,"_WVNPAT_",",.01)=$$NOW^XLFDT
+22 DO UPDATE^DIE("","WVFDA","WVIEN","WVERROR")
+23 IF $DATA(WVERROR)
SET WVRESULT=$$ERROR^WVMGRP("copying existing data",.WVERROR)
QUIT
+24 IF WVNODE=4
Begin DoDot:2
+25 NEW WVCNT
+26 SET WVIENS=""
FOR
SET WVIENS=$ORDER(WVDATA(790.17,WVIENS))
if WVIENS=""
QUIT
SET WVFIELD=""
FOR
SET WVFIELD=$ORDER(WVDATA(790.17,WVIENS,WVFIELD))
if WVFIELD=""
QUIT
Begin DoDot:3
+27 SET WVCNT=1+$GET(WVCNT)
SET WVFDA(790.17,"+"_WVCNT_","_WVIEN(1)_","_WVNPAT_",",WVFIELD)="`"_WVDATA(790.17,WVIENS,WVFIELD,"I")
End DoDot:3
+28 if '$DATA(WVFDA)
QUIT
+29 SET WVRESULT=$$METHOD^WVTDALRT(WVNPAT,,.WVFDA)
+30 IF $PIECE(WVRESULT,U)=-1
SET WVRESULT=$$ERROR^WVMGRP("copying existing contraceptive methods",,$PIECE(WVRESULT,U,2))
End DoDot:2
if $GET(WVRESULT)=-1
QUIT
+31 KILL WVDATA
End DoDot:1
if $GET(WVRESULT)=-1
QUIT -1
+32 SET WVDIENS=0
FOR
SET WVDIENS=$ORDER(WVENTRIS(WVDIENS))
if WVDIENS=""!($GET(WVRESULT)=-1)
QUIT
Begin DoDot:1
+33 SET WVFILE=$SELECT(WVNODE=4:790.05,1:790.16)
+34 SET WVFDA(WVFILE,WVDIENS,6)=1
+35 DO FILE^DIE("K","WVFDA","WVERROR")
+36 IF $DATA(WVERROR)
SET WVRESULT=$$ERROR^WVMGRP("marking the "_$SELECT(WVACTION=1:"incorrect ",1:"")_"entry as entered in error",.WVERROR)
QUIT
+37 SET WVFILE=$SELECT(WVNODE=4:790.15,1:790.18)
+38 IF '$GET(WVPROMPT)
Begin DoDot:2
+39 IF +WVRIENS>0
Begin DoDot:3
+40 DO GETS^DIQ(790.801,WVRIENS,"2;3;11","","WVDATA","WVERROR")
+41 IF $DATA(WVERROR)
SET WVRESULT=$$ERROR^WVMGRP("retrieving WV DATA NEEDING REVIEW data",.WVERROR)
QUIT
+42 SET WVADESC=WVDATA(790.801,WVRIENS,3)
SET WVSRC=WVDATA(790.801,WVRIENS,2)
SET WVNPATNM=WVDATA(790.801,WVRIENS,11)
End DoDot:3
if $GET(WVRESULT)=-1
QUIT
+43 IF +WVRIENS=0
SET WVSRC=$PIECE(WVSRC," (")
+44 SET WVFDA(WVFILE,"+1,"_WVDIENS,.01)="A "_WVADESC_" action taken on the "_WVSRC_" document prompted a chart review."
End DoDot:2
if $GET(WVRESULT)=-1
QUIT
+45 IF $GET(WVPROMPT)
Begin DoDot:2
+46 KILL DIR,DIRUT,DIROUT,Y
+47 SET DIR(0)=WVFILE_",.01"
+48 DO ^DIR
+49 IF $DATA(DIRUT)!($DATA(DIROUT))
SET WVRESULT=-1
QUIT
+50 SET WVFDA(WVFILE,"+1,"_WVDIENS,.01)=$PIECE($GET(Y),U)
End DoDot:2
if $GET(WVRESULT)=-1
QUIT
+51 IF WVACTION=1
SET WVFDA(WVFILE,"+1,"_WVDIENS,.01)=WVFDA(WVFILE,"+1,"_WVDIENS,.01)_" The data was moved to "_WVNPATNM_"'s chart."
+52 DO UPDATE^DIE("","WVFDA",,"WVERROR")
+53 IF $DATA(WVERROR)
SET WVRESULT=$$ERROR^WVMGRP("storing the reason why the "_$SELECT(WVACTION=1:"incorrect",1:"")_" entry was marked as entered in error",.WVERROR)
End DoDot:1
+54 IF $GET(WVRESULT)=-1
QUIT -1
+55 WRITE !!,"ACTION TAKEN.",!
+56 HANG 4
+57 IF $GET(WVRIENS)'=""
Begin DoDot:1
+58 SET WVRIENS=$PIECE(WVRIENS,",",2)_","
+59 IF +WVRIENS=0
SET WVRESULT=$$ERROR^WVMGRP("deleting the review record",,"Unable to determine the proper IENS value.")
QUIT
+60 SET WVFDA(790.8,WVRIENS,.01)="@"
+61 DO FILE^DIE(,"WVFDA","WVERROR")
+62 IF $DATA(WVERROR)
SET WVRESULT=$$ERROR^WVMGRP("deleting the review record",.WVERROR)
QUIT
+63 KILL WVRTACTS
End DoDot:1
if $GET(WVRESULT)=-1
QUIT -1
+64 QUIT 1
+65 ;
