- 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 Feb 19, 2025@00:14:10 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
