OCXOSCR3 ;SLC/RJS,CLA - message xref for the Order Check Patient Rule Event File;1/05/04 14:56
;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,221**;Dec 17,1997
;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
;
Q
;
SET(OCXX,OCXD0,OCXD1) ;
;
N OCXM,OCXC,OCXP,OCXA,OCXO
;
S OCXC=0
S OCXO=+$P($G(^OCXD(860.7,OCXD0,1,OCXD1,0)),U,3)
S OCXM=$G(^OCXD(860.7,OCXD0,1,OCXD1,"M")) Q:'$L(OCXM)
;
F OCXP=1:1:$L(OCXM) D
.S OCXA=$A(OCXM,OCXP)-30 Q:(OCXA<1)
.S OCXC=OCXC+OCXA,OCXC=OCXC+(OCXP-1*100)
;
S ^OCXD(860.7,"AT",OCXX,OCXD0,OCXD1,OCXO,OCXC)=($H*86400)+$P($H,",",2)
;
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HOCXOSCR3 610 printed Nov 22, 2024@17:35:45 Page 2
OCXOSCR3 ;SLC/RJS,CLA - message xref for the Order Check Patient Rule Event File;1/05/04 14:56
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**32,221**;Dec 17,1997
+2 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
+3 ;
+4 QUIT
+5 ;
SET(OCXX,OCXD0,OCXD1) ;
+1 ;
+2 NEW OCXM,OCXC,OCXP,OCXA,OCXO
+3 ;
+4 SET OCXC=0
+5 SET OCXO=+$PIECE($GET(^OCXD(860.7,OCXD0,1,OCXD1,0)),U,3)
+6 SET OCXM=$GET(^OCXD(860.7,OCXD0,1,OCXD1,"M"))
if '$LENGTH(OCXM)
QUIT
+7 ;
+8 FOR OCXP=1:1:$LENGTH(OCXM)
Begin DoDot:1
+9 SET OCXA=$ASCII(OCXM,OCXP)-30
if (OCXA<1)
QUIT
+10 SET OCXC=OCXC+OCXA
SET OCXC=OCXC+(OCXP-1*100)
End DoDot:1
+11 ;
+12 SET ^OCXD(860.7,"AT",OCXX,OCXD0,OCXD1,OCXO,OCXC)=($HOROLOG*86400)+$PIECE($HOROLOG,",",2)
+13 ;
+14 QUIT
+15 ;