[613] | 1 | ORWU16 ; SLC/KCM - General Utilites for Windows Calls 16bit
|
---|
| 2 | ;;3.0;ORDER ENTRY/RESULTS REPORTING;;Dec 17, 1997
|
---|
| 3 | ;
|
---|
| 4 | USERINFO(Y) ; procedure
|
---|
| 5 | ; return DUZ^NAME^SIGNAUTH^ISPROVIDER for the current user
|
---|
| 6 | ; I DUZ=1085 S DUZ=1298 ; CHANGE ID **** DON'T EXPORT ****
|
---|
| 7 | S Y=DUZ_U_$P(^VA(200,DUZ,0),U,1)
|
---|
| 8 | S $P(Y,U,3)=$S($D(^XUSEC("ORES",DUZ)):3,$D(^XUSEC("ORELSE",DUZ)):2,$D(^XUSEC("OREMAS",DUZ)):1,1:0)
|
---|
| 9 | S $P(Y,U,4)=$D(^XUSEC("PROVIDER",DUZ))#10
|
---|
| 10 | Q
|
---|
| 11 | VALIDSIG(ESOK,X) ; procedure
|
---|
| 12 | S X=$$DECRYP^XUSRB1(X),ESOK=0
|
---|
| 13 | D HASH^XUSHSHP
|
---|
| 14 | I X=$P($G(^VA(200,+DUZ,20)),U,4) S ESOK=1
|
---|
| 15 | Q
|
---|
| 16 | HOSPLOC(Y,DIR,FROM) ; Return a bolus from the HOSPITAL LOCATION file
|
---|
| 17 | ; .Return Array, Direction, Starting Text
|
---|
| 18 | N I,IEN,CNT S CNT=44
|
---|
| 19 | ;
|
---|
| 20 | I DIR=0 D ; Forward direction
|
---|
| 21 | . F I=1:1:CNT S FROM=$O(^SC("B",FROM)) Q:FROM="" D
|
---|
| 22 | . . S IEN=$O(^SC("B",FROM,0))
|
---|
| 23 | . . I $$ACTLOC(IEN) S Y(I)=IEN_"^"_FROM
|
---|
| 24 | . I $G(Y(CNT))="" S Y(I)=""
|
---|
| 25 | ;
|
---|
| 26 | I DIR=1 D ; Reverse direction
|
---|
| 27 | . F I=1:1:CNT S FROM=$O(^SC("B",FROM),-1) Q:FROM="" D
|
---|
| 28 | . . S IEN=$O(^SC("B",FROM,0))
|
---|
| 29 | . . I $$ACTLOC(IEN) S Y(I)=IEN_"^"_FROM
|
---|
| 30 | Q
|
---|
| 31 | ACTLOC(LOC) ; Function
|
---|
| 32 | ; Returns 1 (true) if active hospital location, otherwise 0 (false)
|
---|
| 33 | N D0,X I +$G(^SC(LOC,"OOS")) Q 0 ; screen out OOS entry
|
---|
| 34 | S D0=+$G(^SC(LOC,42)) I D0 D WIN^DGPMDDCF Q 'X ; chk out of svc wards
|
---|
| 35 | S X=$G(^SC(LOC,"I")) I +X=0 Q 1 ; no inactivate date
|
---|
| 36 | I DT>$P(X,U)&($P(X,U,2)=""!(DT<$P(X,U,2))) Q 0 ; chk reactivate date
|
---|
| 37 | Q 1 ; must still be active
|
---|
| 38 | ;
|
---|
| 39 | NEWPERS(Y,DIR,FROM,KEY) ; Return a bolus from the NEW PERSON file
|
---|
| 40 | ; .Return Array, Direction, Starting Text
|
---|
| 41 | N I,IEN,CNT S CNT=44,KEY=$G(KEY)
|
---|
| 42 | ;
|
---|
| 43 | I DIR=0 D ; Forward direction
|
---|
| 44 | . F I=1:1:CNT S FROM=$O(^VA(200,"B",FROM)) Q:FROM="" D
|
---|
| 45 | . . S IEN=$O(^VA(200,"B",FROM,0)) I $L(KEY),'$D(^XUSEC(KEY,IEN)) Q
|
---|
| 46 | . . S Y(I)=IEN_"^"_FROM
|
---|
| 47 | . I $G(Y(CNT))="" S Y(I)=""
|
---|
| 48 | ;
|
---|
| 49 | I DIR=1 D ; Reverse direction
|
---|
| 50 | . F I=1:1:CNT S FROM=$O(^VA(200,"B",FROM),-1) Q:FROM="" D
|
---|
| 51 | . . S IEN=$O(^VA(200,"B",FROM,0)) I $L(KEY),'$D(^XUSEC(KEY,IEN)) Q
|
---|
| 52 | . . S Y(I)=IEN_"^"_FROM
|
---|
| 53 | Q
|
---|
| 54 | DEVICE(Y) ; Return a list of devices
|
---|
| 55 | S I=0,DEV=""
|
---|
| 56 | F S DEV=$O(^%ZIS(1,"B",DEV)) Q:DEV="" S IEN=$O(^(DEV,0)) D
|
---|
| 57 | . I $E($G(^%ZIS(2,+$G(^%ZIS(1,IEN,"SUBTYPE")),0)))'="P" Q
|
---|
| 58 | . I $P($G(^%ZIS(1,IEN,0)),U,12)=2 Q
|
---|
| 59 | . S I=I+1,Y(I)=IEN_";"_$P(^%ZIS(1,IEN,0),U)_U_DEV_U_$P($G(^(1)),U)_U_$P($G(^(90)),U)_U_$P(^(91),U)_U_$P(^(91),U,3)
|
---|
| 60 | Q
|
---|
| 61 | VALDT(Y,X,%DT) ; Validate date/time entry
|
---|
| 62 | S:'$D(%DT) %DT="TX" D ^%DT
|
---|
| 63 | Q
|
---|
| 64 | ;
|
---|
| 65 | URGENCY(Y) ; -- retrieve set values from dd for discharge summary urgency
|
---|
| 66 | N ORDD,I,X
|
---|
| 67 | D FIELD^DID(8925,.09,"","POINTER","ORDD")
|
---|
| 68 | F I=1:1 S X=$P(ORDD("POINTER"),";",I) Q:X="" S Y(I)=$TR(X,":","^")
|
---|
| 69 | Q
|
---|
| 70 | ;
|
---|