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