OCXDI02H ;SLC/RJS,CLA - OCX PACKAGE DIAGNOSTIC ROUTINES ;SEP 7,1999 at 10:30
;;3.0;ORDER ENTRY/RESULTS REPORTING;**32**;Dec 17,1997
;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
;
S ;
;
D DOT^OCXDIAG
;
;
K REMOTE,LOCAL,OPCODE,REF
F LINE=1:1:500 S TEXT=$P($T(DATA+LINE),";",2,999) Q:TEXT I $L(TEXT) D Q:QUIT
.S ^TMP("OCXDIAG",$J,$O(^TMP("OCXDIAG",$J,"A"),-1)+1)=TEXT
;
G ^OCXDI02I
;
Q
;
DATA ;
;
;;D^ ; ;
;;R^"860.8:",100,6
;;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
;;R^"860.8:",100,7
;;D^ ; .S OCXD0=0 F S OCXD0=$O(^ORD(101.43,"S."_OCXPKG,OCXD0)) Q:'OCXD0 S OCXLIST=OCXLIST_U_OCXD0
;;R^"860.8:",100,8
;;D^ ; Q OCXLIST
;;R^"860.8:",100,9
;;D^ ; ;
;;EOR^
;;KEY^860.8:^LOG DATA FIELD WITH VALUE
;;R^"860.8:",.01,"E"
;;D^LOG DATA FIELD WITH VALUE
;;R^"860.8:",.02,"E"
;;D^LOGDF
;;R^"860.8:",100,1
;;D^ ;LOGDF(DFLD,CONTEXT,VALUE) ;
;;R^"860.8:",100,2
;;D^ ; ;
;;R^"860.8:",100,3
;;D^ ; I $G(DFLD),$G(CONTEXT),$L($G(VALUE)) D
;;R^"860.8:",100,4
;;D^ ; .Q:'$D(^OCXS(860.4,DFLD,0))
;;R^"860.8:",100,5
;;D^ ; .S ^OCXS(860.4,DFLD,"LINK",CONTEXT,"STAT")=$G(^OCXS(860.4,DFLD,"LINK",CONTEXT,"STAT"))+1
;;R^"860.8:",100,6
;;D^ ; Q 0
;;EOR^
;;KEY^860.8:^EXTERNAL TO OERR PACKAGE
;;R^"860.8:",.01,"E"
;;D^EXTERNAL TO OERR PACKAGE
;;R^"860.8:",.02,"E"
;;D^EXTOERR
;;R^"860.8:",100,1
;;D^EXTOERR(PKG1,PKG2) ;
;;R^"860.8:",100,2
;;D^ ;
;;R^"860.8:",100,3
;;D^ I $L($G(PKG1)),'(PKG1="ORDER ENTRY") Q PKG1
;;R^"860.8:",100,4
;;D^ Q $G(PKG2)
;;R^"860.8:",100,5
;;D^ ;
;;EOR^
;;KEY^860.8:^STRING CONTAINS ONE OF A LIST OF VALUES
;;R^"860.8:",.01,"E"
;;D^STRING CONTAINS ONE OF A LIST OF VALUES
;;R^"860.8:",.02,"E"
;;D^CLIST
;;R^"860.8:",100,1
;;D^ ;CLIST(DATA,LIST) ; DOES THE DATA FIELD CONTAIN AN ELEMENT IN THE LIST
;;R^"860.8:",100,2
;;D^ ; ;
;;R^"860.8:",100,3
;;D^T+; W:$G(OCXTRACE) !!,"$$CLIST(",DATA,",""",LIST,""")"
;;R^"860.8:",100,4
;;D^ ; N PC F PC=1:1:$L(LIST,","),0 I PC,$L($P(LIST,",",PC)),(DATA[$P(LIST,",",PC)) Q
;;R^"860.8:",100,5
;;D^ ; Q ''PC
;;EOR^
;;KEY^860.8:^GET WARD SERVICE
;;R^"860.8:",.01,"E"
;;D^GET WARD SERVICE
;;R^"860.8:",.02,"E"
;;D^WARDSERV
;;R^"860.8:",100,1
;;D^ ;WARDSERV(WARD) ;
;;R^"860.8:",100,2
;;D^ ; ;
;;R^"860.8:",100,3
;;D^ ; N CODESET,PC,SERV,DIC,X,Y,DA
;;R^"860.8:",100,4
;;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"
;;R^"860.8:",100,5
;;D^ ; S DIC=42,DIC(0)="NZ",X="`"_(+WARD) D ^DIC Q:(Y<1) ""
;;R^"860.8:",100,6
;;D^ ; S SERV=$P($G(Y(0)),U,3)
;;R^"860.8:",100,7
;;D^ ; Q:'$L(SERV) "" Q:'$L(CODESET) ""
;;R^"860.8:",100,8
;;D^ ; F PC=1:1:$L(CODESET,";"),0 I PC,($P($P(CODESET,";",PC),":",1)=SERV) Q
;;R^"860.8:",100,9
;;D^ ; Q:'PC "" Q $P($P(CODESET,";",PC),":",2)
;;R^"860.8:",100,10
;;D^ ; ;
;;EOR^
;;KEY^860.8:^GET ORDERABLE ITEM FROM ORDER NUMBER
;;R^"860.8:",.01,"E"
;;D^GET ORDERABLE ITEM FROM ORDER NUMBER
;;R^"860.8:",.02,"E"
;;D^ORDITEM
;;R^"860.8:",100,1
;;D^ ;ORDITEM(OIEN) ;
;;R^"860.8:",100,2
;;D^ ;
;;R^"860.8:",100,3
;;D^ ; Q:'$G(OIEN) ""
;;R^"860.8:",100,4
;;D^ ; ;
;;R^"860.8:",100,5
;;D^ ; N OITXT,X S OITXT=$$OI^ORQOR2(OIEN) Q:'OITXT "No orderable item found."
;;R^"860.8:",100,6
;;D^ ; S X=$G(^ORD(101.43,+OITXT,0)) Q:'$L(X) "No orderable item found."
;;R^"860.8:",100,7
;;D^ ; Q $P(X,U,1)
;;R^"860.8:",100,8
;;D^ ; ;
;;EOR^
;;KEY^860.8:^CONVERT DATE FROM OCX FORMAT TO READABLE FORMAT
;;R^"860.8:",.01,"E"
;;D^CONVERT DATE FROM OCX FORMAT TO READABLE FORMAT
;;R^"860.8:",.02,"E"
;;D^INT2DT
;;R^"860.8:",1,1
;;D^ ;INT2DT(OCXDT,OCXF) ; This Local Extrinsic Function converts an OCX internal format
;;R^"860.8:",1,2
;;D^ ; ; date into an Externl Format (Human Readable) date. 'OCXF=SHORT FORMAT OCXF=LONG FORMAT
;;R^"860.8:",1,3
;;D^ ; ;
;;R^"860.8:",100,1
;;D^ ;INT2DT(OCXDT,OCXF) ; This Local Extrinsic Function converts an OCX internal format
;;R^"860.8:",100,2
;;D^ ; ; date into an Externl Format (Human Readable) date. 'OCXF=SHORT FORMAT OCXF=LONG FORMAT
;;R^"860.8:",100,3
;;D^ ; ;
;;R^"860.8:",100,4
;;D^ ; Q:'$L($G(OCXDT)) "" S OCXF=+$G(OCXF)
;;R^"860.8:",100,5
;;D^ ; N OCXYR,OCXLPYR,OCXMON,OCXDAY,OCXHR,OCXMIN,OCXSEC,OCXCYR
;;R^"860.8:",100,6
;;D^ ; S (OCXYR,OCXLPYR,OCXMON,OCXDAY,OCXHR,OCXMIN,OCXSEC,OCXAP)=""
;;R^"860.8:",100,7
;;D^ ; S OCXSEC=$E(OCXDT#60+100,2,3),OCXDT=OCXDT\60
;;R^"860.8:",100,8
;;D^ ; S OCXMIN=$E(OCXDT#60+100,2,3),OCXDT=OCXDT\60
;;R^"860.8:",100,9
;;D^ ; S OCXHR=$E(OCXDT#24+100,2,3),OCXDT=OCXDT\24
;;R^"860.8:",100,10
;;D^ ; S OCXCYR=($H\1461)*4+1841+(($H#1461)\365)
;;R^"860.8:",100,11
;;D^ ; S OCXYR=(OCXDT\1461)*4+1841,OCXDT=OCXDT#1461
;;R^"860.8:",100,12
;;D^ ; S OCXLPYR=(OCXDT\365),OCXDT=OCXDT-(OCXLPYR*365),OCXYR=OCXYR+OCXLPYR
;;R^"860.8:",100,13
;;D^ ; S OCXCNT="031^059^090^120^151^181^212^243^273^304^334^365"
;1;
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HOCXDI02H 5216 printed Nov 22, 2024@17:33:55 Page 2
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
+2 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
+3 ;
S ;
+1 ;
+2 DO DOT^OCXDIAG
+3 ;
+4 ;
+5 KILL REMOTE,LOCAL,OPCODE,REF
+6 FOR LINE=1:1:500
SET TEXT=$PIECE($TEXT(DATA+LINE),";",2,999)
if TEXT
QUIT
IF $LENGTH(TEXT)
Begin DoDot:1
+7 SET ^TMP("OCXDIAG",$JOB,$ORDER(^TMP("OCXDIAG",$JOB,"A"),-1)+1)=TEXT
End DoDot:1
if QUIT
QUIT
+8 ;
+9 GOTO ^OCXDI02I
+10 ;
+11 QUIT
+12 ;
DATA ;
+1 ;
+2 ;;D^ ; ;
+3 ;;R^"860.8:",100,6
+4 ;;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
+5 ;;R^"860.8:",100,7
+6 ;;D^ ; .S OCXD0=0 F S OCXD0=$O(^ORD(101.43,"S."_OCXPKG,OCXD0)) Q:'OCXD0 S OCXLIST=OCXLIST_U_OCXD0
+7 ;;R^"860.8:",100,8
+8 ;;D^ ; Q OCXLIST
+9 ;;R^"860.8:",100,9
+10 ;;D^ ; ;
+11 ;;EOR^
+12 ;;KEY^860.8:^LOG DATA FIELD WITH VALUE
+13 ;;R^"860.8:",.01,"E"
+14 ;;D^LOG DATA FIELD WITH VALUE
+15 ;;R^"860.8:",.02,"E"
+16 ;;D^LOGDF
+17 ;;R^"860.8:",100,1
+18 ;;D^ ;LOGDF(DFLD,CONTEXT,VALUE) ;
+19 ;;R^"860.8:",100,2
+20 ;;D^ ; ;
+21 ;;R^"860.8:",100,3
+22 ;;D^ ; I $G(DFLD),$G(CONTEXT),$L($G(VALUE)) D
+23 ;;R^"860.8:",100,4
+24 ;;D^ ; .Q:'$D(^OCXS(860.4,DFLD,0))
+25 ;;R^"860.8:",100,5
+26 ;;D^ ; .S ^OCXS(860.4,DFLD,"LINK",CONTEXT,"STAT")=$G(^OCXS(860.4,DFLD,"LINK",CONTEXT,"STAT"))+1
+27 ;;R^"860.8:",100,6
+28 ;;D^ ; Q 0
+29 ;;EOR^
+30 ;;KEY^860.8:^EXTERNAL TO OERR PACKAGE
+31 ;;R^"860.8:",.01,"E"
+32 ;;D^EXTERNAL TO OERR PACKAGE
+33 ;;R^"860.8:",.02,"E"
+34 ;;D^EXTOERR
+35 ;;R^"860.8:",100,1
+36 ;;D^EXTOERR(PKG1,PKG2) ;
+37 ;;R^"860.8:",100,2
+38 ;;D^ ;
+39 ;;R^"860.8:",100,3
+40 ;;D^ I $L($G(PKG1)),'(PKG1="ORDER ENTRY") Q PKG1
+41 ;;R^"860.8:",100,4
+42 ;;D^ Q $G(PKG2)
+43 ;;R^"860.8:",100,5
+44 ;;D^ ;
+45 ;;EOR^
+46 ;;KEY^860.8:^STRING CONTAINS ONE OF A LIST OF VALUES
+47 ;;R^"860.8:",.01,"E"
+48 ;;D^STRING CONTAINS ONE OF A LIST OF VALUES
+49 ;;R^"860.8:",.02,"E"
+50 ;;D^CLIST
+51 ;;R^"860.8:",100,1
+52 ;;D^ ;CLIST(DATA,LIST) ; DOES THE DATA FIELD CONTAIN AN ELEMENT IN THE LIST
+53 ;;R^"860.8:",100,2
+54 ;;D^ ; ;
+55 ;;R^"860.8:",100,3
+56 ;;D^T+; W:$G(OCXTRACE) !!,"$$CLIST(",DATA,",""",LIST,""")"
+57 ;;R^"860.8:",100,4
+58 ;;D^ ; N PC F PC=1:1:$L(LIST,","),0 I PC,$L($P(LIST,",",PC)),(DATA[$P(LIST,",",PC)) Q
+59 ;;R^"860.8:",100,5
+60 ;;D^ ; Q ''PC
+61 ;;EOR^
+62 ;;KEY^860.8:^GET WARD SERVICE
+63 ;;R^"860.8:",.01,"E"
+64 ;;D^GET WARD SERVICE
+65 ;;R^"860.8:",.02,"E"
+66 ;;D^WARDSERV
+67 ;;R^"860.8:",100,1
+68 ;;D^ ;WARDSERV(WARD) ;
+69 ;;R^"860.8:",100,2
+70 ;;D^ ; ;
+71 ;;R^"860.8:",100,3
+72 ;;D^ ; N CODESET,PC,SERV,DIC,X,Y,DA
+73 ;;R^"860.8:",100,4
+74 ;;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"
+75 ;;R^"860.8:",100,5
+76 ;;D^ ; S DIC=42,DIC(0)="NZ",X="`"_(+WARD) D ^DIC Q:(Y<1) ""
+77 ;;R^"860.8:",100,6
+78 ;;D^ ; S SERV=$P($G(Y(0)),U,3)
+79 ;;R^"860.8:",100,7
+80 ;;D^ ; Q:'$L(SERV) "" Q:'$L(CODESET) ""
+81 ;;R^"860.8:",100,8
+82 ;;D^ ; F PC=1:1:$L(CODESET,";"),0 I PC,($P($P(CODESET,";",PC),":",1)=SERV) Q
+83 ;;R^"860.8:",100,9
+84 ;;D^ ; Q:'PC "" Q $P($P(CODESET,";",PC),":",2)
+85 ;;R^"860.8:",100,10
+86 ;;D^ ; ;
+87 ;;EOR^
+88 ;;KEY^860.8:^GET ORDERABLE ITEM FROM ORDER NUMBER
+89 ;;R^"860.8:",.01,"E"
+90 ;;D^GET ORDERABLE ITEM FROM ORDER NUMBER
+91 ;;R^"860.8:",.02,"E"
+92 ;;D^ORDITEM
+93 ;;R^"860.8:",100,1
+94 ;;D^ ;ORDITEM(OIEN) ;
+95 ;;R^"860.8:",100,2
+96 ;;D^ ;
+97 ;;R^"860.8:",100,3
+98 ;;D^ ; Q:'$G(OIEN) ""
+99 ;;R^"860.8:",100,4
+100 ;;D^ ; ;
+101 ;;R^"860.8:",100,5
+102 ;;D^ ; N OITXT,X S OITXT=$$OI^ORQOR2(OIEN) Q:'OITXT "No orderable item found."
+103 ;;R^"860.8:",100,6
+104 ;;D^ ; S X=$G(^ORD(101.43,+OITXT,0)) Q:'$L(X) "No orderable item found."
+105 ;;R^"860.8:",100,7
+106 ;;D^ ; Q $P(X,U,1)
+107 ;;R^"860.8:",100,8
+108 ;;D^ ; ;
+109 ;;EOR^
+110 ;;KEY^860.8:^CONVERT DATE FROM OCX FORMAT TO READABLE FORMAT
+111 ;;R^"860.8:",.01,"E"
+112 ;;D^CONVERT DATE FROM OCX FORMAT TO READABLE FORMAT
+113 ;;R^"860.8:",.02,"E"
+114 ;;D^INT2DT
+115 ;;R^"860.8:",1,1
+116 ;;D^ ;INT2DT(OCXDT,OCXF) ; This Local Extrinsic Function converts an OCX internal format
+117 ;;R^"860.8:",1,2
+118 ;;D^ ; ; date into an Externl Format (Human Readable) date. 'OCXF=SHORT FORMAT OCXF=LONG FORMAT
+119 ;;R^"860.8:",1,3
+120 ;;D^ ; ;
+121 ;;R^"860.8:",100,1
+122 ;;D^ ;INT2DT(OCXDT,OCXF) ; This Local Extrinsic Function converts an OCX internal format
+123 ;;R^"860.8:",100,2
+124 ;;D^ ; ; date into an Externl Format (Human Readable) date. 'OCXF=SHORT FORMAT OCXF=LONG FORMAT
+125 ;;R^"860.8:",100,3
+126 ;;D^ ; ;
+127 ;;R^"860.8:",100,4
+128 ;;D^ ; Q:'$L($G(OCXDT)) "" S OCXF=+$G(OCXF)
+129 ;;R^"860.8:",100,5
+130 ;;D^ ; N OCXYR,OCXLPYR,OCXMON,OCXDAY,OCXHR,OCXMIN,OCXSEC,OCXCYR
+131 ;;R^"860.8:",100,6
+132 ;;D^ ; S (OCXYR,OCXLPYR,OCXMON,OCXDAY,OCXHR,OCXMIN,OCXSEC,OCXAP)=""
+133 ;;R^"860.8:",100,7
+134 ;;D^ ; S OCXSEC=$E(OCXDT#60+100,2,3),OCXDT=OCXDT\60
+135 ;;R^"860.8:",100,8
+136 ;;D^ ; S OCXMIN=$E(OCXDT#60+100,2,3),OCXDT=OCXDT\60
+137 ;;R^"860.8:",100,9
+138 ;;D^ ; S OCXHR=$E(OCXDT#24+100,2,3),OCXDT=OCXDT\24
+139 ;;R^"860.8:",100,10
+140 ;;D^ ; S OCXCYR=($H\1461)*4+1841+(($H#1461)\365)
+141 ;;R^"860.8:",100,11
+142 ;;D^ ; S OCXYR=(OCXDT\1461)*4+1841,OCXDT=OCXDT#1461
+143 ;;R^"860.8:",100,12
+144 ;;D^ ; S OCXLPYR=(OCXDT\365),OCXDT=OCXDT-(OCXLPYR*365),OCXYR=OCXYR+OCXLPYR
+145 ;;R^"860.8:",100,13
+146 ;;D^ ; S OCXCNT="031^059^090^120^151^181^212^243^273^304^334^365"
+147 ;1;
+148 ;
