- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORBCMA1.m
r613 r623 1 ORBCMA1 ; SLC/JLI - Pharmacy Calls for Windows Dialog [ 3/7/2006 ] 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**133,243**;Dec 17, 1997;Build 242 3 ;;OR BCMA ORDER COM V1.0 ;**133**; Jan 19, 2002 4 ; 5 ODSLCT(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 23 PRIOR ; 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 29 DEFPICK(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") 42 XPICK Q X 43 ; 44 DEFSPLY(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 ; 50 DFLTSPLY(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 61 DISPMSG() ; return 1 to suppress dispense message 62 Q +$$GET^XPAR("ALL","ORWDPS SUPPRESS DISPENSE MSG",1,"I") 63 ; 64 SCHALL(LST) ; return all schedules 65 N ILST,SCH,IEN,EXP,TYP,X0 66 K ^TMP($J,"ORBCMA1 SCHALL") 67 D AP^PSS51P1("PSJ",,,,"ORBCMA1 SCHALL") 68 S ILST=0,SCH="" 69 F S SCH=$O(^TMP($J,"ORBCMA1 SCHALL","APPSJ",SCH)) Q:SCH="" D 70 . I (SCH="STAT")!(SCH="NOW") D 71 .. S IEN=$O(^TMP($J,"ORBCMA1 SCHALL","APPSJ",SCH,"")) 72 .. S EXP=$G(^TMP($J,"ORBCMA1 SCHALL",SCH,8)) 73 .. S TYP=$P($G(^TMP($J,"ORBCMA1 SCHALL",SCH,5)),U) 74 .. S ILST=ILST+1,LST(ILST)=SCH_U_EXP_U_TYP 75 K ^TMP($J,"ORBCMA1 SCHALL") 76 Q 77 FORMALT(ORLST,IEN,PSTYPE) ; return a list of formulary alternatives 78 N PSID,I 79 S IEN=+$P(^ORD(101.43,IEN,0),U,2) 80 D EN1^PSSUTIL1(.IEN,PSTYPE) 81 S PSID=0,I=0 82 F S PSID=$O(IEN(PSID)) Q:'PSID D 83 . S OI=+$O(^ORD(101.43,"ID",PSID_";99PSP",0)) 84 . I OI S I=I+1,ORLST(I)=OI,$P(ORLST(I),U,2)=$P(^ORD(101.43,OI,0),U) 85 Q 86 DOSEALT(LST,DDRUG,CUROI,PSTYPE) ; return a list of formulary alternatives for dose 87 N I,OI,ORWLST,ILST S ILST=0 88 D ENRFA^PSJORUTL(DDRUG,PSTYPE,.ORWLST) 89 S I=0 F S I=$O(ORWLST(I)) Q:'I D 90 . S OI=+$O(^ORD(101.43,"ID",+$P(ORWLST(I),U,4)_";99PSP",0)) 91 . I OI,OI'=CUROI S ILST=ILST+1,LST(ILST)=OI_U_$P(^ORD(101.43,OI,0),U) 92 Q 93 FAILDEA(FAIL,OI,ORNP,PSTYPE) ; return 1 if DEA check fails for this provider 94 N DEAFLG,PSOI 95 S FAIL=0,PSOI=+$P($G(^ORD(101.43,+$G(OI),0)),U,2) Q:PSOI'>0 96 I '$L($T(OIDEA^PSSUTLA1)) Q 97 S DEAFLG=$$OIDEA^PSSUTLA1(PSOI,PSTYPE) Q:DEAFLG'>0 98 I '$L($P($G(^VA(200,+$G(ORNP),"PS")),U,2)),'$L($P($G(^("PS")),U,3)) S FAIL=1 99 Q 100 CHK94(VAL) ; return 1 if patch 94 has been installed 101 S VAL=0 102 I $O(^ORD(101.41,"B","PS MEDS",0)) S VAL=1 103 Q 1 ORBCMA1 ; 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 ; 5 ODSLCT(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 23 PRIOR ; 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 29 DEFPICK(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") 42 XPICK Q X 43 ; 44 DEFSPLY(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 ; 50 DFLTSPLY(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 61 DISPMSG() ; return 1 to suppress dispense message 62 Q +$$GET^XPAR("ALL","ORWDPS SUPPRESS DISPENSE MSG",1,"I") 63 ; 64 SCHALL(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 73 FORMALT(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 82 DOSEALT(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 89 FAILDEA(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 96 CHK94(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 TracChangeset
for help on using the changeset viewer.
