LRUC ;DALISC/CYM GET LOCATIONS BY DIVISION ; 9/13/1999
;;5.2;LAB SERVICE;**72,247**;Sep 27, 1994
; Called from input transform of LOCATION field (#65.03,.04)
S DIC="^SC(",DIC(0)="EQMZ",DIC("S")="I '$P(^(0),U,15)!(DUZ(2)=+$$SITE^VASITE(DT,+$P(^(0),U,15)))"
D ^DIC K DIC
I Y>0 S X=$P(Y,U,2) Q
GET D EN^DDIOL("You must choose a location","","!,?5,$C(7)")
D EN^DDIOL("Do you want to see the entire HOSPITAL LOCATION File?","","!,?3")
S %=1 D YN^LRU I %=1 D
. S DIC="^SC(",DIC(0)="AEQMZ",DIC("S")="I '$P(^(0),U,15)!(DUZ(2)=+$$SITE^VASITE(DT,+$P(^(0),U,15)))"
. D ^DIC K DIC
I Y=-1 K X Q
I Y>0 S X=$P(Y,U,2) Q
Q
EN D EN^DDIOL("Please choose a location within your division","","!,?3,$C(7)")
D EN^DDIOL("Type in at least two characters of your choice","","!,?3")
D EN^DDIOL(" OR type in ^ to exit","","!,?5")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRUC 841 printed Nov 22, 2024@17:31:22 Page 2
LRUC ;DALISC/CYM GET LOCATIONS BY DIVISION ; 9/13/1999
+1 ;;5.2;LAB SERVICE;**72,247**;Sep 27, 1994
+2 ; Called from input transform of LOCATION field (#65.03,.04)
+3 SET DIC="^SC("
SET DIC(0)="EQMZ"
SET DIC("S")="I '$P(^(0),U,15)!(DUZ(2)=+$$SITE^VASITE(DT,+$P(^(0),U,15)))"
+4 DO ^DIC
KILL DIC
+5 IF Y>0
SET X=$PIECE(Y,U,2)
QUIT
GET DO EN^DDIOL("You must choose a location","","!,?5,$C(7)")
+1 DO EN^DDIOL("Do you want to see the entire HOSPITAL LOCATION File?","","!,?3")
+2 SET %=1
DO YN^LRU
IF %=1
Begin DoDot:1
+3 SET DIC="^SC("
SET DIC(0)="AEQMZ"
SET DIC("S")="I '$P(^(0),U,15)!(DUZ(2)=+$$SITE^VASITE(DT,+$P(^(0),U,15)))"
+4 DO ^DIC
KILL DIC
End DoDot:1
+5 IF Y=-1
KILL X
QUIT
+6 IF Y>0
SET X=$PIECE(Y,U,2)
QUIT
+7 QUIT
EN DO EN^DDIOL("Please choose a location within your division","","!,?3,$C(7)")
+1 DO EN^DDIOL("Type in at least two characters of your choice","","!,?3")
+2 DO EN^DDIOL(" OR type in ^ to exit","","!,?5")
+3 QUIT
