source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORCONV3.m@ 1801

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

initial load of FOIAVistA 6/30/08 version
File size: 6.2 KB
Line 
1ORCONV3 ; SLC/MKB - Convert diet orders, UD Order Sets ;6/20/97 11:24
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**14**;Dec 17, 1997
3PTR(X) ; -- Returns ptr to 101.41 for prompt OR GTX X
4 Q +$O(^ORD(101.41,"AB",$E("OR GTX "_X,1,63),0))
5 ;
6FH(ORIFN,ORPK) ; -- Called from Dietetics post-init
7 N ORVP,TYPE,ADM,IFN,ORDIALOG
8 S ORVP=$P($G(^OR(100,+$G(ORIFN),0)),U,2) Q:'ORVP
9 S TYPE=$E(ORPK),ADM=+$P(ORPK,";",2),IFN=+$P(ORPK,";",3)
10 D 1:TYPE="D",2:TYPE="E",3:TYPE="I",4:TYPE="N",7:TYPE="A",8:TYPE="T"
11 S ^OR(100,ORIFN,4)=ORPK,$P(^(0),U,5)=+ORDIALOG_";ORD(101.41,"
12 D RESPONSE^ORCSAVE
13 Q
141 ; -- Diet order
15 N OI,I,P,X,Y,FH0
16 S ORDIALOG=+$O(^ORD(101.41,"AB","FHW1",0)) D GETDLG1^ORCD(ORDIALOG)
17 S OI=$$PTR("ORDERABLE ITEM"),FH0=$G(^FHPT(+ORVP,"A",ADM,"DI",IFN,0))
18 S I=0 F P=2:1:6 S X=$P(FH0,U,P) Q:'X S Y=$O(^ORD(101.43,"ID",X_";99FHD",0)) S:Y I=I+1,ORDIALOG(OI,I)=Y
19 S:$P(FH0,U,9) ORDIALOG($$PTR("START DATE/TIME"),1)=$P(FH0,U,9)
20 S:$P(FH0,U,10) ORDIALOG($$PTR("STOP DATE/TIME"),1)=$P(FH0,U,10)
21 S:$L($P(FH0,U,8)) ORDIALOG($$PTR("DELIVERY"),1)=$P(FH0,U,8)
22 S X=$G(^FHPT(+ORVP,"A",ADM,"DI",IFN,1)) S:$L(X) ORDIALOG($$PTR("FREE TEXT 1"),1)=X
23 Q
242 ; -- Early/late tray
25 N ORPARAM,FH0,MEAL,TIME,I,X,Y,OI
26 S ORDIALOG=+$O(^ORD(101.41,"AB","FHW2",0)) D GETDLG1^ORCD(ORDIALOG)
27 S FH0=$G(^FHPT(+ORVP,"A",ADM,"EL",IFN,0)) D EN^FHWOR8(+ORVP,.ORPARAM)
28 S MEAL=$P(FH0,U,2),TIME=$P(FH0,U,3)
29 S I=$S(MEAL="B":1,MEAL="N":7,MEAL="E":13,1:0) I I D ;derive tray
30 . S X=$P(ORPARAM(1),U,I,I+5),Y=""
31 . F I=1:1:6 I $P(X,U,I)=TIME S Y=$S(I<4:"EARLY TRAY",1:"LATE TRAY")
32 . S:$L(Y) OI=+$O(^ORD(101.43,"S.E/L T",Y,0)),ORDIALOG($$PTR("ORDERABLE ITEM"),1)=OI
33 S ORDIALOG($$PTR("MEAL"),1)=MEAL,ORDIALOG($$PTR("MEAL TIME"),1)=TIME
34 S:$L($P(FH0,U,4)) ORDIALOG($$PTR("YES/NO"),1)=($P(FH0,U,4)="Y")
35 S:$P(FH0,U) ORDIALOG($$PTR("START DATE"),1)=$P($P(FH0,U),".")
36 ;S:$P(FH0,U,?) ORDIALOG($$PTR("STOP DATE"),1)=$P($P(FH0,U,?),".")
37 ;S:$L($P(FH0,U,?)) ORDIALOG($$PTR("SCHEDULE"),1)=$P(FH0,U,?)
38 Q
393 ; -- Isolation
40 N OI,FH0 S FH0=$G(^FHPT(+ORVP,"A",ADM,0))
41 S ORDIALOG=+$O(^ORD(101.41,"AB","FHW3",0)) D GETDLG1^ORCD(ORDIALOG)
42 S OI=+$O(^ORD(101.43,"S.PREC","ISOLATION PROCEDURES",0))
43 S ORDIALOG($$PTR("ORDERABLE ITEM"),1)=OI
44 S:$P(FH0,U,9) ORDIALOG($$PTR("ISOLATION TYPE"),1)=$P(FH0,U,9)
45 Q
464 ; -- NPO
47 S ORDIALOG=+$O(^ORD(101.41,"AB","FHW4",0)) D GETDLG1^ORCD(ORDIALOG)
48 N OI,FH0,X S FH0=$G(^FHPT(+ORVP,"A",ADM,"DI",IFN,0))
49 S OI=+$O(^ORD(101.43,"S.DIET","NPO",0))
50 S ORDIALOG($$PTR("ORDERABLE ITEM"),1)=OI
51 S:$P(FH0,U,9) ORDIALOG($$PTR("START DATE/TIME"),1)=$P(FH0,U,9)
52 S:$P(FH0,U,10) ORDIALOG($$PTR("STOP DATE/TIME"),1)=$P(FH0,U,10)
53 S X=$G(^FHPT(+ORVP,"A",ADM,"DI",IFN,1)) S:$L(X) ORDIALOG($$PTR("FREE TEXT 1"),1)=X
54 Q
557 ; -- Additional order
56 N FH0 S FH0=$G(^FHPT(+ORVP,"A",ADM,"OO",IFN,0))
57 S ORDIALOG=+$O(^ORD(101.41,"AB","FHW7",0)) D GETDLG1^ORCD(ORDIALOG)
58 S:$L($P(FH0,U,3)) ORDIALOG($$PTR("FREE TEXT 1"),1)=$P(FH0,U,3)
59 Q
608 ; -- Tubefeeding
61 N PROD,OI,I,X,Y,FH0
62 S ORDIALOG=+$O(^ORD(101.41,"AB","FHW8",0)) D GETDLG1^ORCD(ORDIALOG)
63 S I=0 F S I=$O(^FHPT(+ORVP,"A",ADM,"TF",IFN,"P",I)) Q:I'>0 S FH0=$G(^(I,0)) D
64 . S PROD=+$P(FH0,U),OI=+$O(^ORD(101.43,"ID",PROD_";99FHT",0)) Q:'OI
65 . S ORDIALOG($$PTR("ORDERABLE ITEM"),I)=OI
66 . S:$P(FH0,U,2) ORDIALOG($$PTR("STRENGTH FH"),I)=$P(FH0,U,2)
67 . I $L($P(FH0,U,3)) D S ORDIALOG($$PTR("INSTRUCTIONS"),I)=Y
68 . . S X=$P(FH0,U,3),Y=$P(X,"/") Q:$L(X,"/")'>1 ;done
69 . . S X=$P(X,"/",2),Y=Y_"/"_$S(X="per Day":"QD",X="per Hour":"QH",X="Twice a Day":"BID",X="Three times a Day":"TID",X="Every 2 Hours":"Q2H",X="Every 3 Hours":"Q3H",X="Every 4 Hours":"Q4H",X="Every 6 Hours":"Q6H",1:"")
70 S FH0=$G(^FHPT(+ORVP,"A",ADM,"TF",IFN,0))
71 S:$L($P(FH0,U,5)) ORDIALOG($$PTR("FREE TEXT 1"),1)=$P(FH0,U,5)
72 ;S:$L($P(FH0,U,?)) ORDIALOG($$PTR("CANCEL FUTURE ORDERS"),1)=$P(FH0,U,?)
73 Q
74 ;
75PSJQOS ; -- Unit Dose Order Sets
76 N ORSETNM,DEFAULT,ORI,ORDA,DITEM,CNT,NODE1,NODE2,NODE3,OI,ORPKG,ORDG,ORTX
77 S ORSETNM=$G(^TMP("PSJQOS",$J,"NM")),ORDA=0 Q:'$L(ORSETNM)
78 S DEFAULT=$O(^ORD(101.41,"AB","PSJ OR PAT OE",0)) Q:'DEFAULT
79 S ORPKG=$O(^DIC(9.4,"C","PSJ",0)),ORDG=$O(^ORD(100.98,"B","UD RX",0))
80 S ORI=0 F S ORI=$O(^TMP("PSJQOS",$J,ORI)) Q:ORI'>0 D
81 . S NODE1=$G(^TMP("PSJQOS",$J,ORI,1)),NODE2=$G(^(2)),NODE3=$G(^(3))
82 . S OI=+$O(^ORD(101.43,"ID",+NODE1_";99PSP",0)) Q:'OI S ORTX=$P($G(^ORD(101.43,OI,0)),U)
83 . S DITEM=$$PSJQ(ORTX,ORI) Q:'DITEM
84 . S ORDA=ORDA+1,ORDA(ORDA)=DITEM,CNT=0
85 . D SET^ORCONVRT("ORDERABLE ITEM",OI)
86 . D:NODE3 SET^ORCONVRT("DISPENSE DRUG",+NODE3)
87 . D:$L($P(NODE1,U,4)) SET^ORCONVRT("INSTRUCTIONS",$P(NODE1,U,4))
88 . D:$P(NODE1,U,2) SET^ORCONVRT("ROUTE",$P(NODE1,U,2))
89 . D:$L($P(NODE1,U,3)) SET^ORCONVRT("SCHEDULE",$P(NODE1,U,3))
90 . I $L(NODE2) K ORTX S ORTX(0)="^^1^"_DT_U,ORTX(1,0)=NODE2 D SET^ORCONVRT("WORD PROCESSING 1","ORTX")
91 . S:CNT ^ORD(101.41,DITEM,6,0)="^101.416^"_CNT_U_CNT
92PS1 Q:ORDA'>0 I ORDA=1,$G(ORDA(1)) D Q ; Single quick order only
93 . N DIE,DA,DR,ORNM S DIE="^ORD(101.41,",ORNM="PSJQOS "_ORSETNM
94 . S DA=ORDA(1),DR=".01///^S X=ORNM;2///^S X=ORSETNM" D ^DIE
95 S DITEM=$$PSJQ(ORSETNM) I DITEM D ; Order set
96 . N I,X F I=1:1:ORDA S X=ORDA(I),^ORD(101.41,DITEM,10,I,0)=I_U_X,^ORD(101.41,DITEM,10,"B",I,I)="",^ORD(101.41,DITEM,10,"D",X,I)="",^ORD(101.41,"AD",X,DITEM,I)=""
97 . S ^ORD(101.41,DITEM,10,0)="^101.412AI^"_ORDA_U_ORDA
98 Q
99 ;
100PSJQ(NAME,ITM) ; -- Create new PSJQOS dialog
101 N X,Y,DIC,DLAYGO S:'$L(NAME) NAME=ORSETNM
102 S DIC="^ORD(101.41,",DIC(0)="LX",DLAYGO=101.41
103 S X="PSJQOS "_ORSETNM_$S($G(ITM):" "_ITM,1:"") D ^DIC S:Y'>0 Y=0
104 I $P(Y,U,3) D
105 . S X=$P(Y,U,2)_U_NAME_"^^"_$S($G(ITM):"Q",1:"O")_U_ORDG_"^2^"_ORPKG
106 . S ^ORD(101.41,+Y,0)=X,^ORD(101.41,"C",$$UP^XLFSTR(NAME),+Y)=""
107 . S:ORPKG ^ORD(101.41,"APKG",+ORPKG,+Y)=""
108 Q +Y
109 ;
110COLS ; -- Fix column position
111 N MENU,ITM,ROW,COL,POS,CW,ORCOL
112 S MENU=0 F S MENU=$O(^ORD(101.41,MENU)) Q:MENU'>0 I $P(^(MENU,0),U,4)="M" S CW=+$G(^(5)) D
113 . S:'CW CW=80 K ORCOL D SETCOL(CW) S ITM=0
114 . F S ITM=$O(^ORD(101.41,MENU,10,ITM)) Q:ITM'>0 S POS=$P(^(ITM,0),U) D
115 . . K ^ORD(101.41,MENU,10,"B",POS,ITM)
116 . . S ROW=$P(POS,"."),COL=$P(POS,".",2) S:'COL COL=1 S COL=ORCOL("B",COL)
117 . . S POS=ROW_"."_COL,$P(^ORD(101.41,MENU,10,ITM,0),U)=POS
118 . . S ^ORD(101.41,MENU,10,"B",POS,ITM)="" W "."
119 Q
120 ;
121SETCOL(WIDTH) ; -- Set ORCOL(#)=ColPos by WIDTH
122 N I,X S:'$G(WIDTH) WIDTH=80
123 F I=1:1 S X=(I-1)*WIDTH+1 Q:X'<240 S ORCOL(I)=X,ORCOL=I,ORCOL("B",X)=I
124 Q
Note: See TracBrowser for help on using the repository browser.