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

ORY10509.m

Go to the documentation of this file.
  1. ORY10509 ;SLC/RJS,CLA - OCX PACKAGE RULE TRANSPORT ROUTINE (Delete after Install of OR*3*105) ;OCT 16,2001 at 15:39
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**105**;Dec 17,1997
  1. ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
  1. ;
  1. S ;
  1. ;
  1. D DOT^ORY105ES
  1. ;
  1. ;
  1. K REMOTE,LOCAL,OPCODE,REF
  1. F LINE=1:1:500 S TEXT=$P($T(DATA+LINE),";",2,999) Q:TEXT I $L(TEXT) D Q:QUIT
  1. .S ^TMP("OCXRULE",$J,$O(^TMP("OCXRULE",$J,"A"),-1)+1)=TEXT
  1. ;
  1. G ^ORY1050A
  1. ;
  1. Q
  1. ;
  1. DATA ;
  1. ;
  1. ;;R^"860.8:",100,71
  1. ;;D^ ; ;
  1. ;;R^"860.8:",100,72
  1. ;;D^ ; Q
  1. ;;R^"860.8:",100,73
  1. ;;D^ ; ;
  1. ;;R^"860.8:",100,74
  1. ;;D^ ; ;
  1. ;;EOR^
  1. ;;KEY^860.8:^PATIENT LOCATION
  1. ;;R^"860.8:",.01,"E"
  1. ;;D^PATIENT LOCATION
  1. ;;R^"860.8:",.02,"E"
  1. ;;D^PATLOC
  1. ;;R^"860.8:",1,1
  1. ;;D^Returns the Inpatient or Outpatient location for the patient.
  1. ;;R^"860.8:",1,2
  1. ;;D^
  1. ;;R^"860.8:",1,3
  1. ;;D^ Input: DFN
  1. ;;R^"860.8:",1,4
  1. ;;D^ Output: Patient Status (I/O) Inpatient/Outpatient
  1. ;;R^"860.8:",1,5
  1. ;;D^ Patient Location (Free text name)
  1. ;;R^"860.8:",100,1
  1. ;;D^ ;PATLOC(DFN) ;
  1. ;;R^"860.8:",100,2
  1. ;;D^ ; ;
  1. ;;R^"860.8:",100,3
  1. ;;D^ ; N OCXP1,OCXP2
  1. ;;R^"860.8:",100,4
  1. ;;D^ ; S OCXP1=$G(^TMP("OCXSWAP",$J,"OCXODATA","PV1",2))
  1. ;;R^"860.8:",100,5
  1. ;;D^ ; S OCXP2=$P($G(^TMP("OCXSWAP",$J,"OCXODATA","PV1",3)),"^",1)
  1. ;;R^"860.8:",100,6
  1. ;;D^T+; W:$G(OCXTRACE) !,"OCXP2: ",$G(OCXP1)
  1. ;;R^"860.8:",100,7
  1. ;;D^T+; W:$G(OCXTRACE) !,"OCXP2: ",$G(OCXP2)
  1. ;;R^"860.8:",100,8
  1. ;;D^ ; I OCXP2 D
  1. ;;R^"860.8:",100,9
  1. ;;D^ ; .S OCXP2=$P($G(^SC(+OCXP2,0)),"^",1,2)
  1. ;;R^"860.8:",100,10
  1. ;;D^ ; .I $L($P(OCXP2,"^",2)) S OCXP2=$P(OCXP2,"^",2)
  1. ;;R^"860.8:",100,11
  1. ;;D^ ; .E S OCXP2=$P(OCXP2,"^",1)
  1. ;;R^"860.8:",100,12
  1. ;;D^ ; .S:'$L(OCXP2) OCXP2="NO LOC"
  1. ;;R^"860.8:",100,13
  1. ;;D^ ; I $L(OCXP1),$L(OCXP2) Q OCXP1_"^"_OCXP2
  1. ;;R^"860.8:",100,14
  1. ;;D^ ; ;
  1. ;;R^"860.8:",100,15
  1. ;;D^ ; S OCXP2=$G(^DPT(+$G(DFN),.1))
  1. ;;R^"860.8:",100,16
  1. ;;D^ ; I $L(OCXP2) Q "I^"_OCXP2
  1. ;;R^"860.8:",100,17
  1. ;;D^ ; Q "O^OUTPT"
  1. ;;R^"860.8:",100,18
  1. ;;D^ ; ;
  1. ;;EOR^
  1. ;;KEY^860.8:^RECENT CREATININE LAB PROCEDURE
  1. ;;R^"860.8:",.01,"E"
  1. ;;D^RECENT CREATININE LAB PROCEDURE
  1. ;;R^"860.8:",.02,"E"
  1. ;;D^RECCREAT
  1. ;;R^"860.8:",100,1
  1. ;;D^ ;RECCREAT(ORDFN,ORDAYS) ;extrinsic function to return most recent
  1. ;;R^"860.8:",100,2
  1. ;;D^ ; ;SERUM CREATININE within <ORDAYS> in format:
  1. ;;R^"860.8:",100,3
  1. ;;D^ ; ; test id^result units flag ref range collection d/t
  1. ;;R^"860.8:",100,4
  1. ;;D^ ; N BDT,CDT,ORY,ORX,ORZ,X,TEST,ORI,ORJ,CREARSLT,LABFILE,SPECFILE
  1. ;;R^"860.8:",100,5
  1. ;;D^ ; Q:'$L($G(ORDFN)) "0^"
  1. ;;R^"860.8:",100,6
  1. ;;D^ ; Q:'$L($G(ORDAYS)) "0^"
  1. ;;R^"860.8:",100,7
  1. ;;D^ ; D NOW^%DTC
  1. ;;R^"860.8:",100,8
  1. ;;D^ ; S BDT=$$FMADD^XLFDT(%,"-"_ORDAYS,"","","")
  1. ;;R^"860.8:",100,9
  1. ;;D^ ; K %
  1. ;;R^"860.8:",100,10
  1. ;;D^ ; Q:'$L($G(BDT)) "0^"
  1. ;;R^"860.8:",100,11
  1. ;;D^ ; S LABFILE=$$TERMLKUP("SERUM CREATININE",.ORY)
  1. ;;R^"860.8:",100,12
  1. ;;D^ ; Q:$G(LABFILE)'=60 "0^"
  1. ;;R^"860.8:",100,13
  1. ;;D^ ; Q:+$G(ORY)<1 "0^"
  1. ;;R^"860.8:",100,14
  1. ;;D^ ; S SPECFILE=$$TERMLKUP("SERUM SPECIMEN",.ORX)
  1. ;;R^"860.8:",100,15
  1. ;;D^ ; Q:$G(SPECFILE)'=61 "0^"
  1. ;;R^"860.8:",100,16
  1. ;;D^ ; Q:+$G(ORX)<1 "0^"
  1. ;;R^"860.8:",100,17
  1. ;;D^ ; F ORI=1:1:ORY I +$G(CREARSLT)<1 D
  1. ;;R^"860.8:",100,18
  1. ;;D^ ; .S TEST=$P(ORY(ORI),U)
  1. ;;R^"860.8:",100,19
  1. ;;D^ ; .Q:+$G(TEST)<1
  1. ;;R^"860.8:",100,20
  1. ;;D^ ; .F ORJ=1:1:ORX I +$G(CREARSLT)<1 D
  1. ;;R^"860.8:",100,21
  1. ;;D^ ; ..S SPECIMEN=$P(ORX(ORJ),U)
  1. ;;R^"860.8:",100,22
  1. ;;D^ ; ..Q:+$G(SPECIMEN)<1
  1. ;;R^"860.8:",100,23
  1. ;;D^ ; ..S ORZ=$$LOCL^ORQQLR1(ORDFN,TEST,SPECIMEN)
  1. ;;R^"860.8:",100,24
  1. ;;D^ ; ..Q:'$L($G(ORZ))
  1. ;;R^"860.8:",100,25
  1. ;;D^ ; ..S CDT=$P(ORZ,U,7)
  1. ;;R^"860.8:",100,26
  1. ;;D^ ; ..I CDT'<BDT S CREARSLT=1
  1. ;;R^"860.8:",100,27
  1. ;;D^ ; Q:+$G(CREARSLT)<1 "0^"
  1. ;;R^"860.8:",100,28
  1. ;;D^ ; Q $P(ORZ,U)_U_$P(ORZ,U,3)_" "_$P(ORZ,U,4)_" "_$P(ORZ,U,5)_" ("_$P(ORZ,U,6)_") "_$$FMTE^XLFDT(CDT,"2P")_U_$P(ORZ,U,3)
  1. ;;EOR^
  1. ;;KEY^860.8:^RETURN POINTED TO VALUE
  1. ;;R^"860.8:",.01,"E"
  1. ;;D^RETURN POINTED TO VALUE
  1. ;;R^"860.8:",.02,"E"
  1. ;;D^POINTER
  1. ;;R^"860.8:",1,1
  1. ;;D^ ;POINTER(OCXFILE,D0) ; This Local Extrinsic Function gets the value of the name field
  1. ;;R^"860.8:",1,2
  1. ;;D^ ; ; of record D0 in file OCXFILE
  1. ;;R^"860.8:",100,1
  1. ;;D^ ;POINTER(OCXFILE,D0) ; This Local Extrinsic Function gets the value of the name field
  1. ;;R^"860.8:",100,2
  1. ;;D^ ; ; of record D0 in file OCXFILE
  1. ;;R^"860.8:",100,3
  1. ;;D^T+; I $G(OCXTRACE) W !,"%%%%",?20," FILE: ",$G(OCXFILE)," D0: ",$G(D0)
  1. ;;R^"860.8:",100,4
  1. ;;D^ ; Q:'$G(D0) "" Q:'$L($G(OCXFILE)) ""
  1. ;;R^"860.8:",100,5
  1. ;;D^ ; N GLREF
  1. ;;R^"860.8:",100,6
  1. ;;D^ ; I '(OCXFILE=(+OCXFILE)) S GLREF=U_OCXFILE
  1. ;;R^"860.8:",100,7
  1. ;;D^ ; E S GLREF=$$FILE^OCXBDTD(+OCXFILE,"GLOBAL NAME") Q:'$L(GLREF) ""
  1. ;;R^"860.8:",100,8
  1. ;;D^T+; I $G(OCXTRACE) W !,"%%%%",?20," GLREF: ",GLREF," RESOLVES TO: ",$P($G(@(GLREF_(+D0)_",0)")),U,1)
  1. ;;R^"860.8:",100,9
  1. ;;D^ ; Q $P($G(@(GLREF_(+D0)_",0)")),U,1)
  1. ;;R^"860.8:",100,10
  1. ;;D^ ; ;
  1. ;;EOR^
  1. ;;KEY^860.8:^STRING CONTAINS ONE OF A LIST OF VALUES
  1. ;;R^"860.8:",.01,"E"
  1. ;;D^STRING CONTAINS ONE OF A LIST OF VALUES
  1. ;;R^"860.8:",.02,"E"
  1. ;;D^CLIST
  1. ;;R^"860.8:",100,1
  1. ;;D^ ;CLIST(DATA,LIST) ; DOES THE DATA FIELD CONTAIN AN ELEMENT IN THE LIST
  1. ;;R^"860.8:",100,2
  1. ;;D^ ; ;
  1. ;;R^"860.8:",100,3
  1. ;;D^T+; W:$G(OCXTRACE) !!,"$$CLIST(",DATA,",""",LIST,""")"
  1. ;;R^"860.8:",100,4
  1. ;;D^ ; N PC F PC=1:1:$L(LIST,","),0 I PC,$L($P(LIST,",",PC)),(DATA[$P(LIST,",",PC)) Q
  1. ;;R^"860.8:",100,5
  1. ;;D^ ; Q ''PC
  1. ;;EOR^
  1. ;;EOF^OCXS(860.8)^1
  1. ;;SOF^860.6 ORDER CHECK DATA CONTEXT
  1. ;;KEY^860.6:^CPRS ORDER PRESCAN
  1. ;;R^"860.6:",.01,"E"
  1. ;;D^CPRS ORDER PRESCAN
  1. ;;R^"860.6:",.02,"E"
  1. ;;D^OEPS
  1. ;;R^"860.6:",1,"E"
  1. ;;D^DATA DRIVEN
  1. ;;EOR^
  1. ;;KEY^860.6:^CPRS ORDER PROTOCOL
  1. ;;R^"860.6:",.01,"E"
  1. ;;D^CPRS ORDER PROTOCOL
  1. ;;R^"860.6:",.02,"E"
  1. ;;D^OERR
  1. ;;R^"860.6:",1,"E"
  1. ;;D^DATA DRIVEN
  1. ;;EOR^
  1. ;;KEY^860.6:^DATABASE LOOKUP
  1. ;;R^"860.6:",.01,"E"
  1. ;;D^DATABASE LOOKUP
  1. ;;R^"860.6:",.02,"E"
  1. ;;D^DL
  1. ;;R^"860.6:",1,"E"
  1. ;;D^PACKAGE LOOKUP
  1. ;;EOR^
  1. ;;KEY^860.6:^GENERIC HL7 MESSAGE ARRAY
  1. ;;R^"860.6:",.01,"E"
  1. ;;D^GENERIC HL7 MESSAGE ARRAY
  1. ;;R^"860.6:",.02,"E"
  1. ;;D^HL7
  1. ;;R^"860.6:",1,"E"
  1. ;;D^DATA DRIVEN
  1. ;;EOR^
  1. ;;EOF^OCXS(860.6)^1
  1. ;;SOF^860.5 ORDER CHECK DATA SOURCE
  1. ;;KEY^860.5:^DATABASE LOOKUP
  1. ;;R^"860.5:",.01,"E"
  1. ;;D^DATABASE LOOKUP
  1. ;;R^"860.5:",.02,"E"
  1. ;;D^DATABASE LOOKUP
  1. ;;EOR^
  1. ;;KEY^860.5:^HL7 COMMON ORDER SEGMENT
  1. ;;R^"860.5:",.01,"E"
  1. ;;D^HL7 COMMON ORDER SEGMENT
  1. ;;R^"860.5:",.02,"E"
  1. ;;D^GENERIC HL7 MESSAGE ARRAY
  1. ;;EOR^
  1. ;;KEY^860.5:^HL7 OBSERVATION REQUEST SEGMENT
  1. ;;R^"860.5:",.01,"E"
  1. ;;D^HL7 OBSERVATION REQUEST SEGMENT
  1. ;;R^"860.5:",.02,"E"
  1. ;;D^GENERIC HL7 MESSAGE ARRAY
  1. ;;EOR^
  1. ;;KEY^860.5:^HL7 OBSERVATION/RESULT SEGMENT
  1. ;;R^"860.5:",.01,"E"
  1. ;;D^HL7 OBSERVATION/RESULT SEGMENT
  1. ;;R^"860.5:",.02,"E"
  1. ;;D^GENERIC HL7 MESSAGE ARRAY
  1. ;;EOR^
  1. ;;KEY^860.5:^HL7 PATIENT ID SEGMENT
  1. ;;R^"860.5:",.01,"E"
  1. ;;D^HL7 PATIENT ID SEGMENT
  1. ;;R^"860.5:",.02,"E"
  1. ;;D^GENERIC HL7 MESSAGE ARRAY
  1. ;;EOR^
  1. ;;KEY^860.5:^OERR ORDER EVENT FLAG PROTOCOL
  1. ;;R^"860.5:",.01,"E"
  1. ;;D^OERR ORDER EVENT FLAG PROTOCOL
  1. ;;R^"860.5:",.02,"E"
  1. ;;D^CPRS ORDER PROTOCOL
  1. ;;EOR^
  1. ;;KEY^860.5:^ORDER ENTRY ORDER PRESCAN
  1. ;;R^"860.5:",.01,"E"
  1. ;;D^ORDER ENTRY ORDER PRESCAN
  1. ;;R^"860.5:",.02,"E"
  1. ;;D^CPRS ORDER PRESCAN
  1. ;;EOR^
  1. ;;EOF^OCXS(860.5)^1
  1. ;;SOF^860.4 ORDER CHECK DATA FIELD
  1. ;;KEY^860.4:^ABNORMAL RENAL BIOCHEM RESULTS
  1. ;;R^"860.4:",.01,"E"
  1. ;1;
  1. ;