WVRPCOR1 ;ISP/RFR - CPRS RPCS CONTINUED ;Oct 19, 2020@14:42
;;1.0;WOMEN'S HEALTH;**24,26**;Sep 30, 1998;Build 624
Q
EIE(WVRETURN,WVRECID,WVREASON) ;MARK DATA AS ENTERED IN ERROR
;RPC: WVRPCOR EIE
;WVRECID=790_GLOBAL_NODE_#;IENS
N WVFDA,WVERROR,WVFNUMS,WVFILE,WVIENS,WVTYPES,WVEXTERNAL,WVNODE,WVCNT,WVCUR,WVDFN
I $G(WVRECID)="" S WVRETURN=-1_U_"No record ID specified." Q
I $D(WVREASON)<10 S WVRETURN=-1_U_"No reason(s) specified." Q
S WVDFN=$P($P(WVRECID,";",2),",",2)
D SETUP^WVRPCOR
S WVRETURN=0_U,WVFNUMS(790.05)=790.15,WVFNUMS(790.16)=790.18
S WVNODE=$P(WVRECID,";",1)
I WVNODE="" S WVRETURN=-1_U_"Invalid record ID specified: "_WVRECID Q
I '$D(WVTYPES(WVNODE)) S WVRETURN=-1_U_"Invalid record ID specified: "_WVRECID Q
S WVFILE=$P(WVTYPES(WVNODE),U,2),WVIENS=$P(WVRECID,";",2)
I +$P(WVIENS,",")<1 S WVRETURN=-1_U_"Invalid record ID specified: "_WVRECID Q
I $P($G(^WV(790,$P(WVIENS,",",2),WVNODE,$P(WVIENS,","),0)),U,6) D Q
.S WVRETURN=-1_U_"That record is already marked as entered in error. Please refresh the Women's Health panel before continuing."
I '$D(WVOVRIDE) D Q:+WVRETURN=-1
.S WVCUR=+$$GETLREC^WVUTL11($P(WVIENS,",",2),WVNODE)
.I 'WVCUR S WVRETURN=-1_U_"There is no current status record. Please refresh the Women's Health panel before continuing." Q
.I $P(WVIENS,",")'=WVCUR S WVRETURN=-1_U_"A newer status record exists. Please refresh the Women's Health panel before continuing." Q
S WVFDA(WVFILE,WVIENS,6)="1"
D FILE^DIE(,"WVFDA","WVERROR")
I $D(WVERROR) S WVRETURN=-1_U_$$FMERROR^WVUTL11(.WVERROR) Q
I '$D(WVERROR) S WVRETURN=1_U
S WVREASON="" F S WVREASON=$O(WVREASON(WVREASON)) Q:WVREASON="" D
.S WVCNT=1+$G(WVCNT),WVFDA(WVFNUMS(WVFILE),"+"_WVCNT_","_WVIENS,.01)=WVREASON(WVREASON)
D UPDATE^DIE(,"WVFDA",,"WVERROR")
I $D(WVERROR) S WVRETURN=-1_U_$$FMERROR^WVUTL11(.WVERROR) Q
Q
REASONS(WVRETURN) ;RETURN A LIST OF PRE-DEFINED REASONS FOR USE IN MARKING A
; STATUS AS ENTERED IN ERROR
;RPC: WVRPCOR REASONS
N WVSEQ,WVIEN,WVSITE,WVIDX,WVDATA,WVERROR,WVREASON
;SITE-SPECIFIC REASONS
I $G(DUZ(2))?1.N D
.S WVSITE=DUZ(2),WVIDX=0
.S WVSEQ="" F S WVSEQ=$O(^WV(790.02,WVSITE,43,"B",WVSEQ)) Q:WVSEQ="" D
..S WVIEN=0 F S WVIEN=$O(^WV(790.02,WVSITE,43,"B",WVSEQ,WVIEN)) Q:'+WVIEN D
...S WVIDX=WVIDX+1,WVRETURN(WVIDX)=$P($G(^WV(790.02,WVSITE,43,WVIEN,0)),U,2)
;PACKAGE-SPECIFIC REASONS
D GETLST^XPAR(.WVDATA,"PKG","WV ENTERED IN ERROR REASONS","Q",.WVERROR)
F WVREASON=1:1:WVDATA S WVIDX=WVIDX+1,WVRETURN(WVIDX)=$P(WVDATA(WVREASON),U,2)
Q
SITES(WVRETURN) ;RETURN A LIST OF WEB SITES FOR DISPLAY ON THE COVER SHEET
;RPC: WVRPCOR SITES
D GETLST^XPAR(.WVRETURN,"ALL","WV COVER SHEET WEBSITES","Q")
S WVRETURN(0)="Informational Web Sites"
Q
CONSAVE(WVRETURN,WVDFN) ;DETERMINE WHETHER TO PROMPT USER TO CONFIRM SAVING DATA
;RPC: WVRPCOR1 CONSAVE
N WVTYPES,WVEXTERNAL,WVAPPL,WVNODE,WVWARN,WVDELIM,WVITEM,WVRIEN
D SETUP^WVRPCOR
S WVRETURN(0)=""
S WVNODE=0 F S WVNODE=$O(WVTYPES(WVNODE)) Q:'+WVNODE!(+$G(WVAPPL)=-1) D
.S WVAPPL=$$APPL^WVRPCOR(WVDFN,WVNODE) Q:+WVAPPL=-1
.I '+WVAPPL S WVWARN=1+$G(WVWARN),WVWARN(WVWARN)=$P(WVTYPES(WVNODE),U,4) I WVWARN>1 S WVWARN(WVWARN)=$$LOW^XLFSTR(WVWARN(WVWARN))
I +$G(WVAPPL)=-1 S WVRETURN(0)=WVAPPL Q
S WVDELIM=", ",WVITEM=0 F S WVITEM=$O(WVWARN(WVITEM)) Q:'+WVITEM D
.I WVITEM=WVWARN-1 S WVDELIM=" and "
.S WVRETURN(0)=$S(WVRETURN(0)'="":WVRETURN(0)_WVDELIM,1:"")_WVWARN(WVITEM)
S WVRIEN=$O(^PXRMD(801.41,"B","VA-WH TD PREGNANCY STATUS YES LMPD",""))
S WVRETURN(1)="datesCal"_U_WVRIEN
I WVRETURN(0)="" S WVRETURN(0)=0_U Q
S WVRETURN(0)=1_U_WVRETURN(0)_" data "_$S(WVWARN<2:"is",1:"are")_" not required for this patient. Do you want to continue updating data for this patient?"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HWVRPCOR1 3781 printed Dec 13, 2024@02:47:43 Page 2
WVRPCOR1 ;ISP/RFR - CPRS RPCS CONTINUED ;Oct 19, 2020@14:42
+1 ;;1.0;WOMEN'S HEALTH;**24,26**;Sep 30, 1998;Build 624
+2 QUIT
EIE(WVRETURN,WVRECID,WVREASON) ;MARK DATA AS ENTERED IN ERROR
+1 ;RPC: WVRPCOR EIE
+2 ;WVRECID=790_GLOBAL_NODE_#;IENS
+3 NEW WVFDA,WVERROR,WVFNUMS,WVFILE,WVIENS,WVTYPES,WVEXTERNAL,WVNODE,WVCNT,WVCUR,WVDFN
+4 IF $GET(WVRECID)=""
SET WVRETURN=-1_U_"No record ID specified."
QUIT
+5 IF $DATA(WVREASON)<10
SET WVRETURN=-1_U_"No reason(s) specified."
QUIT
+6 SET WVDFN=$PIECE($PIECE(WVRECID,";",2),",",2)
+7 DO SETUP^WVRPCOR
+8 SET WVRETURN=0_U
SET WVFNUMS(790.05)=790.15
SET WVFNUMS(790.16)=790.18
+9 SET WVNODE=$PIECE(WVRECID,";",1)
+10 IF WVNODE=""
SET WVRETURN=-1_U_"Invalid record ID specified: "_WVRECID
QUIT
+11 IF '$DATA(WVTYPES(WVNODE))
SET WVRETURN=-1_U_"Invalid record ID specified: "_WVRECID
QUIT
+12 SET WVFILE=$PIECE(WVTYPES(WVNODE),U,2)
SET WVIENS=$PIECE(WVRECID,";",2)
+13 IF +$PIECE(WVIENS,",")<1
SET WVRETURN=-1_U_"Invalid record ID specified: "_WVRECID
QUIT
+14 IF $PIECE($GET(^WV(790,$PIECE(WVIENS,",",2),WVNODE,$PIECE(WVIENS,","),0)),U,6)
Begin DoDot:1
+15 SET WVRETURN=-1_U_"That record is already marked as entered in error. Please refresh the Women's Health panel before continuing."
End DoDot:1
QUIT
+16 IF '$DATA(WVOVRIDE)
Begin DoDot:1
+17 SET WVCUR=+$$GETLREC^WVUTL11($PIECE(WVIENS,",",2),WVNODE)
+18 IF 'WVCUR
SET WVRETURN=-1_U_"There is no current status record. Please refresh the Women's Health panel before continuing."
QUIT
+19 IF $PIECE(WVIENS,",")'=WVCUR
SET WVRETURN=-1_U_"A newer status record exists. Please refresh the Women's Health panel before continuing."
QUIT
End DoDot:1
if +WVRETURN=-1
QUIT
+20 SET WVFDA(WVFILE,WVIENS,6)="1"
+21 DO FILE^DIE(,"WVFDA","WVERROR")
+22 IF $DATA(WVERROR)
SET WVRETURN=-1_U_$$FMERROR^WVUTL11(.WVERROR)
QUIT
+23 IF '$DATA(WVERROR)
SET WVRETURN=1_U
+24 SET WVREASON=""
FOR
SET WVREASON=$ORDER(WVREASON(WVREASON))
if WVREASON=""
QUIT
Begin DoDot:1
+25 SET WVCNT=1+$GET(WVCNT)
SET WVFDA(WVFNUMS(WVFILE),"+"_WVCNT_","_WVIENS,.01)=WVREASON(WVREASON)
End DoDot:1
+26 DO UPDATE^DIE(,"WVFDA",,"WVERROR")
+27 IF $DATA(WVERROR)
SET WVRETURN=-1_U_$$FMERROR^WVUTL11(.WVERROR)
QUIT
+28 QUIT
REASONS(WVRETURN) ;RETURN A LIST OF PRE-DEFINED REASONS FOR USE IN MARKING A
+1 ; STATUS AS ENTERED IN ERROR
+2 ;RPC: WVRPCOR REASONS
+3 NEW WVSEQ,WVIEN,WVSITE,WVIDX,WVDATA,WVERROR,WVREASON
+4 ;SITE-SPECIFIC REASONS
+5 IF $GET(DUZ(2))?1.N
Begin DoDot:1
+6 SET WVSITE=DUZ(2)
SET WVIDX=0
+7 SET WVSEQ=""
FOR
SET WVSEQ=$ORDER(^WV(790.02,WVSITE,43,"B",WVSEQ))
if WVSEQ=""
QUIT
Begin DoDot:2
+8 SET WVIEN=0
FOR
SET WVIEN=$ORDER(^WV(790.02,WVSITE,43,"B",WVSEQ,WVIEN))
if '+WVIEN
QUIT
Begin DoDot:3
+9 SET WVIDX=WVIDX+1
SET WVRETURN(WVIDX)=$PIECE($GET(^WV(790.02,WVSITE,43,WVIEN,0)),U,2)
End DoDot:3
End DoDot:2
End DoDot:1
+10 ;PACKAGE-SPECIFIC REASONS
+11 DO GETLST^XPAR(.WVDATA,"PKG","WV ENTERED IN ERROR REASONS","Q",.WVERROR)
+12 FOR WVREASON=1:1:WVDATA
SET WVIDX=WVIDX+1
SET WVRETURN(WVIDX)=$PIECE(WVDATA(WVREASON),U,2)
+13 QUIT
SITES(WVRETURN) ;RETURN A LIST OF WEB SITES FOR DISPLAY ON THE COVER SHEET
+1 ;RPC: WVRPCOR SITES
+2 DO GETLST^XPAR(.WVRETURN,"ALL","WV COVER SHEET WEBSITES","Q")
+3 SET WVRETURN(0)="Informational Web Sites"
+4 QUIT
CONSAVE(WVRETURN,WVDFN) ;DETERMINE WHETHER TO PROMPT USER TO CONFIRM SAVING DATA
+1 ;RPC: WVRPCOR1 CONSAVE
+2 NEW WVTYPES,WVEXTERNAL,WVAPPL,WVNODE,WVWARN,WVDELIM,WVITEM,WVRIEN
+3 DO SETUP^WVRPCOR
+4 SET WVRETURN(0)=""
+5 SET WVNODE=0
FOR
SET WVNODE=$ORDER(WVTYPES(WVNODE))
if '+WVNODE!(+$GET(WVAPPL)=-1)
QUIT
Begin DoDot:1
+6 SET WVAPPL=$$APPL^WVRPCOR(WVDFN,WVNODE)
if +WVAPPL=-1
QUIT
+7 IF '+WVAPPL
SET WVWARN=1+$GET(WVWARN)
SET WVWARN(WVWARN)=$PIECE(WVTYPES(WVNODE),U,4)
IF WVWARN>1
SET WVWARN(WVWARN)=$$LOW^XLFSTR(WVWARN(WVWARN))
End DoDot:1
+8 IF +$GET(WVAPPL)=-1
SET WVRETURN(0)=WVAPPL
QUIT
+9 SET WVDELIM=", "
SET WVITEM=0
FOR
SET WVITEM=$ORDER(WVWARN(WVITEM))
if '+WVITEM
QUIT
Begin DoDot:1
+10 IF WVITEM=WVWARN-1
SET WVDELIM=" and "
+11 SET WVRETURN(0)=$SELECT(WVRETURN(0)'="":WVRETURN(0)_WVDELIM,1:"")_WVWARN(WVITEM)
End DoDot:1
+12 SET WVRIEN=$ORDER(^PXRMD(801.41,"B","VA-WH TD PREGNANCY STATUS YES LMPD",""))
+13 SET WVRETURN(1)="datesCal"_U_WVRIEN
+14 IF WVRETURN(0)=""
SET WVRETURN(0)=0_U
QUIT
+15 SET WVRETURN(0)=1_U_WVRETURN(0)_" data "_$SELECT(WVWARN<2:"is",1:"are")_" not required for this patient. Do you want to continue updating data for this patient?"
+16 QUIT
