| [613] | 1 | ORCDRA1 ;SLC/MKB-Utility functions for RA dialogs ; 08 May 2002 2:12 PM
|
|---|
| 2 | ;;3.0;ORDER ENTRY/RESULTS REPORTING;**4,75,141**;Dec 17, 1997
|
|---|
| 3 | DIV() ; -- Returns division of ordering location
|
|---|
| 4 | N Y I $G(ORL),'$G(OREVENT) S Y=+$P($G(^SC(+ORL,0)),U,15),Y=+$$SITE^VASITE(DT,Y)
|
|---|
| 5 | I $G(OREVENT) S Y=+$$DIV^OREVNTX(OREVENT)
|
|---|
| 6 | S:$G(Y)'>0 Y=+$G(DUZ(2))
|
|---|
| 7 | DIVQ Q Y
|
|---|
| 8 | ;
|
|---|
| 9 | CKPTYPE ; -- Check procedure for Series type
|
|---|
| 10 | N PTYPE S PTYPE=$P($G(^ORD(101.43,+$$VAL^ORCD("PROCEDURE"),"RA")),U,2)
|
|---|
| 11 | Q:PTYPE'="S" Q:'$L($P($G(^RAMIS(71.2,+Y,0)),U,2))
|
|---|
| 12 | W $C(7),!,"This procedure modifier may not be selected with a procedure series!",!
|
|---|
| 13 | K DONE,ORDIALOG(PROMPT,ORI)
|
|---|
| 14 | Q
|
|---|
| 15 | ;
|
|---|
| 16 | VALIDWP(ROOT) ; -- Validate wp field (borrowed from VALWP^RAUTL5)
|
|---|
| 17 | ; Pass back '1' is data is valid, '0' if not valid.
|
|---|
| 18 | Q:'$L($G(ROOT)) 0 Q:'$O(@(ROOT_"0)")) 0
|
|---|
| 19 | N CHAR,CNT,WL,WPFLG,X,Y,Z
|
|---|
| 20 | S (WPFLG,X)=0
|
|---|
| 21 | F S X=$O(@(ROOT_X_")")) Q:X'>0 D Q:WPFLG
|
|---|
| 22 | . S (CNT,WL)=0
|
|---|
| 23 | . S Y=$G(@(ROOT_X_",0)")) Q:Y']""
|
|---|
| 24 | . S WL=$L(Y)
|
|---|
| 25 | . F Z=1:1:WL D Q:WPFLG
|
|---|
| 26 | .. S CHAR=$E(Y,Z) S:CHAR?1AN CNT=CNT+1
|
|---|
| 27 | .. S:CHAR'?1AN&(CNT>0) CNT=0 S:CNT=2 WPFLG=1
|
|---|
| 28 | Q WPFLG
|
|---|
| 29 | ;
|
|---|
| 30 | CHNGCAT ; -- Kill dependent values if Category changes
|
|---|
| 31 | N P,PTR
|
|---|
| 32 | F P="LOCATION","CONTRACT/SHARING SOURCE","RESEARCH SOURCE" D
|
|---|
| 33 | . S PTR=+$O(^ORD(101.41,"AB",$E("OR GTX "_P,1,63),0))
|
|---|
| 34 | . K:PTR ORDIALOG(PTR,1),ORDIALOG(PTR,"S") ; kill value,screen
|
|---|
| 35 | Q
|
|---|
| 36 | ;
|
|---|
| 37 | MATCH(CATG) ; -- Category match pt location type?
|
|---|
| 38 | I $G(OREVENT) Q 1 ; location will be stuffed
|
|---|
| 39 | N TYPE,SCREEN,Y S TYPE=$P($G(^SC(+$G(ORL),0)),U,3),Y=1
|
|---|
| 40 | S:CATG="I"&(TYPE'="W") SCREEN="I $P(^(0),U,3)=""W"",'$P($G(^(""OOS"")),""^"")"
|
|---|
| 41 | S:CATG="O"&(TYPE="W") SCREEN="I $P(^(0),U,3)'=""W"",'$P($G(^(""OOS"")),""^"")"
|
|---|
| 42 | I $D(SCREEN) S Y=0,ORDIALOG($$PTR^ORCD("OR GTX LOCATION"),"S")=SCREEN
|
|---|
| 43 | Q Y
|
|---|
| 44 | ;
|
|---|
| 45 | SCHEDULD() ; -- Returns 1 or 0, if patient is scheduled for pre-op
|
|---|
| 46 | N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
|
|---|
| 47 | I $G(ORDIALOG(PROMPT,1)) Q 1 ; don't ask - already have date
|
|---|
| 48 | S DIR(0)="YAO",DIR("A")="Is this patient scheduled for pre-op? "
|
|---|
| 49 | S DIR("B")="NO" D ^DIR S:$D(DTOUT)!($D(DUOUT)) ORQUIT=1
|
|---|
| 50 | Q +Y
|
|---|
| 51 | ;
|
|---|
| 52 | MODE() ; -- Returns default mode of transport
|
|---|
| 53 | Q:$G(ORTYPE)="Z" "" N I,M,P
|
|---|
| 54 | S I=0,M=$O(^ORD(101.41,"AB","OR GTX MODIFIERS",0))
|
|---|
| 55 | S P=$O(^RAMIS(71.2,"B","PORTABLE EXAM",0))
|
|---|
| 56 | F S I=$O(ORDIALOG(M,I)) Q:I'>0 I ORDIALOG(M,I)=P S Y="P" Q
|
|---|
| 57 | S:'$D(Y) Y=$S($G(ORWARD):"W",1:"A")
|
|---|
| 58 | Q Y
|
|---|
| 59 | ;
|
|---|
| 60 | ILOC ; -- Get allowable imaging locations
|
|---|
| 61 | N ITYPE,ORY,IFN,CNT K ORDIALOG(PROMPT,"LIST")
|
|---|
| 62 | S ITYPE=$P(ORDG,U,4) D EN4^RAO7PC1(ITYPE,"ORY")
|
|---|
| 63 | S (IFN,CNT)=0 F S IFN=$O(ORY(IFN)) Q:IFN'>0 D
|
|---|
| 64 | . S CNT=CNT+1,ORDIALOG(PROMPT,"LIST",CNT)=ORY(IFN)_U_IFN
|
|---|
| 65 | . S ORDIALOG(PROMPT,"LIST","B",$P(ORY(IFN),U,2))=IFN
|
|---|
| 66 | S:CNT ORDIALOG(PROMPT,"LIST")=CNT_"^1",Y=+ORDIALOG(PROMPT,"LIST",1)
|
|---|
| 67 | Q
|
|---|
| 68 | ;
|
|---|
| 69 | DEFLOC() ; -- Returns default imaging location
|
|---|
| 70 | N X,I S X=+$G(ORDIALOG(PROMPT,"LIST",1))
|
|---|
| 71 | I $G(ORDIV) S I=0 F S I=$O(ORDIALOG(PROMPT,"LIST",I)) Q:I'>0 I $P(ORDIALOG(PROMPT,"LIST",I),U,3)=ORDIV S X=+ORDIALOG(PROMPT,"LIST",I) Q
|
|---|
| 72 | Q X
|
|---|
