- 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
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORERR 2014 printed Jan 18, 2025@03:31:45 Page 2
- 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 ;