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

OCXDI02H.m

Go to the documentation of this file.
  1. OCXDI02H ;SLC/RJS,CLA - OCX PACKAGE DIAGNOSTIC ROUTINES ;SEP 7,1999 at 10:30
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32**;Dec 17,1997
  1. ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
  1. ;
  1. S ;
  1. ;
  1. D DOT^OCXDIAG
  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("OCXDIAG",$J,$O(^TMP("OCXDIAG",$J,"A"),-1)+1)=TEXT
  1. ;
  1. G ^OCXDI02I
  1. ;
  1. Q
  1. ;
  1. DATA ;
  1. ;
  1. ;;D^ ; ;
  1. ;;R^"860.8:",100,6
  1. ;;D^ ; S OCXLIST="",OCXOI=OCXNAME F S OCXD0=$O(^ORD(101.43,"S."_OCXPKG,OCXOI)) Q:'$L(OCXOI) Q:'($E(OCXOI,1,$L(OCXNAME))=OCXNAME) D
  1. ;;R^"860.8:",100,7
  1. ;;D^ ; .S OCXD0=0 F S OCXD0=$O(^ORD(101.43,"S."_OCXPKG,OCXD0)) Q:'OCXD0 S OCXLIST=OCXLIST_U_OCXD0
  1. ;;R^"860.8:",100,8
  1. ;;D^ ; Q OCXLIST
  1. ;;R^"860.8:",100,9
  1. ;;D^ ; ;
  1. ;;EOR^
  1. ;;KEY^860.8:^LOG DATA FIELD WITH VALUE
  1. ;;R^"860.8:",.01,"E"
  1. ;;D^LOG DATA FIELD WITH VALUE
  1. ;;R^"860.8:",.02,"E"
  1. ;;D^LOGDF
  1. ;;R^"860.8:",100,1
  1. ;;D^ ;LOGDF(DFLD,CONTEXT,VALUE) ;
  1. ;;R^"860.8:",100,2
  1. ;;D^ ; ;
  1. ;;R^"860.8:",100,3
  1. ;;D^ ; I $G(DFLD),$G(CONTEXT),$L($G(VALUE)) D
  1. ;;R^"860.8:",100,4
  1. ;;D^ ; .Q:'$D(^OCXS(860.4,DFLD,0))
  1. ;;R^"860.8:",100,5
  1. ;;D^ ; .S ^OCXS(860.4,DFLD,"LINK",CONTEXT,"STAT")=$G(^OCXS(860.4,DFLD,"LINK",CONTEXT,"STAT"))+1
  1. ;;R^"860.8:",100,6
  1. ;;D^ ; Q 0
  1. ;;EOR^
  1. ;;KEY^860.8:^EXTERNAL TO OERR PACKAGE
  1. ;;R^"860.8:",.01,"E"
  1. ;;D^EXTERNAL TO OERR PACKAGE
  1. ;;R^"860.8:",.02,"E"
  1. ;;D^EXTOERR
  1. ;;R^"860.8:",100,1
  1. ;;D^EXTOERR(PKG1,PKG2) ;
  1. ;;R^"860.8:",100,2
  1. ;;D^ ;
  1. ;;R^"860.8:",100,3
  1. ;;D^ I $L($G(PKG1)),'(PKG1="ORDER ENTRY") Q PKG1
  1. ;;R^"860.8:",100,4
  1. ;;D^ Q $G(PKG2)
  1. ;;R^"860.8:",100,5
  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. ;;KEY^860.8:^GET WARD SERVICE
  1. ;;R^"860.8:",.01,"E"
  1. ;;D^GET WARD SERVICE
  1. ;;R^"860.8:",.02,"E"
  1. ;;D^WARDSERV
  1. ;;R^"860.8:",100,1
  1. ;;D^ ;WARDSERV(WARD) ;
  1. ;;R^"860.8:",100,2
  1. ;;D^ ; ;
  1. ;;R^"860.8:",100,3
  1. ;;D^ ; N CODESET,PC,SERV,DIC,X,Y,DA
  1. ;;R^"860.8:",100,4
  1. ;;D^ ; 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"
  1. ;;R^"860.8:",100,5
  1. ;;D^ ; S DIC=42,DIC(0)="NZ",X="`"_(+WARD) D ^DIC Q:(Y<1) ""
  1. ;;R^"860.8:",100,6
  1. ;;D^ ; S SERV=$P($G(Y(0)),U,3)
  1. ;;R^"860.8:",100,7
  1. ;;D^ ; Q:'$L(SERV) "" Q:'$L(CODESET) ""
  1. ;;R^"860.8:",100,8
  1. ;;D^ ; F PC=1:1:$L(CODESET,";"),0 I PC,($P($P(CODESET,";",PC),":",1)=SERV) Q
  1. ;;R^"860.8:",100,9
  1. ;;D^ ; Q:'PC "" Q $P($P(CODESET,";",PC),":",2)
  1. ;;R^"860.8:",100,10
  1. ;;D^ ; ;
  1. ;;EOR^
  1. ;;KEY^860.8:^GET ORDERABLE ITEM FROM ORDER NUMBER
  1. ;;R^"860.8:",.01,"E"
  1. ;;D^GET ORDERABLE ITEM FROM ORDER NUMBER
  1. ;;R^"860.8:",.02,"E"
  1. ;;D^ORDITEM
  1. ;;R^"860.8:",100,1
  1. ;;D^ ;ORDITEM(OIEN) ;
  1. ;;R^"860.8:",100,2
  1. ;;D^ ;
  1. ;;R^"860.8:",100,3
  1. ;;D^ ; Q:'$G(OIEN) ""
  1. ;;R^"860.8:",100,4
  1. ;;D^ ; ;
  1. ;;R^"860.8:",100,5
  1. ;;D^ ; N OITXT,X S OITXT=$$OI^ORQOR2(OIEN) Q:'OITXT "No orderable item found."
  1. ;;R^"860.8:",100,6
  1. ;;D^ ; S X=$G(^ORD(101.43,+OITXT,0)) Q:'$L(X) "No orderable item found."
  1. ;;R^"860.8:",100,7
  1. ;;D^ ; Q $P(X,U,1)
  1. ;;R^"860.8:",100,8
  1. ;;D^ ; ;
  1. ;;EOR^
  1. ;;KEY^860.8:^CONVERT DATE FROM OCX FORMAT TO READABLE FORMAT
  1. ;;R^"860.8:",.01,"E"
  1. ;;D^CONVERT DATE FROM OCX FORMAT TO READABLE FORMAT
  1. ;;R^"860.8:",.02,"E"
  1. ;;D^INT2DT
  1. ;;R^"860.8:",1,1
  1. ;;D^ ;INT2DT(OCXDT,OCXF) ; This Local Extrinsic Function converts an OCX internal format
  1. ;;R^"860.8:",1,2
  1. ;;D^ ; ; date into an Externl Format (Human Readable) date. 'OCXF=SHORT FORMAT OCXF=LONG FORMAT
  1. ;;R^"860.8:",1,3
  1. ;;D^ ; ;
  1. ;;R^"860.8:",100,1
  1. ;;D^ ;INT2DT(OCXDT,OCXF) ; This Local Extrinsic Function converts an OCX internal format
  1. ;;R^"860.8:",100,2
  1. ;;D^ ; ; date into an Externl Format (Human Readable) date. 'OCXF=SHORT FORMAT OCXF=LONG FORMAT
  1. ;;R^"860.8:",100,3
  1. ;;D^ ; ;
  1. ;;R^"860.8:",100,4
  1. ;;D^ ; Q:'$L($G(OCXDT)) "" S OCXF=+$G(OCXF)
  1. ;;R^"860.8:",100,5
  1. ;;D^ ; N OCXYR,OCXLPYR,OCXMON,OCXDAY,OCXHR,OCXMIN,OCXSEC,OCXCYR
  1. ;;R^"860.8:",100,6
  1. ;;D^ ; S (OCXYR,OCXLPYR,OCXMON,OCXDAY,OCXHR,OCXMIN,OCXSEC,OCXAP)=""
  1. ;;R^"860.8:",100,7
  1. ;;D^ ; S OCXSEC=$E(OCXDT#60+100,2,3),OCXDT=OCXDT\60
  1. ;;R^"860.8:",100,8
  1. ;;D^ ; S OCXMIN=$E(OCXDT#60+100,2,3),OCXDT=OCXDT\60
  1. ;;R^"860.8:",100,9
  1. ;;D^ ; S OCXHR=$E(OCXDT#24+100,2,3),OCXDT=OCXDT\24
  1. ;;R^"860.8:",100,10
  1. ;;D^ ; S OCXCYR=($H\1461)*4+1841+(($H#1461)\365)
  1. ;;R^"860.8:",100,11
  1. ;;D^ ; S OCXYR=(OCXDT\1461)*4+1841,OCXDT=OCXDT#1461
  1. ;;R^"860.8:",100,12
  1. ;;D^ ; S OCXLPYR=(OCXDT\365),OCXDT=OCXDT-(OCXLPYR*365),OCXYR=OCXYR+OCXLPYR
  1. ;;R^"860.8:",100,13
  1. ;;D^ ; S OCXCNT="031^059^090^120^151^181^212^243^273^304^334^365"
  1. ;1;
  1. ;