OCXOZ05 ;SLC/RJS,CLA - Order Check Scan ;JAN 28,2014 at 03:37
;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,221,243**;Dec 17,1997;Build 242
;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
;
; ***************************************************************
; ** Warning: This routine is automatically generated by the **
; ** Rule Compiler (^OCXOCMP) and ANY changes to this routine **
; ** will be lost the next time the rule compiler executes. **
; ***************************************************************
;
Q
;
CHK47 ; Look through the current environment for valid Event/Elements for this patient.
; Called from CHK1+29^OCXOZ02.
;
Q:$G(OCXOERR)
;
; Local CHK47 Variables
; OCXDF(1) ----> Data Field: CONTROL CODE (FREE TEXT)
; OCXDF(2) ----> Data Field: FILLER (FREE TEXT)
; OCXDF(6) ----> Data Field: ABNORMAL FLAG (FREE TEXT)
; OCXDF(34) ---> Data Field: ORDER NUMBER (NUMERIC)
; OCXDF(37) ---> Data Field: PATIENT IEN (NUMERIC)
; OCXDF(96) ---> Data Field: ORDERABLE ITEM NAME (FREE TEXT)
; OCXDF(146) --> Data Field: INPT/OUTPT (FREE TEXT)
;
; Local Extrinsic Functions
; LIST( ------------> IN LIST OPERATOR
; ORDITEM( ---------> GET ORDERABLE ITEM FROM ORDER NUMBER
; PATLOC( ----------> PATIENT LOCATION
;
I $L(OCXDF(6)),$$LIST(OCXDF(6),"HH,LL"),$L(OCXDF(1)),$$LIST(OCXDF(1),"RE"),$L(OCXDF(2)),($E(OCXDF(2),1,2)="LR"),$L(OCXDF(34)) S OCXDF(96)=$$ORDITEM(OCXDF(34)) D CHK55
I $L(OCXDF(1)),$$LIST(OCXDF(1),"RE"),$L(OCXDF(2)),($E(OCXDF(2),1,2)="LR"),$L(OCXDF(37)) S OCXDF(146)=$P($$PATLOC(OCXDF(37)),"^",1) I $L(OCXDF(146)),$L(OCXDF(34)) D CHK144^OCXOZ07
Q
;
CHK55 ; Look through the current environment for valid Event/Elements for this patient.
; Called from CHK47+19.
;
Q:$G(OCXOERR)
;
; Local CHK55 Variables
; OCXDF(113) --> Data Field: LAB TEST ID (NUMERIC)
; OCXDF(114) --> Data Field: LAB TEST PRINT NAME (FREE TEXT)
;
; Local Extrinsic Functions
; FILE(DFN,24, -----> FILE DATA IN PATIENT ACTIVE DATA FILE (Event/Element: HL7 LAB TEST RESULTS CRITICAL)
;
I $L(OCXDF(113)) S OCXDF(114)=$$PRINTNAM^ORQQLR1(OCXDF(113)),OCXOERR=$$FILE(DFN,24,"12,13,96,114") Q:OCXOERR
Q
;
CHK58 ; Look through the current environment for valid Event/Elements for this patient.
; Called from UPDATE+12^OCXOZ01.
;
Q:$G(OCXOERR)
;
; Local CHK58 Variables
; OCXDF(2) ----> Data Field: FILLER (FREE TEXT)
; OCXDF(37) ---> Data Field: PATIENT IEN (NUMERIC)
; OCXDF(40) ---> Data Field: ORDER MODE (FREE TEXT)
; OCXDF(47) ---> Data Field: OI LOCAL TEXT (FREE TEXT)
; OCXDF(73) ---> Data Field: ORDERABLE ITEM IEN (NUMERIC)
; OCXDF(131) --> Data Field: PHARMACY LOCAL ID (FREE TEXT)
; OCXDF(143) --> Data Field: DANGEROUS MEDS FOR PT > 64 NAME (FREE TEXT)
;
; Local Extrinsic Functions
; DMED64( ----------> DANGEROUS MEDS FOR PATIENTS > 64
;
S OCXDF(2)=$P($G(OCXPSD),"|",2) I $L(OCXDF(2)) D CHK60
S OCXDF(40)=$G(OCXPSM) I $L(OCXDF(40)) D CHK163^OCXOZ08
S OCXDF(47)=$P($P($G(OCXPSD),"|",3),"^",5) I $L(OCXDF(47)) D CHK188^OCXOZ09
S OCXDF(131)=$P($P($G(OCXPSD),"|",3),"^",4) I $L(OCXDF(131)) S OCXDF(37)=$G(DFN) I $L(OCXDF(37)) D CHK347^OCXOZ0C
S OCXDF(73)=$P($G(OCXPSD),"|",1) I $L(OCXDF(73)) S OCXDF(143)=$P($$DMED64(OCXDF(73)),"^",2) I $L(OCXDF(143)) D CHK398^OCXOZ0D
S OCXDF(37)=$G(DFN) I $L(OCXDF(37)) D CHK446^OCXOZ0E
Q
;
CHK60 ; Look through the current environment for valid Event/Elements for this patient.
; Called from CHK58+17.
;
Q:$G(OCXOERR)
;
; Local CHK60 Variables
; OCXDF(2) ----> Data Field: FILLER (FREE TEXT)
;
; Local Extrinsic Functions
; FILE(DFN,135, ----> FILE DATA IN PATIENT ACTIVE DATA FILE (Event/Element: DIET ORDER)
; FILE(DFN,137, ----> FILE DATA IN PATIENT ACTIVE DATA FILE (Event/Element: PHARMACY ORDER)
; FILE(DFN,28, -----> FILE DATA IN PATIENT ACTIVE DATA FILE (Event/Element: RADIOLOGY ORDER)
;
I (OCXDF(2)="RA") S OCXOERR=$$FILE(DFN,28,"") Q:OCXOERR
I (OCXDF(2)="FH") S OCXOERR=$$FILE(DFN,135,"") Q:OCXOERR
I ($E(OCXDF(2),1,2)="PS") S OCXOERR=$$FILE(DFN,137,"") Q:OCXOERR
Q
;
CHK87 ; Look through the current environment for valid Event/Elements for this patient.
; Called from CHK23+16^OCXOZ03.
;
Q:$G(OCXOERR)
;
; Local CHK87 Variables
; OCXDF(90) ---> Data Field: PATIENT MOVEMENT WARD CURRENT (FREE TEXT)
; OCXDF(91) ---> Data Field: PATIENT MOVEMENT SERVICE CURRENT (FREE TEXT)
; OCXDF(92) ---> Data Field: PATIENT MOVEMENT WARD IEN CURRENT (NUMERIC)
;
; Local Extrinsic Functions
; POINTER( ---------> RETURN POINTED TO VALUE
; WARDSERV( --------> GET WARD SERVICE
;
I $L(OCXDF(92)) S OCXDF(91)=$$WARDSERV(OCXDF(92)) I $L(OCXDF(91)),($L(OCXDF(91))>0),'(OCXDF(91)="PSYCHIATRY") S OCXDF(90)=$$POINTER(42,$P($G(DGPMA),"^",6)) D CHK93
Q
;
CHK93 ; Look through the current environment for valid Event/Elements for this patient.
; Called from CHK87+14.
;
Q:$G(OCXOERR)
;
; Local CHK93 Variables
; OCXDF(95) ---> Data Field: PATIENT MOVEMENT WARD PREVIOUS (FREE TEXT)
;
; Local Extrinsic Functions
; FILE(DFN,42, -----> FILE DATA IN PATIENT ACTIVE DATA FILE (Event/Element: PATIENT TRANSFERRED FROM PSYCH WARD)
; POINTER( ---------> RETURN POINTED TO VALUE
;
S OCXDF(95)=$$POINTER(42,$P($G(DGPM0),"^",6)),OCXOERR=$$FILE(DFN,42,"90,95") Q:OCXOERR
Q
;
DMED64(OCXOI) ;ext func rtns med oi^med name if OCXOI is dangerous
N OCXTL,OCXT,OCXDM
Q:'$$TERMLKUP("DANGEROUS MEDS FOR PTS > 64",.OCXTL) "0^"
S OCXDM="",OCXT=0 F S OCXT=$O(OCXTL(OCXT)) Q:'OCXT D Q:$L(OCXDM)
.I OCXT=OCXOI S OCXDM=OCXT_"^"_OCXTL(OCXT)
Q:'$L(OCXDM) "0^"
Q OCXDM
;
FILE(DFN,OCXELE,OCXDFL) ; This Local Extrinsic Function logs a validated event/element.
;
N OCXTIMN,OCXTIML,OCXTIMT1,OCXTIMT2,OCXDATA,OCXPC,OCXPC,OCXVAL,OCXSUB,OCXDFI
S DFN=+$G(DFN),OCXELE=+$G(OCXELE)
;
Q:'DFN 1 Q:'OCXELE 1 K OCXDATA
;
S OCXDATA(DFN,OCXELE)=1
F OCXPC=1:1:$L(OCXDFL,",") S OCXDFI=$P(OCXDFL,",",OCXPC) I OCXDFI D
.S OCXVAL=$G(OCXDF(+OCXDFI)),OCXDATA(DFN,OCXELE,+OCXDFI)=OCXVAL
;
M ^TMP("OCXCHK",$J,DFN)=OCXDATA(DFN)
;
Q 0
;
LIST(DATA,LIST) ; IS THE DATA FIELD IN THE LIST
;
S:'($E(LIST,1)=",") LIST=","_LIST S:'($E(LIST,$L(LIST))=",") LIST=LIST_"," S DATA=","_DATA_","
Q (LIST[DATA)
;
ORDITEM(OIEN) ; Compiler Function: GET ORDERABLE ITEM FROM ORDER NUMBER
Q:'$G(OIEN) ""
;
N OITXT,X S OITXT=$$OI^ORQOR2(OIEN) Q:'OITXT "No orderable item found."
S X=$G(^ORD(101.43,+OITXT,0)) Q:'$L(X) "No orderable item found."
Q $P(X,U,1)
;
PATLOC(DFN) ; Compiler Function: PATIENT LOCATION
;
N OCXP1,OCXP2
S OCXP1=$G(^TMP("OCXSWAP",$J,"OCXODATA","PV1",2))
S OCXP2=$P($G(^TMP("OCXSWAP",$J,"OCXODATA","PV1",3)),"^",1)
I OCXP2 D
.S OCXP2=$P($G(^SC(+OCXP2,0)),"^",1,2)
.I $L($P(OCXP2,"^",2)) S OCXP2=$P(OCXP2,"^",2)
.E S OCXP2=$P(OCXP2,"^",1)
.S:'$L(OCXP2) OCXP2="NO LOC"
I $L(OCXP1),$L(OCXP2) Q OCXP1_"^"_OCXP2
;
S OCXP2=$G(^DPT(+$G(DFN),.1))
I $L(OCXP2) Q "I^"_OCXP2
Q "O^OUTPT"
;
POINTER(OCXFILE,D0) ; This Local Extrinsic Function gets the value of the name field
; of record D0 in file OCXFILE
Q:'$G(D0) "" Q:'$L($G(OCXFILE)) ""
N GLREF
I '(OCXFILE=(+OCXFILE)) S GLREF=U_OCXFILE
E S GLREF=$$FILE^OCXBDTD(+OCXFILE,"GLOBAL NAME") Q:'$L(GLREF) ""
Q $P($G(@(GLREF_(+D0)_",0)")),U,1)
;
TERMLKUP(OCXTERM,OCXLIST) ;
Q $$TERM^OCXOZ01(OCXTERM,.OCXLIST)
;
WARDSERV(WARD) ; Compiler Function: GET WARD SERVICE
;
N CODESET,PC,SERV,DIC,X,Y,DA
S CODESET="M:MEDICINE;S:SURGERY;P:PSYCHIATRY;NH:NHCU;NE:NEUROLOGY;I:INTERMEDIATE MED;R:REHAB MEDICINE;SCI:SPINAL CORD INJURY;D:DOMICILIARY;B:BLIND REHAB;NC:NON-COUNT"
S DIC=42,DIC(0)="NZ",X="`"_(+WARD) D ^DIC Q:(Y<1) ""
S SERV=$P($G(Y(0)),U,3)
Q:'$L(SERV) "" Q:'$L(CODESET) ""
F PC=1:1:$L(CODESET,";"),0 I PC,($P($P(CODESET,";",PC),":",1)=SERV) Q
Q:'PC "" Q $P($P(CODESET,";",PC),":",2)
;
OCXOZ05 ;SLC/RJS,CLA - Order Check Scan ;JAN 28,2014 at 03:37
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,221,243**;Dec 17,1997;Build 242
+2 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
+3 ;
+4 ; ***************************************************************
+5 ; ** Warning: This routine is automatically generated by the **
+6 ; ** Rule Compiler (^OCXOCMP) and ANY changes to this routine **
+7 ; ** will be lost the next time the rule compiler executes. **
+8 ; ***************************************************************
+9 ;
+10 QUIT
+11 ;
CHK47 ; Look through the current environment for valid Event/Elements for this patient.
+1 ; Called from CHK1+29^OCXOZ02.
+2 ;
+3 IF $GET(OCXOERR)
QUIT
+4 ;
+5 ; Local CHK47 Variables
+6 ; OCXDF(1) ----> Data Field: CONTROL CODE (FREE TEXT)
+7 ; OCXDF(2) ----> Data Field: FILLER (FREE TEXT)
+8 ; OCXDF(6) ----> Data Field: ABNORMAL FLAG (FREE TEXT)
+9 ; OCXDF(34) ---> Data Field: ORDER NUMBER (NUMERIC)
+10 ; OCXDF(37) ---> Data Field: PATIENT IEN (NUMERIC)
+11 ; OCXDF(96) ---> Data Field: ORDERABLE ITEM NAME (FREE TEXT)
+12 ; OCXDF(146) --> Data Field: INPT/OUTPT (FREE TEXT)
+13 ;
+14 ; Local Extrinsic Functions
+15 ; LIST( ------------> IN LIST OPERATOR
+16 ; ORDITEM( ---------> GET ORDERABLE ITEM FROM ORDER NUMBER
+17 ; PATLOC( ----------> PATIENT LOCATION
+18 ;
+19 IF $LENGTH(OCXDF(6))
IF $$LIST(OCXDF(6),"HH,LL")
IF $LENGTH(OCXDF(1))
IF $$LIST(OCXDF(1),"RE")
IF $LENGTH(OCXDF(2))
IF ($EXTRACT(OCXDF(2),1,2)="LR")
IF $LENGTH(OCXDF(34))
SET OCXDF(96)=$$ORDITEM(OCXDF(34))
DO CHK55
+20 IF $LENGTH(OCXDF(1))
IF $$LIST(OCXDF(1),"RE")
IF $LENGTH(OCXDF(2))
IF ($EXTRACT(OCXDF(2),1,2)="LR")
IF $LENGTH(OCXDF(37))
SET OCXDF(146)=$PIECE($$PATLOC(OCXDF(37)),"^",1)
IF $LENGTH(OCXDF(146))
IF $LENGTH(OCXDF(34))
DO CHK144^OCXOZ07
+21 QUIT
+22 ;
CHK55 ; Look through the current environment for valid Event/Elements for this patient.
+1 ; Called from CHK47+19.
+2 ;
+3 IF $GET(OCXOERR)
QUIT
+4 ;
+5 ; Local CHK55 Variables
+6 ; OCXDF(113) --> Data Field: LAB TEST ID (NUMERIC)
+7 ; OCXDF(114) --> Data Field: LAB TEST PRINT NAME (FREE TEXT)
+8 ;
+9 ; Local Extrinsic Functions
+10 ; FILE(DFN,24, -----> FILE DATA IN PATIENT ACTIVE DATA FILE (Event/Element: HL7 LAB TEST RESULTS CRITICAL)
+11 ;
+12 IF $LENGTH(OCXDF(113))
SET OCXDF(114)=$$PRINTNAM^ORQQLR1(OCXDF(113))
SET OCXOERR=$$FILE(DFN,24,"12,13,96,114")
IF OCXOERR
QUIT
+13 QUIT
+14 ;
CHK58 ; Look through the current environment for valid Event/Elements for this patient.
+1 ; Called from UPDATE+12^OCXOZ01.
+2 ;
+3 IF $GET(OCXOERR)
QUIT
+4 ;
+5 ; Local CHK58 Variables
+6 ; OCXDF(2) ----> Data Field: FILLER (FREE TEXT)
+7 ; OCXDF(37) ---> Data Field: PATIENT IEN (NUMERIC)
+8 ; OCXDF(40) ---> Data Field: ORDER MODE (FREE TEXT)
+9 ; OCXDF(47) ---> Data Field: OI LOCAL TEXT (FREE TEXT)
+10 ; OCXDF(73) ---> Data Field: ORDERABLE ITEM IEN (NUMERIC)
+11 ; OCXDF(131) --> Data Field: PHARMACY LOCAL ID (FREE TEXT)
+12 ; OCXDF(143) --> Data Field: DANGEROUS MEDS FOR PT > 64 NAME (FREE TEXT)
+13 ;
+14 ; Local Extrinsic Functions
+15 ; DMED64( ----------> DANGEROUS MEDS FOR PATIENTS > 64
+16 ;
+17 SET OCXDF(2)=$PIECE($GET(OCXPSD),"|",2)
IF $LENGTH(OCXDF(2))
DO CHK60
+18 SET OCXDF(40)=$GET(OCXPSM)
IF $LENGTH(OCXDF(40))
DO CHK163^OCXOZ08
+19 SET OCXDF(47)=$PIECE($PIECE($GET(OCXPSD),"|",3),"^",5)
IF $LENGTH(OCXDF(47))
DO CHK188^OCXOZ09
+20 SET OCXDF(131)=$PIECE($PIECE($GET(OCXPSD),"|",3),"^",4)
IF $LENGTH(OCXDF(131))
SET OCXDF(37)=$GET(DFN)
IF $LENGTH(OCXDF(37))
DO CHK347^OCXOZ0C
+21 SET OCXDF(73)=$PIECE($GET(OCXPSD),"|",1)
IF $LENGTH(OCXDF(73))
SET OCXDF(143)=$PIECE($$DMED64(OCXDF(73)),"^",2)
IF $LENGTH(OCXDF(143))
DO CHK398^OCXOZ0D
+22 SET OCXDF(37)=$GET(DFN)
IF $LENGTH(OCXDF(37))
DO CHK446^OCXOZ0E
+23 QUIT
+24 ;
CHK60 ; Look through the current environment for valid Event/Elements for this patient.
+1 ; Called from CHK58+17.
+2 ;
+3 IF $GET(OCXOERR)
QUIT
+4 ;
+5 ; Local CHK60 Variables
+6 ; OCXDF(2) ----> Data Field: FILLER (FREE TEXT)
+7 ;
+8 ; Local Extrinsic Functions
+9 ; FILE(DFN,135, ----> FILE DATA IN PATIENT ACTIVE DATA FILE (Event/Element: DIET ORDER)
+10 ; FILE(DFN,137, ----> FILE DATA IN PATIENT ACTIVE DATA FILE (Event/Element: PHARMACY ORDER)
+11 ; FILE(DFN,28, -----> FILE DATA IN PATIENT ACTIVE DATA FILE (Event/Element: RADIOLOGY ORDER)
+12 ;
+13 IF (OCXDF(2)="RA")
SET OCXOERR=$$FILE(DFN,28,"")
IF OCXOERR
QUIT
+14 IF (OCXDF(2)="FH")
SET OCXOERR=$$FILE(DFN,135,"")
IF OCXOERR
QUIT
+15 IF ($EXTRACT(OCXDF(2),1,2)="PS")
SET OCXOERR=$$FILE(DFN,137,"")
IF OCXOERR
QUIT
+16 QUIT
+17 ;
CHK87 ; Look through the current environment for valid Event/Elements for this patient.
+1 ; Called from CHK23+16^OCXOZ03.
+2 ;
+3 IF $GET(OCXOERR)
QUIT
+4 ;
+5 ; Local CHK87 Variables
+6 ; OCXDF(90) ---> Data Field: PATIENT MOVEMENT WARD CURRENT (FREE TEXT)
+7 ; OCXDF(91) ---> Data Field: PATIENT MOVEMENT SERVICE CURRENT (FREE TEXT)
+8 ; OCXDF(92) ---> Data Field: PATIENT MOVEMENT WARD IEN CURRENT (NUMERIC)
+9 ;
+10 ; Local Extrinsic Functions
+11 ; POINTER( ---------> RETURN POINTED TO VALUE
+12 ; WARDSERV( --------> GET WARD SERVICE
+13 ;
+14 IF $LENGTH(OCXDF(92))
SET OCXDF(91)=$$WARDSERV(OCXDF(92))
IF $LENGTH(OCXDF(91))
IF ($LENGTH(OCXDF(91))>0)
IF '(OCXDF(91)="PSYCHIATRY")
SET OCXDF(90)=$$POINTER(42,$PIECE($GET(DGPMA),"^",6))
DO CHK93
+15 QUIT
+16 ;
CHK93 ; Look through the current environment for valid Event/Elements for this patient.
+1 ; Called from CHK87+14.
+2 ;
+3 IF $GET(OCXOERR)
QUIT
+4 ;
+5 ; Local CHK93 Variables
+6 ; OCXDF(95) ---> Data Field: PATIENT MOVEMENT WARD PREVIOUS (FREE TEXT)
+7 ;
+8 ; Local Extrinsic Functions
+9 ; FILE(DFN,42, -----> FILE DATA IN PATIENT ACTIVE DATA FILE (Event/Element: PATIENT TRANSFERRED FROM PSYCH WARD)
+10 ; POINTER( ---------> RETURN POINTED TO VALUE
+11 ;
+12 SET OCXDF(95)=$$POINTER(42,$PIECE($GET(DGPM0),"^",6))
SET OCXOERR=$$FILE(DFN,42,"90,95")
IF OCXOERR
QUIT
+13 QUIT
+14 ;
DMED64(OCXOI) ;ext func rtns med oi^med name if OCXOI is dangerous
+1 NEW OCXTL,OCXT,OCXDM
+2 IF '$$TERMLKUP("DANGEROUS MEDS FOR PTS > 64",.OCXTL)
QUIT "0^"
+3 SET OCXDM=""
SET OCXT=0
FOR
SET OCXT=$ORDER(OCXTL(OCXT))
IF 'OCXT
QUIT
Begin DoDot:1
+4 IF OCXT=OCXOI
SET OCXDM=OCXT_"^"_OCXTL(OCXT)
End DoDot:1
IF $LENGTH(OCXDM)
QUIT
+5 IF '$LENGTH(OCXDM)
QUIT "0^"
+6 QUIT OCXDM
+7 ;
FILE(DFN,OCXELE,OCXDFL) ; This Local Extrinsic Function logs a validated event/element.
+1 ;
+2 NEW OCXTIMN,OCXTIML,OCXTIMT1,OCXTIMT2,OCXDATA,OCXPC,OCXPC,OCXVAL,OCXSUB,OCXDFI
+3 SET DFN=+$GET(DFN)
SET OCXELE=+$GET(OCXELE)
+4 ;
+5 IF 'DFN
QUIT 1
IF 'OCXELE
QUIT 1
KILL OCXDATA
+6 ;
+7 SET OCXDATA(DFN,OCXELE)=1
+8 FOR OCXPC=1:1:$LENGTH(OCXDFL,",")
SET OCXDFI=$PIECE(OCXDFL,",",OCXPC)
IF OCXDFI
Begin DoDot:1
+9 SET OCXVAL=$GET(OCXDF(+OCXDFI))
SET OCXDATA(DFN,OCXELE,+OCXDFI)=OCXVAL
End DoDot:1
+10 ;
+11 MERGE ^TMP("OCXCHK",$JOB,DFN)=OCXDATA(DFN)
+12 ;
+13 QUIT 0
+14 ;
LIST(DATA,LIST) ; IS THE DATA FIELD IN THE LIST
+1 ;
+2 IF '($EXTRACT(LIST,1)=",")
SET LIST=","_LIST
IF '($EXTRACT(LIST,$LENGTH(LIST))=",")
SET LIST=LIST_","
SET DATA=","_DATA_","
+3 QUIT (LIST[DATA)
+4 ;
ORDITEM(OIEN) ; Compiler Function: GET ORDERABLE ITEM FROM ORDER NUMBER
+1 IF '$GET(OIEN)
QUIT ""
+2 ;
+3 NEW OITXT,X
SET OITXT=$$OI^ORQOR2(OIEN)
IF 'OITXT
QUIT "No orderable item found."
+4 SET X=$GET(^ORD(101.43,+OITXT,0))
IF '$LENGTH(X)
QUIT "No orderable item found."
+5 QUIT $PIECE(X,U,1)
+6 ;
PATLOC(DFN) ; Compiler Function: PATIENT LOCATION
+1 ;
+2 NEW OCXP1,OCXP2
+3 SET OCXP1=$GET(^TMP("OCXSWAP",$JOB,"OCXODATA","PV1",2))
+4 SET OCXP2=$PIECE($GET(^TMP("OCXSWAP",$JOB,"OCXODATA","PV1",3)),"^",1)
+5 IF OCXP2
Begin DoDot:1
+6 SET OCXP2=$PIECE($GET(^SC(+OCXP2,0)),"^",1,2)
+7 IF $LENGTH($PIECE(OCXP2,"^",2))
SET OCXP2=$PIECE(OCXP2,"^",2)
+8 IF '$TEST
SET OCXP2=$PIECE(OCXP2,"^",1)
+9 IF '$LENGTH(OCXP2)
SET OCXP2="NO LOC"
End DoDot:1
+10 IF $LENGTH(OCXP1)
IF $LENGTH(OCXP2)
QUIT OCXP1_"^"_OCXP2
+11 ;
+12 SET OCXP2=$GET(^DPT(+$GET(DFN),.1))
+13 IF $LENGTH(OCXP2)
QUIT "I^"_OCXP2
+14 QUIT "O^OUTPT"
+15 ;
POINTER(OCXFILE,D0) ; This Local Extrinsic Function gets the value of the name field
+1 ; of record D0 in file OCXFILE
+2 IF '$GET(D0)
QUIT ""
IF '$LENGTH($GET(OCXFILE))
QUIT ""
+3 NEW GLREF
+4 IF '(OCXFILE=(+OCXFILE))
SET GLREF=U_OCXFILE
+5 IF '$TEST
SET GLREF=$$FILE^OCXBDTD(+OCXFILE,"GLOBAL NAME")
IF '$LENGTH(GLREF)
QUIT ""
+6 QUIT $PIECE($GET(@(GLREF_(+D0)_",0)")),U,1)
+7 ;
TERMLKUP(OCXTERM,OCXLIST) ;
+1 QUIT $$TERM^OCXOZ01(OCXTERM,.OCXLIST)
+2 ;
WARDSERV(WARD) ; Compiler Function: GET WARD SERVICE
+1 ;
+2 NEW CODESET,PC,SERV,DIC,X,Y,DA
+3 SET CODESET="M:MEDICINE;S:SURGERY;P:PSYCHIATRY;NH:NHCU;NE:NEUROLOGY;I:INTERMEDIATE MED;R:REHAB MEDICINE;SCI:SPINAL CORD INJURY;D:DOMICILIARY;B:BLIND REHAB;NC:NON-COUNT"
+4 SET DIC=42
SET DIC(0)="NZ"
SET X="`"_(+WARD)
DO ^DIC
IF (Y<1)
QUIT ""
+5 SET SERV=$PIECE($GET(Y(0)),U,3)
+6 IF '$LENGTH(SERV)
QUIT ""
IF '$LENGTH(CODESET)
QUIT ""
+7 FOR PC=1:1:$LENGTH(CODESET,";"),0
IF PC
IF ($PIECE($PIECE(CODESET,";",PC),":",1)=SERV)
QUIT
+8 IF 'PC
QUIT ""
QUIT $PIECE($PIECE(CODESET,";",PC),":",2)
+9 ;
