source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORMLR1.m

Last change on this file was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.5 KB
Line 
1ORMLR1 ; SLC/MKB - Process Lab ORM msgs cont ;3/20/97 08:22
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;;Dec 17, 1997
3XX ; -- 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")
18XX1 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_")"
30XX2 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 ;
42PTR(NAME) ; -- Returns ien of prompt NAME in Order Dialog file #101.41
43 Q $O(^ORD(101.41,"AB",$E(NAME,1,63),0))
Note: See TracBrowser for help on using the repository browser.