Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: GMRCSLM2

GMRCSLM2.m

Go to the documentation of this file. 
  1. GMRCSLM2 ;SLC/DCM,WAT - LM Detailed  display and printing ;05-Aug-2013 12:52;DU
  1.  ;;3.0;CONSULT/REQUEST TRACKING;**1,4,18,15,17,23,22,65,1003,1004**;DEC 27,1997;Build 12
  1.  ;
  1.  ; This routine invokes IA #872 ^ORD(101   #875 ORDER STATUS file point   #2467 $$OI^ORX8   #2638 ORDER STATUS file access
  1.  ;#2056 $$GET1^DIQ   #10104 XLFSTR   #4156 $$CVEDT^DGCV   #10117  ^VALM10   #2849 ORDERS file
  1.  ;#10040 HOSPITAL LOCATION file   #10060 NEW PERSON file
  1.  ;
  1.  ;Modified - IHS/MSC/PLS - 01/31/2012 - Line DT+21
  1.  ;
  1. DT(GMRCO,GMRCIERR) ;;Entry point to set-up detailed display.
  1.  ;;Pass in GMRCO as +GMRCO - a number only. GMRCO=IEN from of consult from file 123
  1.  ;;Results are placed in ^TMP("GMRCR",$J,"DT",
  1.  ;;Pass in variable GMRCOER=2 if calling from the GUI, GMRCOER=1 if call is from CPRS consults tab
  1.  ;;Pass in variable GMRCOER=0 (or as <UNDEFINED>) if call is from consults routines
  1.  K GMRCQUT
  1.  N DFN,GMRCD,GMRCDA,ORIFN,GMRCSF S GMRCDVDL="",$P(GMRCDVDL,"-",80)=""
  1.  I $S('GMRCO:1,'$D(^GMR(123,+GMRCO,0)):1,1:0) D:$S('$D(GMRCOER):1,'GMRCOER:1,1:0)  S GMRCQUT=1 Q
  1.  .S GMRCMSG="The consult entry selected for the Detailed Display is unknown." D EXAC^GMRCADC(GMRCMSG) K GMRCMSG
  1.  .Q
  1.  K ^TMP("GMRCR",$J,"DT") S TAB="",$P(TAB," ",30)="",GMRCCT=1
  1.  S GMRCO(0)=^GMR(123,+GMRCO,0),ORIFN=$P(GMRCO(0),"^",3),DFN=$P(GMRCO(0),"^",2)
  1.  S X="SDUTL3" X ^%ZOSF("TEST") I  D
  1.  .N PR S PR=$$OUTPTPR^SDUTL3(DFN) I $L(PR) S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Current PC Provider:   "_$P(PR,"^",2),GMRCCT=GMRCCT+1
  1.  .S PR=$$OUTPTTM^SDUTL3(DFN) I $L(PR) S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Current PC Team:       "_$P(PR,"^",2),GMRCCT=GMRCCT+1
  1.  .Q
  1.  N VAIN,VAEL,CVELIG
  1.  D INP^VADPT S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Current Pat. Status:   "_$S(+VAIN(8):"Inpatient",1:"Outpatient"),GMRCCT=GMRCCT+1
  1.  I $D(VAIN(4)),$L($P(VAIN(4),"^",2)) S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Ward:"_$E(TAB,1,18)_$P(VAIN(4),"^",2),GMRCCT=GMRCCT+1
  1.  D ELIG^VADPT
  1.  I $L($P(VAEL(1),"^",2)) S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Primary Eligibility:"_$E(TAB,1,11)_$P(VAEL(1),"^",2),GMRCCT=GMRCCT+1
  1.  ;IHS/MSC/PLS - S CVELIG=$$CVEDT^DGCV(DFN) S:$P($G(CVELIG),U,3) ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Combat Vet Eligible:"_$E(TAB,1,11)_"YES",GMRCCT=GMRCCT+1 ;WAT gmrc,65
  1.  S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="",GMRCCT=GMRCCT+1
  1.  S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Order Information",GMRCCT=GMRCCT+1
  1.  S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="To Service:"_$E(TAB,1,12)_$P($G(^GMR(123.5,+$P(GMRCO(0),"^",5),0)),"^"),GMRCCT=GMRCCT+1
  1.  I $P(GMRCO(0),"^",11) S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Attention:"_$E(TAB,1,13)_$$GET1^DIQ(200,$P($G(GMRCO(0)),"^",11),.01),GMRCCT=GMRCCT+1
  1.  S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="From Service:"_$E(TAB,1,10)_$P($G(^SC(+$P(GMRCO(0),"^",6),0)),"^"),GMRCCT=GMRCCT+1
  1.  S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Requesting Provider: "_$E(TAB,1,2)_$S($P(GMRCO(0),"^",14)]"":$$GET1^DIQ(200,$P($G(GMRCO(0)),"^",14),.01),1:""),GMRCCT=GMRCCT+1
  1.  I $L($P(GMRCO(0),"^",18)) D
  1.  .S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Service is to be rendered on an "_$S($P(GMRCO(0),"^",18)="I":"INPATIENT",1:"OUTPATIENT")_" basis",GMRCCT=GMRCCT+1
  1.  .Q
  1.  I $P(GMRCO(0),"^",10) S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Place:"_$E(TAB,1,17)_$P($G(^ORD(101,+$P(GMRCO(0),"^",10),0)),"^",2),GMRCCT=GMRCCT+1
  1.  S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Urgency:"_$E(TAB,1,15)_$S($L($P(GMRCO(0),"^",9)):$P($G(^ORD(101,+$P(GMRCO(0),"^",9),0)),"^",2),1:""),GMRCCT=GMRCCT+1
  1.  S X="ORX8" X ^%ZOSF("TEST") I  D
  1.  .N GMRCOITM S GMRCOITM=$$OI^ORX8(ORIFN)
  1.  .S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Orderable Item:"_$E(TAB,1,8)_$P(GMRCOITM,U,2),GMRCCT=GMRCCT+1
  1.  .Q
  1.  S GMRCPRNM=$P(GMRCO(0),"^",8),GMRCPROC=$S(+GMRCPRNM:$P($G(^GMR(123.3,+GMRCPRNM,0)),"^"),1:"Consult Request")
  1.  I $L(GMRCPROC) D
  1.  .N GMRCLN
  1.  .S GMRCTYPE=$S($P(GMRCO(0),U,17)="P":"Procedure",1:"Consult")
  1.  .S GMRCLN=GMRCTYPE_":"_$E(TAB,1,22-$L(GMRCTYPE))_GMRCPROC
  1.  .S ^TMP("GMRCR",$J,"DT",GMRCCT,0)=GMRCLN
  1.  .S GMRCCT=GMRCCT+1
  1.  .I $G(^GMR(123,+GMRCO,1)) D
  1.  .. S GMRCLN=""
  1.  .. S GMRCLN="Clinical Procedure:"_$E(TAB,1,4)
  1.  .. S GMRCLN=GMRCLN_$$GET1^DIQ(123,+GMRCO,1.01,"E")
  1.  .. S ^TMP("GMRCR",$J,"DT",GMRCCT,0)=GMRCLN
  1.  .. S GMRCCT=GMRCCT+1
  1.  .Q
  1.  S GMRCD=$G(^GMR(123,+GMRCO,30)) I $L(GMRCD) D
  1.  . I $L(GMRCD)>54 D
  1.  .. N SEG,I S I=2
  1.  .. F  S SEG=$P(GMRCD," ",1,I) Q:$L(SEG)>54  S I=I+1
  1.  .. S SEG=$P(GMRCD," ",1,(I-1))
  1.  .. S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Provisional Diagnosis: "_SEG
  1.  .. S GMRCCT=GMRCCT+1
  1.  .. S SEG=$$REPEAT^XLFSTR(" ",22)_$E(GMRCD,$L(SEG)+1,80)
  1.  .. S ^TMP("GMRCR",$J,"DT",GMRCCT,0)=SEG S GMRCD=""
  1.  .. S GMRCCT=GMRCCT+1
  1.  I GMRCD'="" D
  1.  . S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Provisional Diagnosis: "_GMRCD
  1.  . S GMRCCT=GMRCCT+1
  1.  I $D(^GMR(123,+GMRCO,20,0)) D
  1.  .I $O(^GMR(123,+GMRCO,20,0)) S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Reason For Request:",GMRCCT=GMRCCT+1 D  Q
  1.  .. S LN=0
  1.  .. F  S LN=$O(^GMR(123,+GMRCO,20,LN)) Q:LN=""  D
  1.  ... S ^TMP("GMRCR",$J,"DT",GMRCCT,0)=^GMR(123,+GMRCO,20,LN,0)
  1.  ... I $G(GMRCIERR) D
  1.  .... N TXT S TXT=^TMP("GMRCR",$J,"DT",GMRCCT,0)_"..."
  1.  .... S ^TMP("GMRCR",$J,"DT",GMRCCT,0)=TXT
  1.  .... S LN=9999 ;quit with just one line
  1.  ... S GMRCCT=GMRCCT+1
  1.  .. Q
  1.  . Q
  1.  S ^TMP("GMRCR",$J,"DT",GMRCCT,0)=" ",GMRCCT=GMRCCT+1
  1.  N TXT,SNOTXT,SNO,PROB,PROBTXT,PROBIEN
  1.  S (SNOTXT,PROBTXT)=""
  1.  ;IHS/MSC/MGH Patch 1004
  1.  I $D(^GMR(123,+GMRCO,9999999)) D
  1.  .S SNO=$P($G(^GMR(123,+GMRCO,9999999)),U,1)
  1.  .S PROBIEN=$P($G(^GMR(123,+GMRCO,9999999)),U,2)
  1.  .I SNO'="" D
  1.  ..S SNOTXT=$$CONC^BSTSAPI(SNO_"^30^^1")
  1.  ..S TXT="Snomed: "_$P(SNOTXT,U,4)_" ("_SNO_")"
  1.  ..S ^TMP("GMRCR",$J,"DT",GMRCCT,0)=TXT,GMRCCT=GMRCCT+1
  1.  .I PROBIEN'="" D
  1.  ..S PROB=$$GET1^DIQ(9000011,PROBIEN,80002)
  1.  ..S PROBTXT=$$GET1^DIQ(9000011,PROBIEN,.05)
  1.  ..S TXT="Associated Problem: "_PROBTXT_" ("_PROB_")"
  1.  ..S ^TMP("GMRCR",$J,"DT",GMRCCT,0)=TXT,GMRCCT=GMRCCT+1
  1.  ;end mods patch 1004
  1.  ; get inter-facility consult info
  1.  S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Inter-facility Information",GMRCCT=GMRCCT+1
  1.  I '$P(GMRCO(0),"^",23) D
  1.  . S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="This is not an inter-facility consult request.",GMRCCT=GMRCCT+1
  1.  E  D
  1.  . S ^TMP("GMRCR",$J,"DT",GMRCCT,0)=$$REPEAT^XLFSTR("-",27)
  1.  . S GMRCCT=GMRCCT+1
  1.  . N GMRCOP
  1.  . S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Remote Facility:"_$E(TAB,1,6)_$P($G(^DIC(4,+$P(GMRCO(0),"^",23),0)),"^"),GMRCCT=GMRCCT+1
  1.  . S GMRCO(12)=$G(^GMR(123,+GMRCO,12))
  1.  . I $L($P(GMRCO(12),U,6)) D
  1.  .. S GMRCOP=$P(GMRCO(12),U,6)
  1.  . I '$D(GMRCOP) S GMRCOP=$$GET1^DIQ(200,+$P(GMRCO(0),U,14),.01)
  1.  . S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Ordering Provider:"_$E(TAB,1,5)_GMRCOP,GMRCCT=GMRCCT+1
  1.  . S GMRCO(13)=$G(^GMR(123,+GMRCO,13)) I $L($P(GMRCO(13),U,2,3))>1 D
  1.  .. N LINE
  1.  .. S LINE=$P(GMRCO(13),U,2) I $L(LINE) S LINE=LINE_$E(TAB,1,5) D
  1.  ... S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Ordering Provider phone: "_LINE
  1.  ... S GMRCCT=GMRCCT+1
  1.  .. S LINE=$P(GMRCO(13),U,3) I $L(LINE) S LINE=LINE_$E(TAB,1,5) D
  1.  ... S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Ordering Provider pager: "_LINE
  1.  ... S GMRCCT=GMRCCT+1
  1.  . S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Remote Consult #"_$E(TAB)_$P(GMRCO(0),"^",22),GMRCCT=GMRCCT+1
  1.  . I $L($P(GMRCO(13),U)) S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Remote Service name: "_$E(TAB)_$P(GMRCO(13),U),GMRCCT=GMRCCT+1
  1.  . S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Role: "_$E(TAB,1,10)_$S($P(GMRCO(12),U,5)="P":"Requesting facility",1:"Consulting facility"),GMRCCT=GMRCCT+1
  1.  S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="",GMRCCT=GMRCCT+1
  1.  ;get status, last action, and significant findings
  1.  S STS=$P(GMRCO(0),"^",12),^TMP("GMRCR",$J,"DT",GMRCCT,0)="Status:  "_$E(TAB,1,14)_$S($D(^ORD(100.01,+STS,0)):$P(^(0),"^",1),1:$P(^ORD(100.01,6,0),"^",1)),GMRCCT=GMRCCT+1
  1.  S GMRCA=$P(^GMR(123,+GMRCO,0),"^",13),^TMP("GMRCR",$J,"DT",GMRCCT,0)="Last Action:"_$E(TAB,1,11)_$S(+GMRCA:$P($G(^GMR(123.1,GMRCA,0)),"^",1),1:""),GMRCCT=GMRCCT+1
  1.  I $L($P(GMRCO(0),"^",19)) D
  1.  .S GMRCSF=$P(GMRCO(0),"^",19)
  1.  .S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Significant Findings:  "_$S(GMRCSF="Y":"YES",GMRCSF="N":"NO",1:"Unknown")
  1.  .S GMRCCT=GMRCCT+1
  1.  .Q
  1.  ;IHS/MSC/MGH SNOMEDS added for MU stage 2
  1.  N I,CLOSED,IN,OUT,ARR,BY,WHEN,X,TXT,AIEN
  1.  I $D(^GMR(123,+GMRCO,9999999.11,0)) D
  1.  .S I=0 F  S I=$O(^GMR(123,+GMRCO,9999999.11,I)) Q:I=""  D
  1.  ..S AIEN=I_","_+GMRCO_","
  1.  ..S CLOSED=$$GET1^DIQ(123.999999911,AIEN,.01)
  1.  ..S BY=$$GET1^DIQ(123.999999911,AIEN,1)
  1.  ..S WHEN=$$GET1^DIQ(123.999999911,AIEN,2)
  1.  ..S IN=CLOSED_"^30^^1"
  1.  ..S OUT="ARR"
  1.  ..S X=$$CNCLKP^BSTSAPI(.OUT,.IN)
  1.  ..I X>0 D
  1.  ...S TXT=@OUT@(1,"PRE","TRM")
  1.  ...S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="  Closed Action: "_TXT_" ("_CLOSED_")",GMRCCT=GMRCCT+1
  1.  ...S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="  On: "_WHEN_" By: "_BY,GMRCCT=GMRCCT+1
  1.  I $G(GMRCIERR) Q  ;don't need results or activities on IFC errors
  1.  D ACTLOG^GMRCSLM4(+GMRCO)
  1.  ; any inter-facility results?
  1.  I $P(GMRCO(0),"^",23) D
  1.  . N GMRCIFRS,X S GMRCIFRS=0,X=""
  1.  . F  S X=$O(^GMR(123,GMRCO,51,"B",X)) Q:X=""  S GMRCIFRS=GMRCIFRS+1
  1.  . S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="",GMRCCT=GMRCCT+1
  1.  . S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="Inter-facility Results: "_$S(GMRCIFRS>0:"Results are available via Display Results action.",1:"No results available for this consult request."),GMRCCT=GMRCCT+2
  1.  ;get local results
  1.  D GETRSLT^GMRCART($NA(^TMP("GMRCRT",$J)),1)
  1.  N NXT S NXT=0
  1.  F  S NXT=$O(^TMP("GMRCRT",$J,NXT)) Q:'NXT  D
  1.  . S ^TMP("GMRCR",$J,"DT",GMRCCT,0)=$G(^TMP("GMRCRT",$J,NXT,0))
  1.  . S GMRCCT=GMRCCT+1
  1.  . Q
  1.  K ^TMP("GMRCRT",$J)
  1.  I $S('$D(GMRCOER):1,'GMRCOER:1,1:0),$D(VALMAR) D CLEAN^VALM10
  1.  S ^TMP("GMRCR",$J,"DT",GMRCCT,0)="",$P(^(0),"=",80)="",^(0)=$E(^(0),1,36)_" END "_$E(^(0),43,80)
  1. DTQ K X,LN,PL,TO,WP,FLG,SEX,STS,URG,WRD,BKLN,DATA,WRD,PROC,LINE,GMRC(0),GMRC(40),GMRCD,GMRCDVDL,GMRCO,GMRCAR,GMRCRB,GMRCLA,GMRCSR,GMRCTO,MCFILE,MCPROC,DSPLINE,GMRCLA1,GMRCPRNM,GMRCPROC,GMRCTYPE,GMRCWARD
  1.  I $D(GMRCOER),'GMRCOER D:$D(VALMEVL) KILL^VALM10() D:$D(VALMAR) CLEAN^VALM10
  1.  Q