source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORBCMA1.m@ 1608

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

revised back to 6/30/08 version
File size: 3.5 KB
RevLine 
[623]1ORBCMA1 ; SLC/JLI - Pharmacy Calls for Windows Dialog [ 2/11/02 4:30PM ]
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**133**;Dec 17, 1997
3 ;;OR BCMA ORDER COM V1.0 ;**133**; Jan 19, 2002
4 ;
5ODSLCT(LST,PSTYPE,DFN,LOC) ; return default lists for dialog
6 ; PSTYPE: pharmacy type (U=unit dose, F=IV fluids, O=outpatient)
7 N ILST S ILST=0
8 S ILST=ILST+1,LST(ILST)="~Priority" D PRIOR
9 S ILST=ILST+1,LST(ILST)="~DispMsg"
10 S ILST=ILST+1,LST(ILST)="d"_$$DISPMSG
11 ;
12 ; I PSTYPE="F" D Q ; IV Fluids
13 ; . S ILST=ILST+1,LST(ILST)="~ShortList" D SHORT
14 ;
15 I PSTYPE="O" D ; Outpatient
16 . S ILST=ILST+1,LST(ILST)="~Refills"
17 . S ILST=ILST+1,LST(ILST)="d0^0"
18 . S ILST=ILST+1,LST(ILST)="~Pickup"
19 . S ILST=ILST+1,LST(ILST)="d"_$$DEFPICK($G(LOC))
20 . ; S ILST=ILST+1,LST(ILST)="~Supply"
21 . ; S ILST=ILST+1,LST(ILST)="d^"_$$DEFSPLY(DFN)
22 Q
23PRIOR ; from DLGSLCT, get list of allowed priorities
24 N X,XREF
25 S X=0
26 S X=$O(^ORD(101.42,"B","DONE",X))
27 S ILST=ILST+1,LST(ILST)="d"_X_U_$P(^ORD(101.42,X,0),U,2)
28 Q
29DEFPICK(LOC) ; return default routing
30 N X,DLG,PRMT
31 S DLG=$O(^ORD(101.41,"AB","PSO OERR",0)),X=""
32 S PRMT=$O(^ORD(101.41,"AB","OR GTX ROUTING",0))
33 I $D(^TMP("ORECALL",$J,+DLG,+PRMT,1)) S X=^(1)
34 I X'="" S EDITONLY=1 Q X ; EDITONLY used by default action
35 ;
36 S X=$$GET^XPAR("ALL^"_"LOC.`"_LOC,"ORWDPS ROUTING DEFAULT",1,"I")
37 I X="C" S X="C^in Clinic" G XPICK
38 I X="M" S X="M^by Mail" G XPICK
39 I X="W" S X="W^at Window" G XPICK
40 I X="N" S X="" G XPICK
41 I X="" S X=$S($D(^PSX(550,"C")):"M^by Mail",1:"W^at Window")
42XPICK Q X
43 ;
44DEFSPLY(DFN) ; return default days supply for this patient
45 N ORWX
46 S ORWX("PATIENT")=DFN
47 D DSUP^PSOSIGDS(.ORWX)
48 Q $G(ORWX("DAYS SUPPLY"))
49 ;
50DFLTSPLY(VAL,UPD,SCH,PAT,DRG) ; return days supply given quantity
51 ; VAL: default days supply
52 N ORWX,I
53 S ORWX("PATIENT")=PAT
54 I DRG S ORWX("DRUG")=DRG
55 F I=1:1:$L(UPD,U)-1 D
56 . S ORWX("DOSE ORDERED",I)=$P(UPD,U,I)
57 . S ORWX("SCHEDULE",I)=$P(SCH,U,I)
58 D DSUP^PSOSIGDS(.ORWX)
59 S VAL=$G(ORWX("DAYS SUPPLY"))
60 Q
61DISPMSG() ; return 1 to suppress dispense message
62 Q +$$GET^XPAR("ALL","ORWDPS SUPPRESS DISPENSE MSG",1,"I")
63 ;
64SCHALL(LST) ; return all schedules
65 N ILST,SCH,IEN,EXP,TYP,X0
66 S ILST=0,SCH=""
67 F S SCH=$O(^PS(51.1,"APPSJ",SCH)) Q:SCH="" D
68 . I (SCH="STAT")!(SCH="NOW") D
69 .. S IEN=$O(^PS(51.1,"APPSJ",SCH,0))
70 .. S X0=$G(^PS(51.1,IEN,0)),EXP=$P(X0,U,8),TYP=$P(X0,U,5)
71 .. S ILST=ILST+1,LST(ILST)=SCH_U_EXP_U_TYP
72 Q
73FORMALT(ORLST,IEN,PSTYPE) ; return a list of formulary alternatives
74 N PSID,I
75 S IEN=+$P(^ORD(101.43,IEN,0),U,2)
76 D EN1^PSSUTIL1(.IEN,PSTYPE)
77 S PSID=0,I=0
78 F S PSID=$O(IEN(PSID)) Q:'PSID D
79 . S OI=+$O(^ORD(101.43,"ID",PSID_";99PSP",0))
80 . I OI S I=I+1,ORLST(I)=OI,$P(ORLST(I),U,2)=$P(^ORD(101.43,OI,0),U)
81 Q
82DOSEALT(LST,DDRUG,CUROI,PSTYPE) ; return a list of formulary alternatives for dose
83 N I,OI,ORWLST,ILST S ILST=0
84 D ENRFA^PSJORUTL(DDRUG,PSTYPE,.ORWLST)
85 S I=0 F S I=$O(ORWLST(I)) Q:'I D
86 . S OI=+$O(^ORD(101.43,"ID",+$P(ORWLST(I),U,4)_";99PSP",0))
87 . I OI,OI'=CUROI S ILST=ILST+1,LST(ILST)=OI_U_$P(^ORD(101.43,OI,0),U)
88 Q
89FAILDEA(FAIL,OI,ORNP,PSTYPE) ; return 1 if DEA check fails for this provider
90 N DEAFLG,PSOI
91 S FAIL=0,PSOI=+$P($G(^ORD(101.43,+$G(OI),0)),U,2) Q:PSOI'>0
92 I '$L($T(OIDEA^PSSUTLA1)) Q
93 S DEAFLG=$$OIDEA^PSSUTLA1(PSOI,PSTYPE) Q:DEAFLG'>0
94 I '$L($P($G(^VA(200,+$G(ORNP),"PS")),U,2)),'$L($P($G(^("PS")),U,3)) S FAIL=1
95 Q
96CHK94(VAL) ; return 1 if patch 94 has been installed
97 S VAL=0
98 I $O(^ORD(101.41,"B","PS MEDS",0)) S VAL=1
99 Q
Note: See TracBrowser for help on using the repository browser.