source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORMPS3.m@ 824

Last change on this file since 824 was 623, checked in by George Lilly, 15 years ago

revised back to 6/30/08 version

File size: 2.2 KB
RevLine 
[623]1ORMPS3 ;SLC/MKB - Process Pharmacy ORM msgs cont ;12/3/03 10:32
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**213**;Dec 17, 1997
3 ;
4PTR(X) ; -- Return ptr to prompt OR GTX X
5 Q +$O(^ORD(101.41,"AB","OR GTX "_X,0))
6 ;
7PARENT ; -- create parent order for backdoor complex renewals
8 ; Expects ORIFN, ORIG, ORDIALOG()
9 ;Q:'$$PATCH^XPDUTL("PSJ*5.0*110")
10 N ORIGDAD,ORIFNDAD,HDR S ORIGDAD=$P($G(^OR(100,ORIG,3)),U,9)
11 Q:ORIGDAD<1 Q:$$DOSES^ORCACT4(ORIGDAD)'>1 ;cont if complex
12 S ORIFNDAD=$P($G(^OR(100,ORIGDAD,3)),U,6) I ORIFNDAD<1 D G P1
13 . N ORIFN D EN^ORCSAVE Q:ORIFN<1
14 . S $P(^OR(100,ORIFN,3),U,5)=ORIGDAD,$P(^(3),U,8)=1,$P(^(3),U,11)=2
15 . S $P(^OR(100,ORIGDAD,3),U,6)=ORIFN,ORIFNDAD=ORIFN
16 . D RELEASE^ORCSAVE2(ORIFN,1,ORLOG,ORDUZ,ORNATR)
17 . D SIGSTS^ORCSAVE2(ORIFN,1),DATES^ORCSAVE2(ORIFN,ORSTRT)
18 . I $P(^OR(100,ORIFN,8,1,0),U,4)=2 S $P(^(0),U,4)="" K ^OR(100,"AS",ORVP,9999999-ORLOG,ORIFN,1) ;sign children instead
19 . ;STATUS updated in SN2^ORMPS from child orders
20P0 ; -- just add conjunction, new dose if DAD already exists
21 N INST,DA,PTR,ID,P,I,J,X
22 S INST=$$DOSES^ORCACT4(ORIFNDAD),DA=$O(^OR(100,ORIFNDAD,4.5,"A"),-1)
23 S PTR=$$PTR("AND/THEN"),ID="CONJ",DA=DA+1
24 S ^OR(100,ORIFNDAD,4.5,DA,0)=U_PTR_U_INST_U_ID,^(1)="A"
25 S ^OR(100,ORIFNDAD,4.5,"ID","CONJ",DA)="",INST=INST+1
26 F P="INSTRUCTIONS","ROUTE","SCHEDULE","DURATION","DOSE","DISPENSE DRUG" D
27 . S PTR=$$PTR(P) Q:'$L($G(ORDIALOG(PTR,1)))
28 . S DA=DA+1,ID=$P($G(^ORD(101.41,PTR,1)),U,3)
29 . S ^OR(100,ORIFNDAD,4.5,DA,0)=U_PTR_U_INST_U_ID,^(1)=ORDIALOG(PTR,1)
30 . S ^OR(100,ORIFNDAD,4.5,"ID",ID,DA)=""
31 S $P(^OR(100,ORIFNDAD,4.5,0),U,3,4)=DA_U_DA
32 S P=$$PTR("SIG"),DA=+$O(^OR(100,ORIFNDAD,4.5,"ID","SIG",0))
33 S I=+$O(^OR(100,ORIFNDAD,4.5,DA,2,""),-1),X=$G(^(I,0)) S:$L(X) X=X_" AND",^(0)=X
34 S J=0 F S J=$O(^TMP("ORWORD",$J,PTR,1,J)) Q:J<1 S I=I+1,^OR(100,ORIFNDAD,4.5,DA,2,I,0)=^TMP("ORWORD",$J,PTR,1,J,0)
35 S $P(^OR(100,ORIFNDAD,4.5,DA,2,0),U,3,4)=I_U_I
36 ; -- rebuild order text w/new SIG
37 K ^TMP("ORWORD",$J,PTR) M ^TMP("ORWORD",$J,PTR,1)=^OR(100,ORIFNDAD,4.5,DA,2)
38 K ^OR(100,ORIFNDAD,8,1,.1) D ORDTEXT^ORCSAVE1(ORIFNDAD_";1")
39P1 ; -- set up links
40 S $P(^OR(100,ORIFN,3),U,9)=ORIFNDAD
41 S HDR=$G(^OR(100,ORIFNDAD,2,0)),^(0)="^100.002PA^"_ORIFN_U_($P(HDR,U,4)+1),^(ORIFN,0)=ORIFN
42 Q
Note: See TracBrowser for help on using the repository browser.