WVRADWP ;HCIOFO/FT-Display Report Data from Related Packages ;9/29/04 14:35
;;1.0;WOMEN'S HEALTH;**4,5,7,15,16**;Sep 30, 1998
;
; This routine uses the following IAs:
; #2479 - FILE 74 fields (private)
; #2480 - FILE 70 fileds (private)
; #10035 - ^DPT( references (supported)
; #10070 - ^XMD (supported)
;
EN ; Determine which report to show (i.e., radiology/nuclear medicine)
; Called from Edit a Procedure option screen form.
D EX
Q:'$G(DA)
Q:'$D(^WV(790.1,+DA,0))
N WV7901
S WV7901=$E(^WV(790.1,+DA,0),1,2) ;first 2 characters of accession code
Q:WV7901=""
I "^BU^MB^MS^MU^PU^VU^"[WV7901 D EN1 Q ;show rad/nm report data
Q
EN1 ; Set up radiology report data and call FM Browser
N LOOP,WVDUP,WVIENS,WVLCNT,WVRADCSE,WVRADDFN,WVRADDTE,WVRADIEN,WVRPTIEN
N WVJCN,WVJCN1
S WVRADIEN=$P(^WV(790.1,DA,0),U,15)
Q:WVRADIEN="" ;no 'radiology mam case #'
S WVRADDFN=$P(^WV(790.1,DA,0),U,2)
Q:'WVRADDFN ;no dfn
S WVRADDTE=$O(^RADPT("ADC",WVRADIEN,WVRADDFN,0))
Q:'WVRADDTE ;no inverse exam date
S WVRADCSE=$O(^RADPT("ADC",WVRADIEN,WVRADDFN,WVRADDTE,0))
Q:'WVRADCSE ;no case number
S WVRPTIEN=+$P(^RADPT(WVRADDFN,"DT",WVRADDTE,"P",WVRADCSE,0),U,17)
Q:'WVRPTIEN ;no report in File 74
K ^TMP($J,"WV RADRPT"),^TMP("WV RADRPT",$J),^TMP($J,"WV CH")
S WVIENS=WVRADCSE_","_WVRADDTE_","_WVRADDFN_"," ;iens for FILE 70 entry
; get clincal history from FILE 70
D GETS^DIQ(70.03,WVIENS,400,"EIZ","^TMP($J,""WV CH"")")
; get data from FILE 74
D GETS^DIQ(74,WVRPTIEN_",","*","EI","^TMP($J,""WV RADRPT"")")
S ^TMP("WV RADRPT",$J,1,0)=" DAY-CASE #: "_$G(^TMP($J,"WV RADRPT",74,WVRPTIEN_",",.01,"E"))_$S($$AMEND(WVRPTIEN):" (AMENDED REPORT)",1:"")
S ^TMP("WV RADRPT",$J,2,0)=" EXAM DATE/TIME: "_^TMP($J,"WV RADRPT",74,WVRPTIEN_",",3,"E")
S ^TMP("WV RADRPT",$J,3,0)=" VERIFYING PHYSICIAN: "_^TMP($J,"WV RADRPT",74,WVRPTIEN_",",9,"E")
S ^TMP("WV RADRPT",$J,4,0)=" PROCEDURE: "_^TMP($J,"WV RADRPT",74,WVRPTIEN_",",102,"E")
S ^TMP("WV RADRPT",$J,5,0)=" CATEGORY OF EXAM: "_^TMP($J,"WV RADRPT",74,WVRPTIEN_",",104,"E")
S ^TMP("WV RADRPT",$J,6,0)=" WARD: "_^TMP($J,"WV RADRPT",74,WVRPTIEN_",",106,"E")
S ^TMP("WV RADRPT",$J,7,0)=" TREATING SERVICE (INPATIENT): "_^TMP($J,"WV RADRPT",74,WVRPTIEN_",",107,"E")
S ^TMP("WV RADRPT",$J,8,0)=" PRINCIPAL CLINIC: "_^TMP($J,"WV RADRPT",74,WVRPTIEN_",",108,"E")
S ^TMP("WV RADRPT",$J,9,0)=" CONTRACT SHARING SOURCE: "_^TMP($J,"WV RADRPT",74,WVRPTIEN_",",109,"E")
S ^TMP("WV RADRPT",$J,10,0)="PRIMARY INTERPRETING RESIDENT: "_^TMP($J,"WV RADRPT",74,WVRPTIEN_",",112,"E")
S ^TMP("WV RADRPT",$J,11,0)=" PRIMARY INTERPRETING STAFF: "_^TMP($J,"WV RADRPT",74,WVRPTIEN_",",115,"E")
S ^TMP("WV RADRPT",$J,12,0)=" PRIMARY DIAGNOSIS: "_^TMP($J,"WV RADRPT",74,WVRPTIEN_",",113,"E")
S ^TMP("WV RADRPT",$J,13,0)=" REQUESTING PHYSICIAN: "_^TMP($J,"WV RADRPT",74,WVRPTIEN_",",114,"E")
S ^TMP("WV RADRPT",$J,14,0)=" COMPLICATION: "_^TMP($J,"WV RADRPT",74,WVRPTIEN_",",116,"E")
S ^TMP("WV RADRPT",$J,15,0)=" "
S ^TMP("WV RADRPT",$J,16,0)="CLINICAL HISTORY:"
S LOOP=0,WVLCNT=16
S WVDUP=$$COMPARE()
I WVDUP=1 D ;Clinical History text in files 70 & 74 are different
.S LOOP=0
.F S LOOP=$O(^TMP($J,"WV CH",70.03,WVIENS,400,LOOP)) Q:'LOOP D
..S WVLCNT=WVLCNT+1
..S ^TMP("WV RADRPT",$J,WVLCNT,0)=^TMP($J,"WV CH",70.03,WVIENS,400,LOOP,0)
..Q
.I WVLCNT>16 D ;insert blank line if different texts exist
..S WVLCNT=WVLCNT+1
..S ^TMP("WV RADRPT",$J,WVLCNT,0)=" "
..Q
.S LOOP=0
.F S LOOP=$O(^TMP($J,"WV RADRPT",74,WVRPTIEN_",",400,LOOP)) Q:'LOOP D
..S WVLCNT=WVLCNT+1
..S ^TMP("WV RADRPT",$J,WVLCNT,0)=^TMP($J,"WV RADRPT",74,WVRPTIEN_",",400,LOOP)
..Q
.Q
I WVDUP=0 D ;Clinical History field is same
.S LOOP=0
.F S LOOP=$O(^TMP($J,"WV RADRPT",74,WVRPTIEN_",",400,LOOP)) Q:'LOOP D
..S WVLCNT=WVLCNT+1
..S ^TMP("WV RADRPT",$J,WVLCNT,0)=^TMP($J,"WV RADRPT",74,WVRPTIEN_",",400,LOOP)
..Q
.Q
S WVLCNT=WVLCNT+1
S ^TMP("WV RADRPT",$J,WVLCNT,0)=" "
S WVLCNT=WVLCNT+1
S ^TMP("WV RADRPT",$J,WVLCNT,0)="IMPRESSION TEXT:"
S LOOP=0
F S LOOP=$O(^TMP($J,"WV RADRPT",74,WVRPTIEN_",",300,LOOP)) Q:'LOOP D
.S WVLCNT=WVLCNT+1
.S ^TMP("WV RADRPT",$J,WVLCNT,0)=^TMP($J,"WV RADRPT",74,WVRPTIEN_",",300,LOOP)
.Q
S WVLCNT=WVLCNT+1
S ^TMP("WV RADRPT",$J,WVLCNT,0)=" "
S WVLCNT=WVLCNT+1
S ^TMP("WV RADRPT",$J,WVLCNT,0)="REPORT TEXT:"
S LOOP=0
F S LOOP=$O(^TMP($J,"WV RADRPT",74,WVRPTIEN_",",200,LOOP)) Q:'LOOP D
.S WVLCNT=WVLCNT+1
.S ^TMP("WV RADRPT",$J,WVLCNT,0)=^TMP($J,"WV RADRPT",74,WVRPTIEN_",",200,LOOP)
.Q
K ^TMP($J,"WV RADRPT"),WVLCNT,^WV(790.1,DA,9)
S WVJCN=0 F S WVJCN=$O(^TMP("WV RADRPT",$J,WVJCN)) Q:WVJCN'>0 D
.S ^WV(790.1,DA,9,WVJCN,0)=$G(^TMP("WV RADRPT",$J,WVJCN,0)) S WVJCN1=WVJCN
S ^WV(790.1,DA,9,0)="^^"_WVJCN1_"^"_WVJCN1
K ^TMP("WV RADRPT",$J),^TMP($J,"WV CH")
Q
EX ; delete existing radiology report text stored in WH
K ^WV(790.1,DA,9)
Q
MAIL(DFN,WVACCESS,WVPROC,WVPROV) ; Send mail message to case manager when
; Radiology procedure is added to WH Procedure file (#790.1).
; Called from WVRALINK
; DFN -> Patient ien
; WVACCESS -> File 790.1 ien (procedure entry)
; WVPROC -> File 790.2 ien (procedure type)
; WVPROV -> File 200 IEN (provider/requestor)
Q:'$G(DFN)!('$G(WVACCESS))!('$G(WVPROC))
N WVCMGR,WVLOOP,WVMSG,XMDUZ,XMSUB,XMTEXT,XMY
S WVCMGR=+$$GET1^DIQ(790,DFN,.1,"I") ;get case manager
S:WVCMGR XMY(WVCMGR)=""
; if no case manager, then get default case manager(s)
I 'WVCMGR S WVLOOP=0 F S WVLOOP=$O(^WV(790.02,WVLOOP)) Q:'WVLOOP D
.S WVCMGR=$$GET1^DIQ(790.02,WVLOOP,.02,"I")
.S:WVCMGR XMY(WVCMGR)=""
.Q
Q:$O(XMY(0))'>0 ;no case manager(s)
;S:WVPROV XMY(WVPROV)=""
S XMDUZ=.5 ;message sender
S XMSUB="RAD/NM added a procedure for a WH patient"
S WVMSG(1)=" Patient: "_$P($G(^DPT(DFN,0)),U,1)_" (SSN: "_$$SSN^WVUTL1(DFN)_")"
S WVMSG(2)=" WH Accession #: "_$P($G(^WV(790.1,+WVACCESS,0)),U,1)
S WVMSG(3)=" Procedure: "_$P($G(^WV(790.2,+WVPROC,0)),U,1)
S WVMSG(4)=" "
S WVMSG(5)="Please use the 'Edit a Procedure' option in the WOMEN'S"
S WVMSG(6)="HEALTH package to complete/close this procedure."
I ($E($P(WVMSG(2),"#: ",2),1,2)="MB")!($E($P(WVMSG(2),"#: ",2),1,2)="MS")!($E($P(WVMSG(2),"#: ",2),1,2)="MU") D
.S WVMSG(5)="Please use CPRS to resolve the Clinical Reminder for this procedure and"
.S WVMSG(6)="complete the result."
.Q
S XMTEXT="WVMSG("
D ^XMD
Q
AMEND(WVRPTIEN) ; Check if RAD/NM report is amended.
; WVRPTIEN - File 74 ien
N WVAMEND
K ^TMP("DILIST",$J),^TMP("DIERR",$J)
D LIST^DIC(74.06,","_WVRPTIEN_",",.01)
S WVAMEND=$O(^TMP("DILIST",$J,0))
K ^TMP("DILIST",$J),^TMP("DIERR",$J)
Q WVAMEND
;
COMPARE() ; Compares Clincal History fields in files 70 & 74
; Returns 1 (different) or 0 (same)
N LOOP,WVFLAG,WV70CNT,WV70IEN,WV74CNT,WV74IEN,WVNODE70,WVNODE74
S (LOOP,WV70CNT,WV74CNT,WVFLAG)=0
S WV70IEN=WVIENS,WV74IEN=WVRPTIEN_","
I '$O(^TMP($J,"WV CH",70.03,WV70IEN,400,0)) S WVFLAG=WVFLAG+1
I '$O(^TMP($J,"WV RADRPT",74,WV74IEN,400,0)) S WVFLAG=WVFLAG+1
I WVFLAG=1 Q 1 ;different (field was purged in one file, exists in
; the other file)
I WVFLAG=2 Q 0 ;same (field was purged in 70 & 74)
F S LOOP=$O(^TMP($J,"WV CH",70.03,WV70IEN,400,LOOP)) Q:'LOOP D
.S WV70CNT=WV70CNT+1
.Q
S LOOP=0
F S LOOP=$O(^TMP($J,"WV RADRPT",74,WV74IEN,400,LOOP)) Q:'LOOP D
.S WV74CNT=WV74CNT+1
.Q
I WV70CNT'=WV74CNT Q 1 ;line counts are different
S LOOP=0
F S LOOP=$O(^TMP($J,"WV CH",70.03,WV70IEN,400,LOOP)) Q:'LOOP!(WVFLAG=1) D
.S WVNODE70=$G(^TMP($J,"WV CH",70.03,WV70IEN,400,LOOP,0))
.S WVNODE74=$G(^TMP($J,"WV RADRPT",74,WV74IEN,400,LOOP))
.I WVNODE70'=WVNODE74 S WVFLAG=1
.Q
Q WVFLAG
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HWVRADWP 7972 printed Oct 16, 2024@18:48:01 Page 2
WVRADWP ;HCIOFO/FT-Display Report Data from Related Packages ;9/29/04 14:35
+1 ;;1.0;WOMEN'S HEALTH;**4,5,7,15,16**;Sep 30, 1998
+2 ;
+3 ; This routine uses the following IAs:
+4 ; #2479 - FILE 74 fields (private)
+5 ; #2480 - FILE 70 fileds (private)
+6 ; #10035 - ^DPT( references (supported)
+7 ; #10070 - ^XMD (supported)
+8 ;
EN ; Determine which report to show (i.e., radiology/nuclear medicine)
+1 ; Called from Edit a Procedure option screen form.
+2 DO EX
+3 if '$GET(DA)
QUIT
+4 if '$DATA(^WV(790.1,+DA,0))
QUIT
+5 NEW WV7901
+6 ;first 2 characters of accession code
SET WV7901=$EXTRACT(^WV(790.1,+DA,0),1,2)
+7 if WV7901=""
QUIT
+8 ;show rad/nm report data
IF "^BU^MB^MS^MU^PU^VU^"[WV7901
DO EN1
QUIT
+9 QUIT
EN1 ; Set up radiology report data and call FM Browser
+1 NEW LOOP,WVDUP,WVIENS,WVLCNT,WVRADCSE,WVRADDFN,WVRADDTE,WVRADIEN,WVRPTIEN
+2 NEW WVJCN,WVJCN1
+3 SET WVRADIEN=$PIECE(^WV(790.1,DA,0),U,15)
+4 ;no 'radiology mam case #'
if WVRADIEN=""
QUIT
+5 SET WVRADDFN=$PIECE(^WV(790.1,DA,0),U,2)
+6 ;no dfn
if 'WVRADDFN
QUIT
+7 SET WVRADDTE=$ORDER(^RADPT("ADC",WVRADIEN,WVRADDFN,0))
+8 ;no inverse exam date
if 'WVRADDTE
QUIT
+9 SET WVRADCSE=$ORDER(^RADPT("ADC",WVRADIEN,WVRADDFN,WVRADDTE,0))
+10 ;no case number
if 'WVRADCSE
QUIT
+11 SET WVRPTIEN=+$PIECE(^RADPT(WVRADDFN,"DT",WVRADDTE,"P",WVRADCSE,0),U,17)
+12 ;no report in File 74
if 'WVRPTIEN
QUIT
+13 KILL ^TMP($JOB,"WV RADRPT"),^TMP("WV RADRPT",$JOB),^TMP($JOB,"WV CH")
+14 ;iens for FILE 70 entry
SET WVIENS=WVRADCSE_","_WVRADDTE_","_WVRADDFN_","
+15 ; get clincal history from FILE 70
+16 DO GETS^DIQ(70.03,WVIENS,400,"EIZ","^TMP($J,""WV CH"")")
+17 ; get data from FILE 74
+18 DO GETS^DIQ(74,WVRPTIEN_",","*","EI","^TMP($J,""WV RADRPT"")")
+19 SET ^TMP("WV RADRPT",$JOB,1,0)=" DAY-CASE #: "_$GET(^TMP($JOB,"WV RADRPT",74,WVRPTIEN_",",.01,"E"))_$SELECT($$AMEND(WVRPTIEN):" (AMENDED REPORT)",1:"")
+20 SET ^TMP("WV RADRPT",$JOB,2,0)=" EXAM DATE/TIME: "_^TMP($JOB,"WV RADRPT",74,WVRPTIEN_",",3,"E")
+21 SET ^TMP("WV RADRPT",$JOB,3,0)=" VERIFYING PHYSICIAN: "_^TMP($JOB,"WV RADRPT",74,WVRPTIEN_",",9,"E")
+22 SET ^TMP("WV RADRPT",$JOB,4,0)=" PROCEDURE: "_^TMP($JOB,"WV RADRPT",74,WVRPTIEN_",",102,"E")
+23 SET ^TMP("WV RADRPT",$JOB,5,0)=" CATEGORY OF EXAM: "_^TMP($JOB,"WV RADRPT",74,WVRPTIEN_",",104,"E")
+24 SET ^TMP("WV RADRPT",$JOB,6,0)=" WARD: "_^TMP($JOB,"WV RADRPT",74,WVRPTIEN_",",106,"E")
+25 SET ^TMP("WV RADRPT",$JOB,7,0)=" TREATING SERVICE (INPATIENT): "_^TMP($JOB,"WV RADRPT",74,WVRPTIEN_",",107,"E")
+26 SET ^TMP("WV RADRPT",$JOB,8,0)=" PRINCIPAL CLINIC: "_^TMP($JOB,"WV RADRPT",74,WVRPTIEN_",",108,"E")
+27 SET ^TMP("WV RADRPT",$JOB,9,0)=" CONTRACT SHARING SOURCE: "_^TMP($JOB,"WV RADRPT",74,WVRPTIEN_",",109,"E")
+28 SET ^TMP("WV RADRPT",$JOB,10,0)="PRIMARY INTERPRETING RESIDENT: "_^TMP($JOB,"WV RADRPT",74,WVRPTIEN_",",112,"E")
+29 SET ^TMP("WV RADRPT",$JOB,11,0)=" PRIMARY INTERPRETING STAFF: "_^TMP($JOB,"WV RADRPT",74,WVRPTIEN_",",115,"E")
+30 SET ^TMP("WV RADRPT",$JOB,12,0)=" PRIMARY DIAGNOSIS: "_^TMP($JOB,"WV RADRPT",74,WVRPTIEN_",",113,"E")
+31 SET ^TMP("WV RADRPT",$JOB,13,0)=" REQUESTING PHYSICIAN: "_^TMP($JOB,"WV RADRPT",74,WVRPTIEN_",",114,"E")
+32 SET ^TMP("WV RADRPT",$JOB,14,0)=" COMPLICATION: "_^TMP($JOB,"WV RADRPT",74,WVRPTIEN_",",116,"E")
+33 SET ^TMP("WV RADRPT",$JOB,15,0)=" "
+34 SET ^TMP("WV RADRPT",$JOB,16,0)="CLINICAL HISTORY:"
+35 SET LOOP=0
SET WVLCNT=16
+36 SET WVDUP=$$COMPARE()
+37 ;Clinical History text in files 70 & 74 are different
IF WVDUP=1
Begin DoDot:1
+38 SET LOOP=0
+39 FOR
SET LOOP=$ORDER(^TMP($JOB,"WV CH",70.03,WVIENS,400,LOOP))
if 'LOOP
QUIT
Begin DoDot:2
+40 SET WVLCNT=WVLCNT+1
+41 SET ^TMP("WV RADRPT",$JOB,WVLCNT,0)=^TMP($JOB,"WV CH",70.03,WVIENS,400,LOOP,0)
+42 QUIT
End DoDot:2
+43 ;insert blank line if different texts exist
IF WVLCNT>16
Begin DoDot:2
+44 SET WVLCNT=WVLCNT+1
+45 SET ^TMP("WV RADRPT",$JOB,WVLCNT,0)=" "
+46 QUIT
End DoDot:2
+47 SET LOOP=0
+48 FOR
SET LOOP=$ORDER(^TMP($JOB,"WV RADRPT",74,WVRPTIEN_",",400,LOOP))
if 'LOOP
QUIT
Begin DoDot:2
+49 SET WVLCNT=WVLCNT+1
+50 SET ^TMP("WV RADRPT",$JOB,WVLCNT,0)=^TMP($JOB,"WV RADRPT",74,WVRPTIEN_",",400,LOOP)
+51 QUIT
End DoDot:2
+52 QUIT
End DoDot:1
+53 ;Clinical History field is same
IF WVDUP=0
Begin DoDot:1
+54 SET LOOP=0
+55 FOR
SET LOOP=$ORDER(^TMP($JOB,"WV RADRPT",74,WVRPTIEN_",",400,LOOP))
if 'LOOP
QUIT
Begin DoDot:2
+56 SET WVLCNT=WVLCNT+1
+57 SET ^TMP("WV RADRPT",$JOB,WVLCNT,0)=^TMP($JOB,"WV RADRPT",74,WVRPTIEN_",",400,LOOP)
+58 QUIT
End DoDot:2
+59 QUIT
End DoDot:1
+60 SET WVLCNT=WVLCNT+1
+61 SET ^TMP("WV RADRPT",$JOB,WVLCNT,0)=" "
+62 SET WVLCNT=WVLCNT+1
+63 SET ^TMP("WV RADRPT",$JOB,WVLCNT,0)="IMPRESSION TEXT:"
+64 SET LOOP=0
+65 FOR
SET LOOP=$ORDER(^TMP($JOB,"WV RADRPT",74,WVRPTIEN_",",300,LOOP))
if 'LOOP
QUIT
Begin DoDot:1
+66 SET WVLCNT=WVLCNT+1
+67 SET ^TMP("WV RADRPT",$JOB,WVLCNT,0)=^TMP($JOB,"WV RADRPT",74,WVRPTIEN_",",300,LOOP)
+68 QUIT
End DoDot:1
+69 SET WVLCNT=WVLCNT+1
+70 SET ^TMP("WV RADRPT",$JOB,WVLCNT,0)=" "
+71 SET WVLCNT=WVLCNT+1
+72 SET ^TMP("WV RADRPT",$JOB,WVLCNT,0)="REPORT TEXT:"
+73 SET LOOP=0
+74 FOR
SET LOOP=$ORDER(^TMP($JOB,"WV RADRPT",74,WVRPTIEN_",",200,LOOP))
if 'LOOP
QUIT
Begin DoDot:1
+75 SET WVLCNT=WVLCNT+1
+76 SET ^TMP("WV RADRPT",$JOB,WVLCNT,0)=^TMP($JOB,"WV RADRPT",74,WVRPTIEN_",",200,LOOP)
+77 QUIT
End DoDot:1
+78 KILL ^TMP($JOB,"WV RADRPT"),WVLCNT,^WV(790.1,DA,9)
+79 SET WVJCN=0
FOR
SET WVJCN=$ORDER(^TMP("WV RADRPT",$JOB,WVJCN))
if WVJCN'>0
QUIT
Begin DoDot:1
+80 SET ^WV(790.1,DA,9,WVJCN,0)=$GET(^TMP("WV RADRPT",$JOB,WVJCN,0))
SET WVJCN1=WVJCN
End DoDot:1
+81 SET ^WV(790.1,DA,9,0)="^^"_WVJCN1_"^"_WVJCN1
+82 KILL ^TMP("WV RADRPT",$JOB),^TMP($JOB,"WV CH")
+83 QUIT
EX ; delete existing radiology report text stored in WH
+1 KILL ^WV(790.1,DA,9)
+2 QUIT
MAIL(DFN,WVACCESS,WVPROC,WVPROV) ; Send mail message to case manager when
+1 ; Radiology procedure is added to WH Procedure file (#790.1).
+2 ; Called from WVRALINK
+3 ; DFN -> Patient ien
+4 ; WVACCESS -> File 790.1 ien (procedure entry)
+5 ; WVPROC -> File 790.2 ien (procedure type)
+6 ; WVPROV -> File 200 IEN (provider/requestor)
+7 if '$GET(DFN)!('$GET(WVACCESS))!('$GET(WVPROC))
QUIT
+8 NEW WVCMGR,WVLOOP,WVMSG,XMDUZ,XMSUB,XMTEXT,XMY
+9 ;get case manager
SET WVCMGR=+$$GET1^DIQ(790,DFN,.1,"I")
+10 if WVCMGR
SET XMY(WVCMGR)=""
+11 ; if no case manager, then get default case manager(s)
+12 IF 'WVCMGR
SET WVLOOP=0
FOR
SET WVLOOP=$ORDER(^WV(790.02,WVLOOP))
if 'WVLOOP
QUIT
Begin DoDot:1
+13 SET WVCMGR=$$GET1^DIQ(790.02,WVLOOP,.02,"I")
+14 if WVCMGR
SET XMY(WVCMGR)=""
+15 QUIT
End DoDot:1
+16 ;no case manager(s)
if $ORDER(XMY(0))'>0
QUIT
+17 ;S:WVPROV XMY(WVPROV)=""
+18 ;message sender
SET XMDUZ=.5
+19 SET XMSUB="RAD/NM added a procedure for a WH patient"
+20 SET WVMSG(1)=" Patient: "_$PIECE($GET(^DPT(DFN,0)),U,1)_" (SSN: "_$$SSN^WVUTL1(DFN)_")"
+21 SET WVMSG(2)=" WH Accession #: "_$PIECE($GET(^WV(790.1,+WVACCESS,0)),U,1)
+22 SET WVMSG(3)=" Procedure: "_$PIECE($GET(^WV(790.2,+WVPROC,0)),U,1)
+23 SET WVMSG(4)=" "
+24 SET WVMSG(5)="Please use the 'Edit a Procedure' option in the WOMEN'S"
+25 SET WVMSG(6)="HEALTH package to complete/close this procedure."
+26 IF ($EXTRACT($PIECE(WVMSG(2),"#: ",2),1,2)="MB")!($EXTRACT($PIECE(WVMSG(2),"#: ",2),1,2)="MS")!($EXTRACT($PIECE(WVMSG(2),"#: ",2),1,2)="MU")
Begin DoDot:1
+27 SET WVMSG(5)="Please use CPRS to resolve the Clinical Reminder for this procedure and"
+28 SET WVMSG(6)="complete the result."
+29 QUIT
End DoDot:1
+30 SET XMTEXT="WVMSG("
+31 DO ^XMD
+32 QUIT
AMEND(WVRPTIEN) ; Check if RAD/NM report is amended.
+1 ; WVRPTIEN - File 74 ien
+2 NEW WVAMEND
+3 KILL ^TMP("DILIST",$JOB),^TMP("DIERR",$JOB)
+4 DO LIST^DIC(74.06,","_WVRPTIEN_",",.01)
+5 SET WVAMEND=$ORDER(^TMP("DILIST",$JOB,0))
+6 KILL ^TMP("DILIST",$JOB),^TMP("DIERR",$JOB)
+7 QUIT WVAMEND
+8 ;
COMPARE() ; Compares Clincal History fields in files 70 & 74
+1 ; Returns 1 (different) or 0 (same)
+2 NEW LOOP,WVFLAG,WV70CNT,WV70IEN,WV74CNT,WV74IEN,WVNODE70,WVNODE74
+3 SET (LOOP,WV70CNT,WV74CNT,WVFLAG)=0
+4 SET WV70IEN=WVIENS
SET WV74IEN=WVRPTIEN_","
+5 IF '$ORDER(^TMP($JOB,"WV CH",70.03,WV70IEN,400,0))
SET WVFLAG=WVFLAG+1
+6 IF '$ORDER(^TMP($JOB,"WV RADRPT",74,WV74IEN,400,0))
SET WVFLAG=WVFLAG+1
+7 ;different (field was purged in one file, exists in
IF WVFLAG=1
QUIT 1
+8 ; the other file)
+9 ;same (field was purged in 70 & 74)
IF WVFLAG=2
QUIT 0
+10 FOR
SET LOOP=$ORDER(^TMP($JOB,"WV CH",70.03,WV70IEN,400,LOOP))
if 'LOOP
QUIT
Begin DoDot:1
+11 SET WV70CNT=WV70CNT+1
+12 QUIT
End DoDot:1
+13 SET LOOP=0
+14 FOR
SET LOOP=$ORDER(^TMP($JOB,"WV RADRPT",74,WV74IEN,400,LOOP))
if 'LOOP
QUIT
Begin DoDot:1
+15 SET WV74CNT=WV74CNT+1
+16 QUIT
End DoDot:1
+17 ;line counts are different
IF WV70CNT'=WV74CNT
QUIT 1
+18 SET LOOP=0
+19 FOR
SET LOOP=$ORDER(^TMP($JOB,"WV CH",70.03,WV70IEN,400,LOOP))
if 'LOOP!(WVFLAG=1)
QUIT
Begin DoDot:1
+20 SET WVNODE70=$GET(^TMP($JOB,"WV CH",70.03,WV70IEN,400,LOOP,0))
+21 SET WVNODE74=$GET(^TMP($JOB,"WV RADRPT",74,WV74IEN,400,LOOP))
+22 IF WVNODE70'=WVNODE74
SET WVFLAG=1
+23 QUIT
End DoDot:1
+24 QUIT WVFLAG
+25 ;
