- ORWU16 ; SLC/KCM - General Utilites for Windows Calls 16bit
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;;Dec 17, 1997
- ;
- USERINFO(Y) ; procedure
- ; return DUZ^NAME^SIGNAUTH^ISPROVIDER for the current user
- ; I DUZ=1085 S DUZ=1298 ; CHANGE ID **** DON'T EXPORT ****
- S Y=DUZ_U_$P(^VA(200,DUZ,0),U,1)
- S $P(Y,U,3)=$S($D(^XUSEC("ORES",DUZ)):3,$D(^XUSEC("ORELSE",DUZ)):2,$D(^XUSEC("OREMAS",DUZ)):1,1:0)
- S $P(Y,U,4)=$D(^XUSEC("PROVIDER",DUZ))#10
- Q
- VALIDSIG(ESOK,X) ; procedure
- S X=$$DECRYP^XUSRB1(X),ESOK=0
- D HASH^XUSHSHP
- I X=$P($G(^VA(200,+DUZ,20)),U,4) S ESOK=1
- Q
- HOSPLOC(Y,DIR,FROM) ; Return a bolus from the HOSPITAL LOCATION file
- ; .Return Array, Direction, Starting Text
- N I,IEN,CNT S CNT=44
- ;
- I DIR=0 D ; Forward direction
- . F I=1:1:CNT S FROM=$O(^SC("B",FROM)) Q:FROM="" D
- . . S IEN=$O(^SC("B",FROM,0))
- . . I $$ACTLOC(IEN) S Y(I)=IEN_"^"_FROM
- . I $G(Y(CNT))="" S Y(I)=""
- ;
- I DIR=1 D ; Reverse direction
- . F I=1:1:CNT S FROM=$O(^SC("B",FROM),-1) Q:FROM="" D
- . . S IEN=$O(^SC("B",FROM,0))
- . . I $$ACTLOC(IEN) S Y(I)=IEN_"^"_FROM
- Q
- ACTLOC(LOC) ; Function
- ; Returns 1 (true) if active hospital location, otherwise 0 (false)
- N D0,X I +$G(^SC(LOC,"OOS")) Q 0 ; screen out OOS entry
- S D0=+$G(^SC(LOC,42)) I D0 D WIN^DGPMDDCF Q 'X ; chk out of svc wards
- S X=$G(^SC(LOC,"I")) I +X=0 Q 1 ; no inactivate date
- I DT>$P(X,U)&($P(X,U,2)=""!(DT<$P(X,U,2))) Q 0 ; chk reactivate date
- Q 1 ; must still be active
- ;
- NEWPERS(Y,DIR,FROM,KEY) ; Return a bolus from the NEW PERSON file
- ; .Return Array, Direction, Starting Text
- N I,IEN,CNT S CNT=44,KEY=$G(KEY)
- ;
- I DIR=0 D ; Forward direction
- . F I=1:1:CNT S FROM=$O(^VA(200,"B",FROM)) Q:FROM="" D
- . . S IEN=$O(^VA(200,"B",FROM,0)) I $L(KEY),'$D(^XUSEC(KEY,IEN)) Q
- . . S Y(I)=IEN_"^"_FROM
- . I $G(Y(CNT))="" S Y(I)=""
- ;
- I DIR=1 D ; Reverse direction
- . F I=1:1:CNT S FROM=$O(^VA(200,"B",FROM),-1) Q:FROM="" D
- . . S IEN=$O(^VA(200,"B",FROM,0)) I $L(KEY),'$D(^XUSEC(KEY,IEN)) Q
- . . S Y(I)=IEN_"^"_FROM
- Q
- DEVICE(Y) ; Return a list of devices
- S I=0,DEV=""
- F S DEV=$O(^%ZIS(1,"B",DEV)) Q:DEV="" S IEN=$O(^(DEV,0)) D
- . I $E($G(^%ZIS(2,+$G(^%ZIS(1,IEN,"SUBTYPE")),0)))'="P" Q
- . I $P($G(^%ZIS(1,IEN,0)),U,12)=2 Q
- . 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)
- Q
- VALDT(Y,X,%DT) ; Validate date/time entry
- S:'$D(%DT) %DT="TX" D ^%DT
- Q
- ;
- URGENCY(Y) ; -- retrieve set values from dd for discharge summary urgency
- N ORDD,I,X
- D FIELD^DID(8925,.09,"","POINTER","ORDD")
- F I=1:1 S X=$P(ORDD("POINTER"),";",I) Q:X="" S Y(I)=$TR(X,":","^")
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORWU16 2738 printed Feb 19, 2025@00:04:14 Page 2
- ORWU16 ; SLC/KCM - General Utilites for Windows Calls 16bit
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;;Dec 17, 1997
- +2 ;
- USERINFO(Y) ; procedure
- +1 ; return DUZ^NAME^SIGNAUTH^ISPROVIDER for the current user
- +2 ; I DUZ=1085 S DUZ=1298 ; CHANGE ID **** DON'T EXPORT ****
- +3 SET Y=DUZ_U_$PIECE(^VA(200,DUZ,0),U,1)
- +4 SET $PIECE(Y,U,3)=$SELECT($DATA(^XUSEC("ORES",DUZ)):3,$DATA(^XUSEC("ORELSE",DUZ)):2,$DATA(^XUSEC("OREMAS",DUZ)):1,1:0)
- +5 SET $PIECE(Y,U,4)=$DATA(^XUSEC("PROVIDER",DUZ))#10
- +6 QUIT
- VALIDSIG(ESOK,X) ; procedure
- +1 SET X=$$DECRYP^XUSRB1(X)
- SET ESOK=0
- +2 DO HASH^XUSHSHP
- +3 IF X=$PIECE($GET(^VA(200,+DUZ,20)),U,4)
- SET ESOK=1
- +4 QUIT
- HOSPLOC(Y,DIR,FROM) ; Return a bolus from the HOSPITAL LOCATION file
- +1 ; .Return Array, Direction, Starting Text
- +2 NEW I,IEN,CNT
- SET CNT=44
- +3 ;
- +4 ; Forward direction
- IF DIR=0
- Begin DoDot:1
- +5 FOR I=1:1:CNT
- SET FROM=$ORDER(^SC("B",FROM))
- if FROM=""
- QUIT
- Begin DoDot:2
- +6 SET IEN=$ORDER(^SC("B",FROM,0))
- +7 IF $$ACTLOC(IEN)
- SET Y(I)=IEN_"^"_FROM
- End DoDot:2
- +8 IF $GET(Y(CNT))=""
- SET Y(I)=""
- End DoDot:1
- +9 ;
- +10 ; Reverse direction
- IF DIR=1
- Begin DoDot:1
- +11 FOR I=1:1:CNT
- SET FROM=$ORDER(^SC("B",FROM),-1)
- if FROM=""
- QUIT
- Begin DoDot:2
- +12 SET IEN=$ORDER(^SC("B",FROM,0))
- +13 IF $$ACTLOC(IEN)
- SET Y(I)=IEN_"^"_FROM
- End DoDot:2
- End DoDot:1
- +14 QUIT
- ACTLOC(LOC) ; Function
- +1 ; Returns 1 (true) if active hospital location, otherwise 0 (false)
- +2 ; screen out OOS entry
- NEW D0,X
- IF +$GET(^SC(LOC,"OOS"))
- QUIT 0
- +3 ; chk out of svc wards
- SET D0=+$GET(^SC(LOC,42))
- IF D0
- DO WIN^DGPMDDCF
- QUIT 'X
- +4 ; no inactivate date
- SET X=$GET(^SC(LOC,"I"))
- IF +X=0
- QUIT 1
- +5 ; chk reactivate date
- IF DT>$PIECE(X,U)&($PIECE(X,U,2)=""!(DT<$PIECE(X,U,2)))
- QUIT 0
- +6 ; must still be active
- QUIT 1
- +7 ;
- NEWPERS(Y,DIR,FROM,KEY) ; Return a bolus from the NEW PERSON file
- +1 ; .Return Array, Direction, Starting Text
- +2 NEW I,IEN,CNT
- SET CNT=44
- SET KEY=$GET(KEY)
- +3 ;
- +4 ; Forward direction
- IF DIR=0
- Begin DoDot:1
- +5 FOR I=1:1:CNT
- SET FROM=$ORDER(^VA(200,"B",FROM))
- if FROM=""
- QUIT
- Begin DoDot:2
- +6 SET IEN=$ORDER(^VA(200,"B",FROM,0))
- IF $LENGTH(KEY)
- IF '$DATA(^XUSEC(KEY,IEN))
- QUIT
- +7 SET Y(I)=IEN_"^"_FROM
- End DoDot:2
- +8 IF $GET(Y(CNT))=""
- SET Y(I)=""
- End DoDot:1
- +9 ;
- +10 ; Reverse direction
- IF DIR=1
- Begin DoDot:1
- +11 FOR I=1:1:CNT
- SET FROM=$ORDER(^VA(200,"B",FROM),-1)
- if FROM=""
- QUIT
- Begin DoDot:2
- +12 SET IEN=$ORDER(^VA(200,"B",FROM,0))
- IF $LENGTH(KEY)
- IF '$DATA(^XUSEC(KEY,IEN))
- QUIT
- +13 SET Y(I)=IEN_"^"_FROM
- End DoDot:2
- End DoDot:1
- +14 QUIT
- DEVICE(Y) ; Return a list of devices
- +1 SET I=0
- SET DEV=""
- +2 FOR
- SET DEV=$ORDER(^%ZIS(1,"B",DEV))
- if DEV=""
- QUIT
- SET IEN=$ORDER(^(DEV,0))
- Begin DoDot:1
- +3 IF $EXTRACT($GET(^%ZIS(2,+$GET(^%ZIS(1,IEN,"SUBTYPE")),0)))'="P"
- QUIT
- +4 IF $PIECE($GET(^%ZIS(1,IEN,0)),U,12)=2
- QUIT
- +5 SET I=I+1
- SET Y(I)=IEN_";"_$PIECE(^%ZIS(1,IEN,0),U)_U_DEV_U_$PIECE($GET(^(1)),U)_U_$PIECE($GET(^(90)),U)_U_$PIECE(^(91),U)_U_$PIECE(^(91),U,3)
- End DoDot:1
- +6 QUIT
- VALDT(Y,X,%DT) ; Validate date/time entry
- +1 if '$DATA(%DT)
- SET %DT="TX"
- DO ^%DT
- +2 QUIT
- +3 ;
- URGENCY(Y) ; -- retrieve set values from dd for discharge summary urgency
- +1 NEW ORDD,I,X
- +2 DO FIELD^DID(8925,.09,"","POINTER","ORDD")
- +3 FOR I=1:1
- SET X=$PIECE(ORDD("POINTER"),";",I)
- if X=""
- QUIT
- SET Y(I)=$TRANSLATE(X,":","^")
- +4 QUIT
- +5 ;
