ORERR(ORTYP,ORMSG,ORVAR) ; RJS/SLC-ISC - Order Entry Error Logger ;11/12/97 08:09
;;3.0;ORDER ENTRY/RESULTS REPORTING;;Dec 17, 1997
;
D EN(ORTYP,.ORMSG,.ORVAR)
Q
;
EN(ORTYP,ORMSG,ORVAR) ;
;
N ORARRY,ORD0,ORD1,ORD2,OREF,ORVNAM
;
S ORARRY=$S($L($G(ORMSG)):ORMSG,1:"ORMSG")
;
I '$O(@ORARRY@(0)) S ORARRY="ORARRY",ORARRY(1)="Null HL7 Data Array Found"
;
S ORD0=$O(^ORYX("ORERR","@"),-1)+1,^ORYX("ORERR",ORD0,0)="",OREF="^ORYX(""ORERR"","_ORD0_")"
S @OREF@(0)=$$NOW_U_$G(ION)_U_$G(DUZ)_U_$G(ORTYP,$ZE)_U_$G(ZTSK)
S $P(^ORYX("ORERR",0),U,3)=ORD0,$P(^ORYX("ORERR",0),U,4)=$P(^ORYX("ORERR",0),U,4)+1
;
D ADD(" "),ADD("HL7 Array: "),ADD(" ")
S ORD1="" F S ORD1=$O(@ORARRY@(ORD1)) Q:'ORD1 D
.N ORPC,ORLEN
.S ORLEN=$L($G(@ORARRY@(ORD1)))
.F ORPC=0:1 Q:((ORPC*200)>ORLEN) D
..D ADD($S(ORPC:" ",1:$J(ORD1,3)_": ")_$E(@ORARRY@(ORD1),(ORPC*200+1),(ORPC+1*200)))
.S ORD2="" F S ORD2=$O(@ORARRY@(ORD1,ORD2)) Q:'ORD2 D
..N ORPC,ORLEN
..S ORLEN=$L($G(@ORARRY@(ORD1,ORD2)))
..F ORPC=0:1 Q:((ORPC*200)>ORLEN) D
...D ADD($S(ORPC:" ",1:$J(ORD1,3)_","_$J(ORD2,3)_": ")_$E(@ORARRY@(ORD1),(ORPC*200+1),(ORPC+1*200)))
;
D ADD(" "),ADD("Local Variables: "),ADD(" ")
;
I $D(ORVAR) S ORVNAM="" F S ORVNAM=$O(ORVAR(ORVNAM)) Q:'$L(ORVNAM) I $D(@ORVNAM) D
.I ($D(@ORVNAM)#2) F ORPC=0:1 Q:((ORPC*100)>$L(@ORVNAM)) D
..N ORSP S ORSP=" "
..D ADD($S(ORPC:ORSP,1:$E(ORSP,$L(ORVNAM),12)_ORVNAM_": ")_$E(@ORVNAM,(ORPC*100+1),(ORPC+1*100)))
.S ORVARY=ORVNAM F S ORVARY=$Q(@ORVARY) Q:'$L(ORVARY) Q:'($P(ORVARY,"(",1)=ORVNAM) D
..F ORPC=0:1 Q:((ORPC*100)>$L(@ORVARY)) D
...N ORSP S ORSP=" "
...D ADD($S(ORPC:ORSP,1:$E(ORSP,$L(ORVARY),12)_ORVARY_": ")_$E(@ORVARY,(ORPC*100+1),(ORPC+1*100)))
;
S @OREF@(1,0)=U_U_$O(@OREF@(1,""),-1)_U_$O(@OREF@(1,""),-1)_U_$$TODAY_U
;
Q
;
NOW() N X,Y,%DT S X="N",%DT="T" D ^%DT Q Y
;
TODAY() N X,Y,%DT S X="T",%DT="" D ^%DT Q Y
;
ADD(X) S @OREF@(1,($O(@OREF@(1,""),-1)+1),0)=X Q
;
ORERR(ORTYP,ORMSG,ORVAR) ; RJS/SLC-ISC - Order Entry Error Logger ;11/12/97 08:09
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;;Dec 17, 1997
+2 ;
+3 DO EN(ORTYP,.ORMSG,.ORVAR)
+4 QUIT
+5 ;
EN(ORTYP,ORMSG,ORVAR) ;
+1 ;
+2 NEW ORARRY,ORD0,ORD1,ORD2,OREF,ORVNAM
+3 ;
+4 SET ORARRY=$SELECT($LENGTH($GET(ORMSG)):ORMSG,1:"ORMSG")
+5 ;
+6 IF '$ORDER(@ORARRY@(0))
SET ORARRY="ORARRY"
SET ORARRY(1)="Null HL7 Data Array Found"
+7 ;
+8 SET ORD0=$ORDER(^ORYX("ORERR","@"),-1)+1
SET ^ORYX("ORERR",ORD0,0)=""
SET OREF="^ORYX(""ORERR"","_ORD0_")"
+9 SET @OREF@(0)=$$NOW_U_$G(ION)_U_$GET(DUZ)_U_$GET(ORTYP,$ZE)_U_$GET(ZTSK)
+10 SET $PIECE(^ORYX("ORERR",0),U,3)=ORD0
SET $PIECE(^ORYX("ORERR",0),U,4)=$PIECE(^ORYX("ORERR",0),U,4)+1
+11 ;
+12 DO ADD(" ")
DO ADD("HL7 Array: ")
DO ADD(" ")
+13 SET ORD1=""
FOR
SET ORD1=$ORDER(@ORARRY@(ORD1))
IF 'ORD1
QUIT
Begin DoDot:1
+14 NEW ORPC,ORLEN
+15 SET ORLEN=$LENGTH($GET(@ORARRY@(ORD1)))
+16 FOR ORPC=0:1
IF ((ORPC*200)>ORLEN)
QUIT
Begin DoDot:2
+17 DO ADD($SELECT(ORPC:" ",1:$JUSTIFY(ORD1,3)_": ")_$EXTRACT(@ORARRY@(ORD1),(ORPC*200+1),(ORPC+1*200)))
End DoDot:2
+18 SET ORD2=""
FOR
SET ORD2=$ORDER(@ORARRY@(ORD1,ORD2))
IF 'ORD2
QUIT
Begin DoDot:2
+19 NEW ORPC,ORLEN
+20 SET ORLEN=$LENGTH($GET(@ORARRY@(ORD1,ORD2)))
+21 FOR ORPC=0:1
IF ((ORPC*200)>ORLEN)
QUIT
Begin DoDot:3
+22 DO ADD($SELECT(ORPC:" ",1:$JUSTIFY(ORD1,3)_","_$JUSTIFY(ORD2,3)_": ")_$EXTRACT(@ORARRY@(ORD1),(ORPC*200+1),(ORPC+1*200)))
End DoDot:3
End DoDot:2
End DoDot:1
+23 ;
+24 DO ADD(" ")
DO ADD("Local Variables: ")
DO ADD(" ")
+25 ;
+26 IF $DATA(ORVAR)
SET ORVNAM=""
FOR
SET ORVNAM=$ORDER(ORVAR(ORVNAM))
IF '$LENGTH(ORVNAM)
QUIT
IF $DATA(@ORVNAM)
Begin DoDot:1
+27 IF ($DATA(@ORVNAM)#2)
FOR ORPC=0:1
IF ((ORPC*100)>$LENGTH(@ORVNAM))
QUIT
Begin DoDot:2
+28 NEW ORSP
SET ORSP=" "
+29 DO ADD($SELECT(ORPC:ORSP,1:$EXTRACT(ORSP,$LENGTH(ORVNAM),12)_ORVNAM_": ")_$EXTRACT(@ORVNAM,(ORPC*100+1),(ORPC+1*100)))
End DoDot:2
+30 SET ORVARY=ORVNAM
FOR
SET ORVARY=$QUERY(@ORVARY)
IF '$LENGTH(ORVARY)
QUIT
IF '($PIECE(ORVARY,"(",1)=ORVNAM)
QUIT
Begin DoDot:2
+31 FOR ORPC=0:1
IF ((ORPC*100)>$LENGTH(@ORVARY))
QUIT
Begin DoDot:3
+32 NEW ORSP
SET ORSP=" "
+33 DO ADD($SELECT(ORPC:ORSP,1:$EXTRACT(ORSP,$LENGTH(ORVARY),12)_ORVARY_": ")_$EXTRACT(@ORVARY,(ORPC*100+1),(ORPC+1*100)))
End DoDot:3
End DoDot:2
End DoDot:1
+34 ;
+35 SET @OREF@(1,0)=U_U_$ORDER(@OREF@(1,""),-1)_U_$ORDER(@OREF@(1,""),-1)_U_$$TODAY_U
+36 ;
+37 QUIT
+38 ;
NOW() NEW X,Y,%DT
SET X="N"
SET %DT="T"
DO ^%DT
QUIT Y
+1 ;
TODAY() NEW X,Y,%DT
SET X="T"
SET %DT=""
DO ^%DT
QUIT Y
+1 ;
ADD(X) SET @OREF@(1,($ORDER(@OREF@(1,""),-1)+1),0)=X
QUIT
+1 ;
