source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORCONVRT.m@ 1697

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

initial load of FOIAVistA 6/30/08 version
File size: 7.0 KB
Line 
1ORCONVRT ; SLC/MKB - Convert protocols/menus to Dialogs ;9/15/97 15:38
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**14**;Dec 17, 1997
3EN ; -- Loop thru protocol menus currently in use
4 Q:$P($G(^ORD(100.99,1,200)),U,2) ; completed
5 N ORDUZ,ORPMENU,ORDMENU,ORNDNG,ORMNAM
6 S ORPMENU=$P($G(^ORD(100.99,1,0)),U,9) ; site default menu
7 I ORPMENU["ORD(101," S ORDMENU=$$MENU(+ORPMENU) D:ORDMENU EN^XPAR("SYS","OR ADD ORDERS MENU",1,"`"_ORDMENU)
8 S ORDUZ=+$G(^ORD(100.99,1,200)) Q:ORDUZ<0 ; done
9 F S ORDUZ=$O(^VA(200,ORDUZ)) Q:ORDUZ'>0 D D LAST(ORDUZ)
10 . S ORPMENU=$P($G(^VA(200,ORDUZ,100.1)),U,2) Q:'ORPMENU ; no menu
11 . S ORDMENU=$$MENU(ORPMENU) W:IOST?1"C-".E "."
12 . D:ORDMENU EN^XPAR(ORDUZ_";VA(200,","OR ADD ORDERS MENU",1,"`"_ORDMENU)
13 D LAST(-1)
14 ; convert defaults if needed
15 F ORNDNG="CLINICIAN","NURSE","WARD CLERK" D
16 . S ORMNAM="ORZ ADD MENU "_ORNDNG
17 . Q:'$O(^ORD(101,"B",ORMNAM,0))!$O(^ORD(101.41,"AB",ORMNAM,0))
18 . S ORPMENU=$O(^ORD(101,"B",ORMNAM,0)),ORDMENU=$$MENU(+ORPMENU)
19 D END
20 Q
21 ;
22LAST(USER) ; -- Save last user preference converted
23 S ^ORD(100.99,1,200)=USER_U_$S(USER<0:1,1:"")
24 Q
25 ;
26MENU(PMENU) ; -- Returns dialog ifn for PMENU protocol
27 N DMENU,XQORM,ORPOS,XUTL,PITEM,DITEM,ROW,COL,POS,NODE0,NODE4,TYPE,FRMT,PITM0,I
28 S NODE0=$G(^ORD(101,PMENU,0)),NODE4=$G(^(4)),TYPE=$P(NODE0,U,4),DMENU=""
29 G:'$L(NODE0) MNQ G:'$L($P(NODE0,U)) MNQ ; protocol deleted
30 S DMENU=$O(^ORD(101.41,"AB",$E($P(NODE0,U),1,63),0))
31 I DMENU,$P($G(^ORD(100.99,1,101,PMENU,0)),U,2)<0 G MNQ ; done
32 S DMENU=$$DIALOG(PMENU) I 'DMENU S PITEM=PMENU D DLG G MNQ
33 S ^ORD(101.41,DMENU,0)=$P(NODE0,U,1,3)_"^M",^(5)=$P(NODE4,U,1,3)
34 S XQORM=PMENU_";ORD(101," D XREF^XQORM ;force ^XUTL to rebuild
35 S ORPOS=+$P($G(^ORD(100.99,1,101,PMENU,0)),U,2)
36MN1 F S ORPOS=$O(^XUTL("XQORM",XQORM,ORPOS)) Q:ORPOS'>0 D S ^ORD(100.99,1,101,PMENU,0)=PMENU_U_ORPOS
37 . S XUTL=$G(^XUTL("XQORM",XQORM,ORPOS,0)),PITEM=+$P(XUTL,U,2)
38 . Q:'PITEM S PITM0=$G(^ORD(101,PITEM,0))
39 . S ROW=$P(ORPOS,"."),COL=$P(ORPOS,".",2),POS=ROW_"."_COL
40 . S FRMT=$S($P(XUTL,U,5)="O":1,$P(XUTL,U,5)="H":2,$P(PITM0,U)?1"ORB BLANK LINE".E:1,$P(PITM0,U,4)="T":1,1:""),DITEM="" Q:FRMT&($P(XUTL,U,3)?1." ")
41 . I FRMT Q:$D(^ORD(101.41,DMENU,10,"B",POS)) ;already added
42 . I 'FRMT S DITEM=$$ITEM(PITEM) Q:'DITEM Q:$D(^ORD(101.41,"AD",DITEM,DMENU))
43 . S DA=$$NEXT(DMENU),^ORD(101.41,DMENU,10,DA,0)=POS_U_DITEM_U_$P(XUTL,U,4)_U_$P(XUTL,U,3)_U_FRMT,^ORD(101.41,DMENU,10,"B",POS,DA)=""
44 . S:DITEM ^ORD(101.41,"AD",DITEM,DMENU,DA)="",^ORD(101.41,DMENU,10,"D",DITEM,DA)=""
45 S ^ORD(100.99,1,101,PMENU,0)=PMENU_"^-1" ; done
46 I $L($G(^ORD(101,PMENU,15)))!$L($G(^(20))) D
47 . Q:$G(^ORD(101,PMENU,15))="K ORSPU"&($G(^(20))="S XQORFLG(""SH"")=1 D EN^OR3")
48 . D MCODE
49MNQ Q DMENU
50 ;
51NEXT(MENU,DINUM) ; -- Returns next available item DA
52 N I,HDR,LAST,TOTAL,DA
53 S HDR=$G(^ORD(101.41,MENU,10,0)) S:HDR="" HDR="^101.412IA^^"
54 S LAST=+$P(HDR,U,3),TOTAL=+$P(HDR,U,4)
55 I $G(DINUM),'$D(^ORD(101.41,MENU,10,DINUM,0)) S I=DINUM
56 E F I=(LAST+1):1 Q:'$D(^ORD(101.41,MENU,10,I,0))
57 S DA=I,$P(HDR,U,3,4)=DA_U_(TOTAL+1),^ORD(101.41,MENU,10,0)=HDR
58 Q DA
59 ;
60ITEM(PITEM) ; -- Returns ifn of dialog for PITEM protocol
61 N DITEM,NAME,NMSP,TYPE
62 S DITEM=$G(^ORD(101,PITEM,0)),TYPE=$P(DITEM,U,4),NAME=$P(DITEM,U)
63 I '$L(NAME) S DITEM="" G ITQ ; protocol deleted
64 I TYPE'?1U D PROTCL S DITEM="" G ITQ ; missing type
65 S NMSP=$$GET1^DIQ(9.4,+$P(DITEM,U,12)_",",1),DITEM=""
66 I (TYPE="Q")!(TYPE="M") S DITEM=$$MENU(PITEM) G ITQ ; sub-menu
67 S DITEM=$O(^ORD(101.41,"AB",$E(NAME,1,63),0)) G:DITEM ITQ ; done
68 I TYPE="D" D DLG^ORCONV0 G ITQ ; dialog
69 I TYPE="X" D SET^ORCONV0 G ITQ ; extended action -> order set
70 I TYPE'="O",TYPE'="L",TYPE'="A" S DITEM="" G ITQ ; not orderable
71 D EN^ORCONV1 ; pkg quick orders
72ITQ Q DITEM
73 ;
74INACTIVE(Y) ; -- Returns 1 or 0, if OrdItem is inactive
75 N IDT S IDT=$G(^ORD(101.43,+Y,.1))
76 I 'IDT Q 0
77 I IDT>$$NOW^XLFDT Q 0
78 Q 1
79 ;
80DIALOG(IFN) ; -- Returns ifn of dialog entry for protocol IFN
81 N X,Y,DIC,DLAYGO,DD,DO,Z,NODE,TEXT
82 S NODE=$G(^ORD(101,IFN,0)),X=$E($P(NODE,U),1,63) I X="" Q X
83 S TEXT=$P(NODE,U,2) S:'$L(TEXT) TEXT=X
84 I TEXT?1"Default Protocol for Rad".E,X?1"RA"1.N.E S TEXT=$$LOWER^VALM1($P(X," ",2,99))
85 I $P(NODE,U,4)="T" S Z=$P($G(^ORD(101,IFN,101.04)),U,2) S:$L(Z) TEXT=Z_": " ;default prompt
86 S DIC="^ORD(101.41,",DIC(0)="LX",DLAYGO=101.41 D ^DIC
87 S Z=$S(Y>0:+Y,1:"")
88 I Z S ^ORD(101.41,Z,0)=X_U_TEXT,^ORD(101.41,"C",$$UP^XLFSTR(TEXT),Z)="" M ^ORD(101.41,Z,2)=^ORD(101,IFN,1)
89 Q Z
90 ;
91SET(PROMPT,VALUE,INST) ; -- Sets VALUE of PROMPT,INST in DEFAULT dlg into DITEM responses
92 N P,D,TYPE
93 S P=$O(^ORD(101.41,"AB",$E("OR GTX "_PROMPT,1,63),0)) Q:'P
94 S D=$O(^ORD(101.41,DEFAULT,10,"D",+P,0)) Q:'D
95 S CNT=$G(CNT)+1,^ORD(101.41,DITEM,6,CNT,0)=D_U_P_U_$S($G(INST):INST,1:1)
96 S:$L(P) ^ORD(101.41,DITEM,6,"D",P,CNT)=""
97 S TYPE=$P(^ORD(101.41,+P,1),U)
98 I TYPE'="W" S ^ORD(101.41,DITEM,6,CNT,1)=VALUE
99 I TYPE="W" M ^ORD(101.41,DITEM,6,CNT,2)=@VALUE
100 Q
101 ;
102VALUE(STR,BEG) ; -- Return value of "var="
103 N X,Y,I S X=$E(STR,BEG,999),Y=""
104 S:$E(X)="""" X=$E(X,2,999) ; strip leading "
105 F I=1:1:$L(X) S Z=$E(X,I) Q:(Z=",")!(Z=" ")!(Z="""") S Y=Y_Z
106 Q Y
107 ;
108ERRORS ; -- Error messages:
109UNKPKG S ^ORD(100.99,1,101.41,PITEM,0)=PITEM_"^Unknown application protocol." Q
110NONSTD S ^ORD(100.99,1,101.41,PITEM,0)=PITEM_"^Non-standard application protocol format." Q
111PROTCL S ^ORD(100.99,1,101.41,PITEM,0)=PITEM_"^Missing required data in protocol." Q
112UNABLE S ^ORD(100.99,1,101.41,PITEM,0)=PITEM_"^Unable to convert quick order." Q
113DLG S ^ORD(100.99,1,101.41,PITEM,0)=PITEM_"^Unable to create a new entry in Order Dialog file." Q
114OI S ^ORD(100.99,1,101.41,PITEM,0)=PITEM_U_$S($G(DITEM):"Incomplete dialog entry - ",1:"")_"Missing or invalid orderable item(s)." Q
115PROMPT S ^ORD(100.99,1,101.41,PITEM,0)=PITEM_"^Incomplete dialog entry - unable to create or match term to dialog prompt." Q
116DUPL S ^ORD(100.99,1,101.41,PITEM,0)=PITEM_"^Incomplete dialog entry - duplicate prompt in Items." Q
117STRTDT S ^ORD(100.99,1,101.41,PITEM,0)=PITEM_"^Incomplete dialog entry - unable to determine 'start date'." Q
118MCODE S ^ORD(100.99,1,101.41,PITEM,0)=PITEM_"^Incomplete dialog entry - Entry or Exit Action present in menu." Q
119 ;
120END ; -- Send bulletin listing conversion problems
121 N ORTEXT,CNT,IFN,ORERR K ^TMP("ORTEXT",$J)
122 S (IFN,CNT)=0 F S IFN=$O(^ORD(100.99,1,101,IFN)) Q:IFN'>0 S CNT=CNT+1
123 S:CNT ^ORD(100.99,1,101,0)="^100.99101P^"_CNT_U_CNT S CNT=0
124 S IFN=0 F S IFN=$O(^ORD(100.99,1,101.41,IFN)) Q:IFN'>0 S CNT=CNT+1
125 S:CNT ^ORD(100.99,1,101.41,0)="^100.99141P^"_CNT_U_CNT Q:CNT'>0
126 S ORTEXT(1)=CNT_" protocols could not be converted."
127 S ORTEXT(2)="These will be sent to "_$P(^VA(200,DUZ,0),U)_" in a bulletin."
128 S ORTEXT(3)="Sending bulletin ..." D MES^XPDUTL(.ORTEXT)
129 S XMB="OR CONVERSION ERRORS",XMDUZ="ORDER ENTRY/RESULTS REPORTING"
130 S XMY(DUZ)="",XMB(1)=CNT,XMTEXT="^TMP(""ORTEXT"",$J,",(CNT,IFN)=0
131 F S IFN=$O(^ORD(100.99,1,101.41,IFN)) Q:IFN'>0 S ORERR=$G(^(IFN,0)) D
132 . S CNT=CNT+1,^TMP("ORTEXT",$J,CNT)=$$LJ^XLFSTR(IFN,15)_$P(^ORD(101,IFN,0),U)
133 . S CNT=CNT+1,^TMP("ORTEXT",$J,CNT)=$P(ORERR,U,2) ; error msg
134 . S CNT=CNT+1,^TMP("ORTEXT",$J,CNT)=" " ; blank
135 D EN^XMB,KILL^XM K ^TMP("ORTEXT",$J)
136 Q
Note: See TracBrowser for help on using the repository browser.