source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORY26508.m@ 1801

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

initial load of WorldVistAEHR
File size: 4.7 KB
RevLine 
[613]1ORY26508 ;SLC/JEH - OCX PACKAGE RULE TRANSPORT ROUTINE - PLUS ;NOV 16, 2006 15:00
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**265**;Dec 17,1997;Build 17
3 ;; ;;ORDER CHECK EXPERT version 1.01 released OCT 29,1998
4 ;; ;;Per VHA Directive 2004-038, this routine should not be modified.
5 ;
6 ;
7SCH ; This code will correct the pointer to imaging.
8 N DTIME,DLAYGO,DINUM,DIC,Y,X,IX,OLD,RPTID,DONEX
9 S DIC="^ORD(100.98," ; Find the IEN of IMAGING in the Display File
10 S DIC(0)="N,O,X"
11 S X="IMAGING"
12 D ^DIC
13 I $G(Y) D ; RPT SCHEDULED/DUE ACTIVITY replace IEN for NURSING (13) (found at some sites) with IMAGING IEN
14 . S X=+Y
15 . ;
16 . S (IX,DONEX,RPTID,OLD)=0
17 . S RPTID=$O(^ORD(102.21,"B","RPT SCHEDULED/DUE ACTIVITY",0))
18 . F S IX=$O(^ORD(102.21,RPTID,1,IX)) Q:('IX)!DONEX D
19 . . I $P(^ORD(102.21,RPTID,1,IX,0),U,4)="IMAGING" D
20 . . . I ^ORD(102.21,RPTID,1,IX,1,1,0)'=X D
21 . . . . S OLD=^ORD(102.21,RPTID,1,IX,1,1,0)
22 . . . . S ^ORD(102.21,RPTID,1,IX,1,1,0)=X
23 . . . . K ^ORD(102.21,RPTID,1,IX,1,"B",OLD,1)
24 . . . . S ^ORD(102.21,RPTID,1,IX,1,"B",X,1)="",DONEX=1
25 W !,"FINISHED: UPDATING CPRS QUERY DEFINITION NAME / RPT SCHEDULED/DUE ACTIVITY"
26 W !
27 ;
28OCX ; this code updates the expert system to compile code that allows results with "<>=" in matching the threshold limit.
29 N LINE,UPDATE,TEXT1,TEXT2,ADDTEXT,TTALCNT,CNT
30 S UPDATE=0
31 S TEXT1="",TEXT2=""
32 S TTALCNT=$P(^OCXS(860.8,53,"CODE",0),"^",3)+1
33 S LINE=1
34 S ADDTEXT=$P($T(DATA+1),";",3,40)
35 F S LINE=$O(^OCXS(860.8,53,"CODE",LINE)) Q:(LINE=TTALCNT)!(LINE="")!(LINE]"@") D
36 . I ^OCXS(860.8,53,"CODE",LINE,0)=ADDTEXT S TTALCNT=LINE+1 Q ; If change has already been made
37 . I UPDATE=0,^OCXS(860.8,53,"CODE",LINE,0)=" ; Q:'$G(OCXLAB)!'$G(OCXSPEC)!'$G(OCXRSLT)!'$L($G(OCXOP)) 0" D
38 . . S TEXT1=^OCXS(860.8,53,"CODE",LINE,0)
39 . . S ^OCXS(860.8,53,"CODE",LINE,0)=$P($T(DATA+1),";",3,40)
40 . . S UPDATE=1
41 . . ; Q
42 . I UPDATE=1 D
43 . . S TEXT2=TEXT1
44 . . S CNT=LINE+1
45 . . S TEXT1=$G(^OCXS(860.8,53,"CODE",CNT,0))
46 . . S ^OCXS(860.8,53,"CODE",CNT,0)=TEXT2
47 . . Q:TEXT1=""
48 I UPDATE=1 D
49 . S $P(^OCXS(860.8,53,"CODE",0),"^",3)=TTALCNT
50 . S $P(^OCXS(860.8,53,"CODE",0),"^",4)=TTALCNT
51 . W !,"FINISHED: UPDATING ORDER CHECK COMPILER FUNCTIONS"
52 . W !!,"THE EXPERT SYSTEM WILL NEED TO BE RECOMPILED TO COMPLETE THIS PROCESS"
53 . W !,"PLEASE SEE THE PATCH INSTRUCTION ON RECOMPILING THE EXPERT SYSTEM"
54 I UPDATE=0 W !,"NO UPDATE NEEDED OR MADE TO EXPERT SYSTEM"
55 Q
56 ;
57RECOVER ; RESET TO OLD GLOBAL
58 N LINE,TEXT1,TTALCNT
59 S TEXT1=""
60 S TTALCNT=$P(^OCXS(860.8,53,"CODE",0),"^",3)+1
61 S LINE=0
62 F S LINE=$O(^OCXS(860.8,53,"CODE",LINE)) Q:(LINE=TTALCNT)!(LINE="")!(LINE]"@") D
63 . S TEXT1=$P($T(DATA2+LINE),";",3,40)
64 . S ^OCXS(860.8,53,"CODE",LINE,0)=TEXT1
65 S ^OCXS(860.8,53,"CODE",0)="^^16^16^3060823^"
66 Q
67 ;
68DATA ;
69 ;; ; S OCXRSLT=$TR($G(OCXRSLT),"<>=","")
70 ;
71 ;;^OCXS(860.8,53,0)=LAB THRESHOLD EXCEEDED BOOLEAN^LABTHRSB
72 ;;^OCXS(860.8,53,"CODE",0)=^^17^17^3060823^
73 ;;^OCXS(860.8,53,"CODE",1,0)= ;LABTHRSB(OCXLAB,OCXPEC,OCXRSLT,OCXOP) ;
74 ;;^OCXS(860.8,53,"CODE",2,0)= ; ;
75 ;;^OCXS(860.8,53,"CODE",3,0)= ; S OCXRSLT=$TR($G(OCXRSLT),"<>=","")
76 ;;^OCXS(860.8,53,"CODE",4,0)= ; Q:'$G(OCXLAB)!'$G(OCXPEC)!'$G(OCXRSLT)!'$L($G(OCXOP)) 0
77 ;;^OCXS(860.8,53,"CODE",5,0)= ; ;
78 ;;^OCXS(860.8,53,"CODE",6,0)= ; N OCXX,OCXPENT,OCXERR,OCXLABSP,OCXPVAL,OCXEXCD
79 ;;^OCXS(860.8,53,"CODE",7,0)= ; S OCXEXCD=0,OCXLABSP=OCXLAB_";"_OCXPEC
80 ;;^OCXS(860.8,53,"CODE",8,0)= ; D ENVAL^XPAR(.OCXX,"ORB LAB "_OCXOP_" THRESHOLD",OCXLABSP,.OCXERR)
81 ;;^OCXS(860.8,53,"CODE",9,0)=T+; I $G(OCXTRACE) W !,"Lab parameter values:",! ZW OCXX,OCXERR
82 ;;^OCXS(860.8,53,"CODE",10,0)= ; Q:+$G(ORERR)'=0 OCXEXCD
83 ;;^OCXS(860.8,53,"CODE",11,0)= ; Q:+$G(OCXX)=0 OCXEXCD
84 ;;^OCXS(860.8,53,"CODE",12,0)= ; S OCXPENT="" F S OCXPENT=$O(OCXX(OCXPENT)) Q:'OCXPENT!OCXEXCD=1 D
85 ;;^OCXS(860.8,53,"CODE",13,0)= ; .S OCXPVAL=OCXX(OCXPENT,OCXLABSP)
86 ;;^OCXS(860.8,53,"CODE",14,0)= ; .I $L(OCXPVAL) D
87 ;;^OCXS(860.8,53,"CODE",15,0)= ; ..I $P(OCXPENT,";",2)="VA(200,",@((+OCXRSLT)_OCXOP_OCXPVAL) D
88 ;;^OCXS(860.8,53,"CODE",16,0)= ; ...S OCXEXCD=1
89 ;;^OCXS(860.8,53,"CODE",17,0)= ; Q OCXEXCD
90 ;
91DATA2 ;
92 ;; ;LABTHRSB(OCXLAB,OCXPEC,OCXRSLT,OCXOP) ;
93 ;; ; ;
94 ;; ; Q:'$G(OCXLAB)!'$G(OCXSPEC)!'$G(OCXRSLT)!'$L($G(OCXOP)) 0
95 ;; ; ;
96 ;; ; N OCXX,OCXPENT,OCXERR,OCXLABSP,OCXPVAL,OCXEXCD
97 ;; ; S OCXEXCD=0,OCXLABSP=OCXLAB_";"_OCXPEC
98 ;; ; D ENVAL^XPAR(.OCXX,"ORB LAB "_OCXOP_" THRESHOLD",OCXLABSP,.OCXERR)
99 ;;T+; I $G(OCXTRACE) W !,"Lab parameter values:",! ZW OCXX,OCXERR
100 ;; ; Q:+$G(ORERR)'=0 OCXEXCD
101 ;; ; Q:+$G(OCXX)=0 OCXEXCD
102 ;; ; S OCXPENT="" F S OCXPENT=$O(OCXX(OCXPENT)) Q:'OCXPENT!OCXEXCD=1 D
103 ;; ; .S OCXPVAL=OCXX(OCXPENT,OCXLABSP)
104 ;; ; .I $L(OCXPVAL) D
105 ;; ; ..I $P(OCXPENT,";",2)="VA(200,",@((+OCXRSLT)_OCXOP_OCXPVAL) D
106 ;; ; ...S OCXEXCD=1
107 ;; ; Q OCXEXCD
108 ;
Note: See TracBrowser for help on using the repository browser.