- 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 Feb 19, 2025@00:13: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 ;
