ORMLR1 ; SLC/MKB - Process Lab ORM msgs cont ;3/20/97  08:22
 ;;3.0;ORDER ENTRY/RESULTS REPORTING;;Dec 17, 1997
XX ; -- add/delete tests
 N OBR,ACTION,CNT,X,Y,I,J,OR0,ORDIALOG,ORDG,OREVENT,ORSTS,ORNP,OI,WP,SAMP,SPEC,TYPE,URG,SIGNED,NTE,LCNT,LAST,OLDIFN,PRMT,PARENT K ^TMP("ORWORD",$J)
 S OBR=$O(@ORMSG@(+ORC)) I 'OBR S ORERR="Missing OBR segment" Q
 S OBR=OBR_U_@ORMSG@(OBR),ACTION=$P(OBR,"|",12)
 S X=$$ORDITEM^ORM($P(OBR,"|",5)) I 'X S ORERR="Invalid test" Q
 S OR0=$G(^OR(100,+ORIFN,0)),ORNP=$P(OR0,U,4),ORDG=$P(OR0,U,11),ORSTS=5
 S:'$G(ORL) ORL=$P(OR0,U,10),ORCAT=$P(OR0,U,12) ; no PV1
 I ACTION=3 D  Q:$D(ORERR)  I CNT=1 D OC^ORMLR Q  ; cancel if only test
 . S (I,Y,CNT)=0
 . F  S I=$O(^OR(100,+ORIFN,.1,I)) Q:I'>0  S CNT=CNT+1 S:X=$G(^(I,0)) Y=1
 . I 'Y S ORERR="Test not found" Q
 S ORDIALOG=+$P(OR0,U,5) D GETDLG1^ORCD(ORDIALOG),GETORDER^ORCD(+ORIFN)
 S OI=$$PTR("OR GTX ORDERABLE ITEM"),WP=$$PTR("OR GTX WORD PROCESSING 1")
 S SAMP=$$PTR("OR GTX COLLECTION SAMPLE"),SPEC=$$PTR("OR GTX SPECIMEN")
 S TYPE=$$PTR("OR GTX COLLECTION TYPE"),URG=$$PTR("OR GTX URGENCY")
XX1 I ACTION=3 S I=0 F  S I=$O(ORDIALOG(OI,I)) Q:I'>0  I ORDIALOG(OI,I)=X F PRMT=OI,SAMP,SPEC,URG,TYPE,WP K ORDIALOG(PRMT,I)
 I ACTION="A" D
 . S LAST=$O(ORDIALOG(OI,"A"),-1),I=LAST+1
 . S I=I+1,ORDIALOG(OI,I)=X,ORDIALOG(TYPE,I)=ORDIALOG(TYPE,LAST)
 . S X=$$FIND^ORM(+OBR,16),ORDIALOG(SAMP,I)=$P(X,";",4)
 . S X=$P(X,";") S:$L(X) ORDIALOG(SPEC,I)=+$O(^LAB(61,"C",X,0))
 . S ORDIALOG(URG,I)=+$P($P($$FIND^ORM(+OBR,28),U,6),";",2)
 . S NTE=$O(@ORMSG@(+OBR)) Q:'NTE  Q:$E(@ORMSG@(NTE),1,3)'="NTE"
 . S LCNT=1,^TMP("ORWORD",$J,WP,I,LCNT,0)=$P(@ORMSG@(NTE),"|",4)
 . I $O(@ORMSG@(NTE,0)) S J=0 F  S J=$O(@ORMSG@(NTE,J)) Q:J'>0  S LCNT=LCNT+1,^TMP("ORWORD",$J,WP,I,LCNT,0)=@ORMSG@(NTE,J)
 . S ^TMP("ORWORD",$J,WP,I,0)="^^"_LCNT_U_LCNT_U_DT_U
 . S ORDIALOG(WP,I)="^TMP(""ORWORD"",$J,"_WP_","_I_")"
XX2 S SIGNED=($P($G(^OR(100,+ORIFN,8,1,0)),U,4)'=2)
 I SIGNED S OLDIFN=+ORIFN K ORIFN
 D EN^ORCSAVE K ^TMP("ORWORD",$J)
 I '$G(ORIFN) S ORERR="Cannot change order" Q
 S ^OR(100,+ORIFN,4)=PKGIFN D:$P(^(8,1,0),U,4)=2 NOTIF^ORCSIGN
 S ORNEW(ORIFN)="1^1" D PRINTS^ORWD1(.ORNEW,+$G(ORL)) ; print chart copy
 I $G(OLDIFN) D  ; clean-up old order
 . S $P(^OR(100,+ORIFN,3),U,5)=OLDIFN D STATUS^ORCSAVE2(OLDIFN,12)
 . S PARENT=$P(^OR(100,OLDIFN,3),U,9) I PARENT S $P(^OR(100,ORIFN,3),U,9)=PARENT K ^OR(100,PARENT,2,OLDIFN) S ^OR(100,PARENT,2,ORIFN,0)=ORIFN
 . D RELEASE^ORCSAVE2(+ORIFN,,ORLOG,ORDUZ),MSG^ORMBLD(ORIFN,"NA")
 Q
 ;
PTR(NAME) ; -- Returns ien of prompt NAME in Order Dialog file #101.41
 Q $O(^ORD(101.41,"AB",$E(NAME,1,63),0))