source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/OR3C100.m@ 1604

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

initial load of WorldVistAEHR

File size: 5.6 KB
RevLine 
[613]1OR3C100 ; SLC/MKB - Orders file conversion for CPRS/OE3 ;8/8/97 15:27
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;;Dec 17, 1997
3ORDERS(ORVP) ; -- Convert all orders for patient ORVP
4 N ORPARAM,ORIDT,ORDG,ORIFN,OR0,OR3,OR6,ORSTRT,ORSTOP,ORSTS,DC,DC0,ORACT,ORCAT,RIFN,ORYD,ORNOW,ORDA,CURR,I S U="^"
5 S ORPARAM=$$GET^XPAR("SYS","ORPF ACTIVE ORDERS CONTEXT HRS",1,"Q")
6ORD1 S ORIDT=0 F S ORIDT=$O(^OR(100,"AO",ORVP,ORIDT)) Q:ORIDT'>0 S ORDG=0 F S ORDG=$O(^OR(100,"AO",ORVP,ORIDT,ORDG)) Q:ORDG'>0 S ORIFN=0 F S ORIFN=$O(^OR(100,"AO",ORVP,ORIDT,ORDG,ORIFN)) Q:ORIFN'>0 D
7 . S OR0=$G(^OR(100,ORIFN,0)),OR3=$G(^(3)),OR6=$G(^(6)) G:'$L(OR0) QQ
8 . I 'ORVP!('$D(^DPT(+ORVP,0)))!('ORDG)!('$D(^ORD(100.98,+ORDG,0))) D CLEAN(ORIFN) G QQ ; bad record
9 . I $P(OR0,U,5)["ORD(101,",$P($G(^ORD(101,+$P(OR0,U,5),0)),U)?1"ORGY ".E S $P(^OR(100,ORIFN,3),U,8)=1 G QQ
10 . S ORSTRT=$P(OR3,U,6),ORSTOP=$P(OR0,U,9),ORSTS=$P(OR3,U,3)
11 . K DC,DC0,ORACT,ORCAT I $D(^OR(100,ORIFN,8)) D ; look for DC order
12 . . S RIFN=0 F S RIFN=$O(^OR(100,ORIFN,8,RIFN)) Q:RIFN'>0 I $D(^OR(100,RIFN,0)),"^1^2^11^"[(U_$P($G(^(3)),U,3)_U),$E($G(^(1,1,0)),1,2)="DC" S DC=RIFN
13 . S ORYD=$$ORYD(ORPARAM),ORNOW=$$NOW^XLFDT
14NW . S ORDA=1,ORACT(ORDA,0)=$P(OR0,U,7)_"^NW^"_$P(OR3,U,7)_U_$P(OR3,U,13)_U_$P(OR3,U,10)_U_$P(OR3,U,12)_U_$P(OR3,U,14)_"^^^^^"_$$NATURE($P(OR0,U,12))_U_$P(OR0,U,6)_U_U_$S($P(OR3,U,3)=11:11,1:"")_U_$P(OR6,U,8,9) ; encrypt ES
15 . S ORACT("C","NW",ORDA)="",CURR=1 D ACT($P(OR0,U,7),$P(OR3,U,13))
16 . I ORSTS,"^1^2^7^14^99^"'[(U_ORSTS_U) D AC($P(OR0,U,7))
17 . I ORYD,"^1^2^7^"[(U_ORSTS_U),ORSTOP'<ORYD D AC($P(OR0,U,7))
18 . I $P(OR6,U)'="" S ORACT(ORDA,3)=$$FLAG(ORIFN)
19 . I ORSTS=11 D BUILD G SET ; build 4.5 nodes if unreleased
20DC . I $G(DC) D ; add DC action
21 . . S ORDA=ORDA+1,DC0=$$DCACTION(DC),ORACT(ORDA,0)=DC0
22 . . S ORACT("C","DC",ORDA)="" D ACT($P(DC0,U),$P(DC0,U,4))
23 . . I $P(DC0,U,15)=11 D AC($P(DC0,U))
24 . . I $P(DC0,U,15)=13,ORYD,$P(DC0,U)'<ORYD D AC($P(DC0,U))
25 . . I $P($G(^OR(100,DC,6)),U)'="" S ORACT(ORDA,3)=$$FLAG(DC)
26 . . K ^OR(100,"AW",ORVP,ORDG,$S($P($G(^OR(100,DC,3)),U,6):$P(^(3),U,6),1:9999999),DC),^OR(100,DC) ; delete DC order
27SET . I $P(OR0,U,14)=+$O(^DIC(9.4,"C","OR",0)) D ORG ; convert text orders
28 . S $P(OR0,U,8)=$P(OR3,U,6),$P(OR0,U,12)=$S($D(ORCAT):ORCAT,1:$$CLASS($P(OR0,U,10))),$P(OR0,U,16,17)=$S($P(OR3,U,13)=3:0,1:2)_U
29 . I $P(OR0,U,14)=+$O(^DIC(9.4,"C","GMRV",0)) S I=+$O(^DIC(9.4,"C","OR",0)) S:I $P(OR0,U,14)=I ; reset pkg to OR, for HL7 msgs
30 . S $P(OR3,U,7)=CURR F I=5,6,10,12,13,14,15 S $P(OR3,U,I)=""
31 . K ^OR(100,ORIFN,6),^(8),^(9) ; Flag/DC, Related Orders, Notifications
32 . S:$P(OR6,U,12) I=$$NATURE($P(OR6,U,11)),^OR(100,ORIFN,6)=$S(I:I,1:$P($G(DC0),U,12))_U_$P(OR6,U,12,13)
33 . S ^OR(100,ORIFN,0)=OR0,^(3)=OR3,^(8,0)="^100.008DA^"_ORDA_U_ORDA M ^OR(100,ORIFN,8)=ORACT
34 . I $D(^OR(100,ORIFN,5)) M ^OR(100,ORIFN,8,1,5)=^OR(100,ORIFN,5) K ^OR(100,ORIFN,5)
35 . I ORSTRT,ORSTRT>ORNOW,ORSTS=8 S ^OR(100,"AD",ORSTRT,ORIFN)=""
36 . I ORSTOP,"^1^2^7^12^13^"'[(U_ORSTS_U) S ^OR(100,"AE",ORSTOP,ORIFN)=""
37QQ . K ^OR(100,"AO",ORVP,ORIDT,ORDG,ORIFN)
38 Q
39 ;
40DCACTION(IFN) ; -- Returns related DC order
41 N OR0,OR3,OR6,X S OR0=$G(^OR(100,IFN,0)),OR3=$G(^(3)),OR6=$G(^(6))
42 S X=$P(OR0,U,7)_"^DC^"_$P(OR3,U,7)_U_$P(OR3,U,13)_U_$P(OR3,U,10)_U_$P(OR3,U,12)_U_$P(OR3,U,14)_"^^^^^"_$$NATURE($P(OR0,U,12))_U_$P(OR0,U,6)_U_U_$S($P(OR3,U,3)=11:11,$P(OR3,U,3)=1:13,1:"")_U_$P(OR6,U,8,9)
43 Q X
44 ;
45FLAG(IFN) ; -- Returns fields for flag
46 N OR6,X S OR6=$G(^OR(100,IFN,6))
47 S X=$P(OR6,U)_U_$P(OR6,U,4)_U_$P(OR6,U,2,3)_U_$P(OR6,U,7)_U_$P(OR6,U,5,6),$P(OR6,U,1,7)="^^^^^^"
48 Q X
49 ;
50NATURE(X) ; -- Returns ptr to #100.02 for nature X
51 N Y S Y=$S(X="":"",1:$O(^ORD(100.02,"C",X,0)))
52 Q Y
53 ;
54AC(X) ; -- Set AC xref
55 S:X ^OR(100,"AC",ORVP,9999999-X,ORIFN,ORDA)=""
56 Q
57 ;
58ACT(X,SIG) ; -- ACT & AS xrefs
59 S:X ^OR(100,"ACT",ORVP,9999999-X,ORDG,ORIFN,ORDA)="",^OR(100,"AF",X,ORIFN,ORDA)=""
60 S:$G(SIG)=2 ^OR(100,"AS",ORVP,9999999-X,ORIFN,ORDA)=""
61 Q
62 ;
63CLASS(LOC) ; -- Returns patient classification for order
64 N X S X=$S($D(ORCAT):ORCAT,1:"I")
65 I +LOC,$P($G(^SC(+LOC,0)),U,3)'="W" S X="O"
66 Q X
67 ;
68ORYD(Y) ; -- Returns Current Orders context hours
69 ; Y = ORPF ACTIVE ORDERS CONTEXT HRS parameter value
70 N X,X1,X2,X3,%,%H
71 I Y S X=$H,X=+X*24+($P(X,",",2)/3600),X2=Y,X1=X-X2,X3=X1#24,X1=X1\24,X2=$J(X3*3600,0,0),%H=X1_","_X2 D YMD^%DTC S Y=+(X_%)
72 Q Y
73 ;
74CLEAN(DA) ; -- Clean up bad entries
75 M ^ORYX("ORDERS",DA)=^OR(100,DA)
76 N DIK S DIK="^OR(100," D ^DIK
77 Q
78 ;
79BUILD ; -- Build Response multiple for unreleased orders
80 N ORPK,ORPKG,ORDIALOG,ORQUIT
81 S ORPKG=$$NMSP^ORCD($P(OR0,U,14)) Q:"PS"[ORPKG
82 S ORPK=$G(^OR(100,ORIFN,4)) K ^(4),^TMP("ORWORD",$J)
83 D ^OR3C100A Q:$G(ORQUIT) D RESPONSE^ORCSAVE ; build, save responses
84 S:$G(ORDIALOG) $P(OR0,U,5)=+ORDIALOG_";ORD(101.41,"
85 K ^TMP("ORWORD",$J)
86 Q
87 ;
88ORG ; -- Convert generic orders from protocols to dialogs
89 I '$O(^OR(100,ORIFN,4.5,0)) D WP Q
90 N PITEM,DITEM,DA,PDA,PTR S PITEM=$P(OR3,U,4)
91 I $S('PITEM:1,PITEM'[";ORD(101,":1,'$D(^ORD(101,+PITEM,0)):1,1:0) D WP Q
92 S DITEM=$$ITEM^ORCONVRT(+PITEM) I 'DITEM D WP Q
93 S DA=0 F S DA=$O(^OR(100,ORIFN,4.5,DA)) Q:DA'>0 S PDA=+$G(^(DA,0)) D
94 . I 'PDA K ^OR(100,ORIFN,4.5,DA) Q
95 . S PTR=+$P($G(^ORD(101.41,DITEM,10,DA,0)),U,2)
96 . S:PTR ^OR(100,ORIFN,4.5,DA,0)=PDA_U_PTR_"^1"
97 S $P(^OR(100,ORIFN,0),U,5)=DITEM_";ORD(101.41,"
98 Q
99 ;
100WP ; -- Save as Word Processing dialog
101 N WP S WP=+$O(^ORD(101.41,"AB","OR GTX WORD PROCESSING 1",0))
102 K ^OR(100,ORIFN,4.5) S ^(4.5,0)="^100.045A^1^1",^(1,0)="1^"_WP_"^1"
103 M ^OR(100,ORIFN,4.5,1,2)=^OR(100,ORIFN,1)
104 N X S X=$G(^OR(100,ORIFN,4.5,1,2,1,0)) I $E(X,1,3)=">> " S X=$E(X,4,999),^(0)=X
105 S $P(^OR(100,ORIFN,0),U,5)=+$O(^ORD(101.41,"AB","OR GXTEXT WORD PROCESSING ORDER",0))_";ORD(101.41,"
106 Q
Note: See TracBrowser for help on using the repository browser.