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