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

CRHDUT.m

Go to the documentation of this file. 
  1. CRHDUT ; CAIRO/CLC - GET THE PATIENT DATA ELEMENTS FOR HANDOFF LIST ;5/13/08  05:19
  1.  ;;1.0;CRHD;****;Jan 28, 2008;Build 19
  1.  ;=================================================================
  1. ALG(CRHDRTN0,CRHDSTR) ; Allergies
  1.  N CRHDTNUM
  1.  S CRHDTRG="CRHDRTN0"
  1.  S DFN=+CRHDSTR
  1.  S CRHDNUM=$P(CRHDSTR,U,2)
  1.  S CRHDHDR=$P(CRHDSTR,U,3)
  1.  K @CRHDTRG,CRHDRTN
  1.  N CRHDX
  1.  S CRHDNUM=CRHDNUM+1,CRHDTNUM=CRHDNUM
  1.  S CRHDNUM=$G(CRHDNUM)+1
  1.  S:$G(CRHDHDR) @CRHDTRG@(CRHDNUM)="Allergies: "
  1.  D LIST^ORQQAL(.CRHDRTN,DFN)
  1.  S CRHDX=0
  1.  F  S CRHDX=$O(CRHDRTN(CRHDX)) Q:'CRHDX  D
  1.  .S @CRHDTRG@(CRHDNUM)=$G(@CRHDTRG@(CRHDNUM))_$$SPACE($G(@CRHDTRG@(CRHDNUM)),$S($G(CRHDHDR):12,1:1))_$P(CRHDRTN(CRHDX),"^",2)
  1.  . S CRHDNUM=CRHDNUM+1
  1.  S @CRHDTRG@(CRHDTNUM)=CRHDNUM-1
  1.  Q
  1. ACTMED(CRHDRTN,CRHDSTR) ;Active Medications
  1.  ;CRHDRTN: Target array
  1.  ;CRHDCAT: I-Inpatient Meds
  1.  ;         O-Outpatient Meds
  1.  ;         B-Both
  1.  ;CRHDIV:  0 - Do not include IV
  1.  ;         1 - include IV
  1.  ;CRHDNUM: next number in results array
  1.  ;CRHDHDR: include section heading
  1.  ;CRHDDET: details, 1-include the sig, 0-exclude sig
  1.  ;CRHDLEN: length to return in chars. Defaults to 16 chars.
  1.  N CRHDUD,CRHDV,CRHDX2,CRHDC,CRHDMEDS,CRHDRN,DFN,CRHDCAT,CRHDI,CRHDN,CRHDP1,CRHDP2
  1.  N CRHDIV,CRHDNUM,CRHDHDR,CRHDDET,CRHDFG,CRHDLEN,CRHDTNUM,CRHDMCTR,CRHDTX
  1.  S DFN=+CRHDSTR
  1.  S CRHDCAT=$P(CRHDSTR,U,2)
  1.  I CRHDCAT="" S CRHDCAT="I"
  1.  S CRHDIV=$P(CRHDSTR,U,3)
  1.  S CRHDNUM=$P(CRHDSTR,U,4)
  1.  S CRHDHDR=$P(CRHDSTR,U,5)
  1.  S CRHDDET=$P(CRHDSTR,U,6)
  1.  S CRHDLEN=$P(CRHDSTR,U,7)
  1.  I 'CRHDLEN S CRHDLEN=16
  1.  S CRHDTRG="CRHDRTN"
  1.  K @CRHDTRG
  1.  S CRHDMCTR=0
  1.  S CRHDNUM=CRHDNUM+1,CRHDTNUM=CRHDNUM
  1.  S CRHDNUM=$G(CRHDNUM)+1
  1.  S:$G(CRHDHDR) @CRHDTRG@(CRHDNUM)="Meds: "
  1.  I CRHDCAT="O"!('CRHDDET) D NODETAM^CRHD2(.CRHDMEDS,DFN,CRHDCAT),NDOUT S @CRHDTRG@(CRHDTNUM)=CRHDNUM-1 Q
  1.  I CRHDDET S CRHDX=$$PSGI^CRHDAM(.CRHDMEDS,DFN) D DOUT
  1.  S @CRHDTRG@(CRHDTNUM)=CRHDNUM-1
  1.  Q
  1. NDOUT ;no details output
  1.  S CRHDP2=" S CRHDN="""""_" F  S CRHDN=$O(CRHDMEDS(CRHDI,CRHDN)) Q:'CRHDN  D AOUTPUT"
  1.  I CRHDCAT="I" D
  1.  .S CRHDP1="F CRHDI=""U"""
  1.  .I CRHDIV S CRHDP1=CRHDP1_","_"""V"""
  1.  I CRHDCAT="O" D
  1.  .S CRHDP1="F CRHDI=""N"""_","_"""R"""
  1.  S CRHDP1=CRHDP1_CRHDP2
  1.  X CRHDP1
  1.  Q
  1. AOUTPUT ;
  1.  S CRHDNUM=CRHDNUM+1
  1.  ;I HDR S @TRG@(CRHDNUM)="Medications",NUM=NUM+1,HDR=0
  1.  ;S @CRHDTRG@(CRHDNUM)=$E($G(CRHDMEDS(CRHDI,CRHDN)),1,CRHDLEN)
  1.  S CRHDMCTR=CRHDMCTR+1,@CRHDTRG@(CRHDNUM)=CRHDMCTR_"."_$E($G(CRHDMEDS(CRHDI,CRHDN)),1,CRHDLEN)
  1.  Q
  1. DOUT ;
  1.  S (CRHDX2,CRHDFG,CRHDMCTR)=0
  1.  F  S CRHDX2=$O(CRHDMEDS(CRHDX2)) Q:'CRHDX2!(CRHDFG)  D
  1.  .S CRHDTX=""
  1.  .S CRHDC=$P(CRHDMEDS(CRHDX2),"^",2)
  1.  .Q:CRHDC=""
  1.  .I CRHDHDR S CRHDNUM=CRHDNUM+1,@CRHDTRG@(CRHDNUM)="Inpatient Meds: ",CRHDNUM=CRHDNUM+1,CRHDHDR=0
  1. IV .I 'CRHDIV&(CRHDC["IV DOSE") S CRHDFG=1 Q
  1.  .I CRHDDET D
  1.  ..I (CRHDC["=UNIT DOSE=")!(CRHDC["=IV DOSE=") S @CRHDTRG@(CRHDNUM)=$E(CRHDC,1,CRHDLEN)
  1.  ..E  S CRHDMCTR=CRHDMCTR+1,@CRHDTRG@(CRHDNUM)=CRHDMCTR_"."_$E(CRHDC,1,CRHDLEN)
  1.  .I 'CRHDDET S @CRHDTRG@(CRHDNUM)=$E(CRHDC,1,CRHDLEN)
  1.  .S CRHDNUM=CRHDNUM+1
  1.  Q
  1. CONSULT(CRHDRTN,CRHDSTR) ;consults orders - call from cprs
  1.  ;DFN,FILTERS,GROUPS,DTFROM,DTTHRU,EVENT
  1.  N CRHDY,CRHDILST,ORYD,CRHDLST,X,D1,CRHDATE,CRHDGRP
  1.  N CRHDLEN,CHRDHDR,CRHDSTS,CRHDILST,DFN
  1.  S DFN=+CRHDSTR
  1.  S CRHDSTS=$P(CRHDSTR,U,2)
  1.  S CRHDNUM=$P(CRHDSTR,U,3)
  1.  S CRHDHDR=$P(CRHDSTR,U,4)
  1.  S CRHDLEN=$P(CRHDSTR,U,5)
  1.  I 'CRHDLEN S CRHDLEN=20
  1.  S CRHDTRG="CRHDRTN"
  1.  K @CRHDTRG
  1.  S CRHDGRP=$O(^ORD(100.98,"B","CONSULTS",0))
  1.  ;D AGET^ORWORR(.CRHDY,DFN,"2^0",11,0,0,"")
  1.  D AGET^ORWORR(.CRHDY,DFN,"2^0",CRHDGRP,0,0,"")
  1.  M CRHDILST=@CRHDY
  1.  K CRHDILST(.1)
  1.  D DETORD("CRHDRTN",.CRHDLST,.CRHDILST,"",CRHDLEN)
  1.  Q
  1. IMAGING(CRHDRTN,CRHDSTR) ;Radiology orders - call from cprs
  1.  ;DFN,FILTERS,CRHDGRPS,DTFROM,DTTHRU,EVENT
  1.  N CRHDY,CRHDILST,ORYD,CRHDLST,X,CRHDLEN
  1.  N D1,CRHDATE,DFN,CRHDSTS,CRHDNUM,CRHDHDR,CRHDTRG,CRHDGRP
  1.  S DFN=+CRHDSTR
  1.  S CRHDSTS=$P(CRHDSTR,U,2)
  1.  S CRHDNUM=$P(CRHDSTR,U,3)
  1.  S CRHDHDR=$P(CRHDSTR,U,4)
  1.  S CRHDLEN=$P(CRHDSTR,U,5)
  1.  I 'CRHDLEN S CRHDLEN=20
  1.  S CRHDTRG="CRHDRTN"
  1.  K @CRHDTRG
  1.  S CRHDGRP=$O(^ORD(100.98,"B","IMAGING",0))
  1.  ;D AGET^ORWORR(.CRHDY,DFN,"2^0",34,0,0,"")
  1.  D AGET^ORWORR(.CRHDY,DFN,"2^0",CRHDGRP,0,0,"")
  1.  M CRHDILST=@CRHDY
  1.  K CRHDILST(.1)
  1.  D DETORD(.CRHDTRG,.CRHDLST,.CRHDILST,"",CRHDLEN)
  1.  Q
  1. LABS(CRHDRTN,CRHDSTR) ;LABS orders - call from cprs
  1.  ;DFN,FILTERS,CRHDGRPS,DTFROM,DTTHRU,EVENT
  1.  N CRHDY,CRHDILST,ORYD,CRHDLST,X,D1,CRHDATE
  1.  N DFN,CRHDSTS,CRHDNUM,CRHDHDR,CRHDLEN,CRHDTRG
  1.  S DFN=+CRHDSTR
  1.  S CRHDSTS=$P(CRHDSTR,U,2)
  1.  S CRHDNUM=$P(CRHDSTR,U,3)
  1.  S CRHDHDR=$P(CRHDSTR,U,4)
  1.  S CRHDLEN=$P(CRHDSTR,U,5)
  1.  I 'CRHDLEN S CRHDLEN=20
  1.  S CRHDTRG="CRHDRTN"
  1.  K @CRHDTRG
  1.  S CRHDGRP=$O(^ORD(100.98,"B","LABORATORY",0))
  1.  ;D AGET^ORWORR(.CRHDY,DFN,"2^0",5,0,0,"")
  1.  D AGET^ORWORR(.CRHDY,DFN,"2^0",CRHDGRP,0,0,"")
  1.  M CRHDILST=@CRHDY
  1.  K CRHDILST(.1)
  1.  D DETORD(.CRHDTRG,.CRHDLST,.CRHDILST,"",CRHDLEN)
  1.  Q
  1. PROC(CRHDRTN,CRHDSTR) ;,DFN,CRHDSTS,CRHDNUM,CRHDHDR) ;Procedures orders - call from cprs
  1.  ;DFN,FILTERS,CRHDGRPS,DTFROM,DTTHRU,EVENT
  1.  N CRHDY,CRHDILST,ORYD,CRHDLST,X,D1,CRHDATE
  1.  N DFN,CRHDSTS,CRHDNUM,CRHDHDR,CRHDGRP,CRHDLEN,CRHDTRG
  1.  S DFN=+CRHDSTR
  1.  S CRHDSTS=$P(CRHDSTR,U,2)
  1.  S CRHDNUM=$P(CRHDSTR,U,3)
  1.  S CRHDHDR=$P(CRHDSTR,U,4)
  1.  S CRHDLEN=$P(CRHDSTR,U,5)
  1.  I 'CRHDLEN S CRHDLEN=20
  1.  S CRHDTRG="CRHDRTN"
  1.  K @CRHDTRG
  1.  S CRHDGRP=$O(^ORD(100.98,"B","PROCEDURES",0))
  1.  ;D AGET^ORWORR(.CRHDY,DFN,"2^0",43,0,0,"")
  1.  D AGET^ORWORR(.CRHDY,DFN,"2^0",CRHDGRP,0,0,"")
  1.  M CRHDILST=@CRHDY
  1.  K CRHDILST(.1)
  1.  D DETORD(.CRHDTRG,.CRHDLST,.CRHDILST,"",CRHDLEN)
  1.  Q
  1. DETORD(CRHDTRG,CRHDRLST,CRHDILST,CRHDHEAD,CRHDLEN) ;
  1.  N ORYD,CRHDSTS,CRHDD1,CRHDATE,CRHDX
  1.  S ORYD=""
  1.  D GET4LST^ORWORR(.CRHDRLST,.CRHDILST)
  1.  S:$G(CRHDHDR) @CRHDTRG@(CRHDNUM,0)=CRHDHEAD_": "
  1.  S CRHDX=""
  1.  F  S CRHDX=$O(CRHDLST(CRHDX)) Q:'CRHDX  D
  1.  . S CRHDD1=$P(CRHDLST(CRHDX),"^",3)
  1.  . I $E(CRHDLST(CRHDX),1)="~" D
  1.  . .S CRHDD1=$P(CRHDLST(CRHDX),"^",3)
  1.  . .S CRHDSTS=$P(CRHDLST(CRHDX),"^",10)
  1.  . .S CRHDATE=$$FMTE^XLFDT(CRHDD1,2)
  1.  . .S @CRHDTRG@(CRHDNUM)=$G(@CRHDTRG@(CRHDNUM))_$$SPACE($G(@CRHDTRG@(CRHDNUM)),$S($G(CRHDHDR):16,1:1))_$P(CRHDATE,"@",1)
  1.  . I $E(CRHDLST(CRHDX),1)="t" D
  1.  . .S @CRHDTRG@(CRHDNUM)=$G(@CRHDTRG@(CRHDNUM))_$$SPACE($G(@CRHDTRG@(CRHDNUM)),$S($G(CRHDHDR):16,1:1))_" "_$E(CRHDLST(CRHDX),2,$L(CRHDLST(CRHDX)))_" ("_$P($G(^ORD(100.01,+CRHDSTS,0)),"^",1)_")"
  1.  . .S @CRHDTRG@(CRHDNUM)=$E(@CRHDTRG@(CRHDNUM),1,CRHDLEN),CRHDNUM=CRHDNUM+1
  1.  Q
  1. PROB(CRHDRTNA,CRHDSTR) ;DFN,NUM,CRHDHDR) ;
  1.  ;Target array ^TMP("CRHD_PROB_DATA",$J)
  1.  N CRHDRTN,X,DFN,CRHDNUM,CRHDHDR,CRHDTRG
  1.  S DFN=+CRHDSTR
  1.  S CRHDNUM=$P(CRHDSTR,U,2)
  1.  S CRHDHDR=$P(CRHDSTR,U,3)
  1.  S CRHDTRG="^TMP(""CRHD_PROB_DATA"",$J)"
  1.  K @CRHDTRG
  1.  S CRHDNUM=$G(CRHDNUM)+1
  1.  S:$G(CRHDHDR) @CRHDTRG@(CRHDNUM,0)="Problem List: "
  1.  D LIST^ORQQPL(.CRHDRTN,DFN,"A")
  1.  S CRHDX=0
  1.  F  S CRHDX=$O(CRHDRTN(CRHDX)) Q:'CRHDX  D
  1.  . S @CRHDTRG@(CRHDNUM)=$G(@CRHDTRG@(CRHDNUM))_$$SPACE($G(@CRHDTRG@(CRHDNUM)),$S($G(CRHDHDR):15,1:1))_$P(CRHDRTN(X),"^",2)
  1.  . S CRHDNUM=CRHDNUM+1
  1.  ;S @CRHDTRG@(CRHDNUM)=""
  1.  Q
  1. RECNTLAB(CRHDROOT,DFN,CRHDNUM,CRHDHDR) ;
  1.  ;(CRHDY,DFN,CRHDATE1,DIR,FORMAT)
  1.  D INTERIMG^ORWLRR(.CRHDY,DFN,$$DT^XLFDT_".2359",1,"")
  1.  Q
  1. SPACE(CRHDX1,CRHDX) ;
  1.  N CRHDY,CRHDY1
  1.  S CRHDY1="",CRHDY=CRHDX-$L(CRHDX1)
  1.  S $P(CRHDY1," ",CRHDY)=""
  1.  Q CRHDY1
  1. PARAM(CRHDW,CRHDX) ;
  1.  Q $$GET^XPAR(CRHDW,CRHDX,1,"I")
  1.  ;
  1. PTSTS(DFN) ;Display current patient status
  1.  N CRHDGPMV,NOW,NOWI,X,Y,%,%H,%I,CRHDA,E,CRHDDGX,VAIP,VAX,VAZ,VAZ2
  1.  D NOW^%DTC S (VAX("DAT"),NOW)=%,NOWI=9999999.999999-%
  1.  D LAST^VADPT3
  1.  S CRHDGPMV(1)=$S($D(VAIP("E")):VAIP("E"),1:E) ;use ifn of last mvt from VADPT cal
  1.  S CRHDDGX=$G(^DGPM(+CRHDGPMV(1),0)),CRHDGPMV(2)=$P(CRHDDGX,"^",2),CRHDGPMV(4)=$P(CRHDDGX,"^",18)
  1.  S CRHDA=$S("^3^5^"[("^"_+CRHDGPMV(2)_"^"):0,1:+CRHDGPMV(2))
  1.  Q $S('CRHDA:"IN",1:"")_"ACTIVE "_$S("^4^5^"[("^"_+CRHDGPMV(2)_"^"):"LODGER",1:"INPATIENT")
  1. DNRPARM(CRHDNRTT,DUZ,CRHDDIV) ;GET DNR TITLES
  1.  N CRHDPAR,CRHDSRV,CRHDTEAM
  1.  S CRHDTEAM=$$GET^XPAR("USR.`"_DUZ,"ORLP DEFAULT TEAM",1,"I")
  1.  S CRHDSRV=$$GET1^DIQ(200,DUZ_",",29,"E")
  1.  S CRHDPAR="USR.`"_DUZ
  1.  D GETLST^XPAR(.CRHDNRTT,CRHDPAR,"CRHD DNR ORDER TITLE")
  1.  I ('CRHDNRTT)&($G(CRHDTEAM)>0) S CRHDPAR="OTL.`"_+CRHDTEAM D GETLST^XPAR(.CRHDNRTT,CRHDPAR,"CRHD DNR ORDER TITLE")
  1.  I ('CRHDNRTT)&($G(CRHDSRV)'="") S CRHDPAR="SRV."_CRHDSRV D GETLST^XPAR(.CRHDNRTT,CRHDPAR,"CRHD DNR ORDER TITLE")
  1.  I '+$G(CRHDDIV) S CRHDDIV=+$$SITE^VASITE
  1.  I 'CRHDNRTT S CRHDPAR="DIV.`"_+CRHDDIV  D GETLST^XPAR(.CRHDNRTT,CRHDPAR,"CRHD DNR ORDER TITLE")
  1.  Q