ORLP3C1 ; slc/CLA - Utilities to convert OE/RR 2.5 lists ;12/15/97 [ 04/03/97 10:50 AM ]
;;3.0;ORDER ENTRY/RESULTS REPORTING;**9**;Dec 17, 1997
Q
POSTORLP ;convert user defaults for pt from ^VA(200 to Parameters
N ORLPC,ERR
S ORLPC=$$GET^XPAR("SYS","ORLPC CONVERSION",1,"Q")
I +$G(ORLPC)>0 D BMES^XPDUTL("User pt selection defaults already converted.") Q
D BMES^XPDUTL("Converting user pt selection defaults to parameters...")
D USERDEF
D EN^XPAR("SYS","ORLPC CONVERSION",1,"1",.ERR) ;1:conversion done
S ORLPC=$$GET^XPAR("SYS","ORLPC CONVERSION",1,"Q")
D BMES^XPDUTL("Conversion of user pt selection defaults completed.")
Q
USERDEF ;move pt selection defaults from file 200 to parameter file [#8989.5]
N NAME,ORDUZ,ORPDUZ,OR1,OR2,WARD,TEAM,FROM,CLIN,BEG,END,SORT,PROV,SPEC,ERR,ORCT
S XPDIDTOT=$P(^VA(200,0),U,4),ORCT=0
D UPDATE^XPDID(0)
S ORDUZ=0,NAME=""
F S NAME=$O(^VA(200,"B",NAME)) Q:NAME="" S ORDUZ=0,ORDUZ=$O(^(NAME,ORDUZ)) D
.Q:'$L($G(ORDUZ))
.S ORPDUZ="USR.`"_ORDUZ
.S (WARD,TEAM,FROM,CLIN,BEG,END,SORT,PROV,SPEC)=""
.S OR1=$G(^VA(200,ORDUZ,100.1)),OR2=$G(^VA(200,ORDUZ,100.2))
.D:$L($G(OR1)) OR1
.D:$L($G(OR2)) OR2
.S ORCT=ORCT+1
.I '(ORCT#100) D UPDATE^XPDID(ORCT)
K XPDIDTOT
Q
OR1 ;set defaults from ^VA(200,ORDUZ,100.1)
N X
S WARD=$P(OR1,U,4),TEAM=$P(OR1,U,5),FROM=$P(OR1,U,6),CLIN=$P(OR1,U,7)
S BEG=$P(OR1,U,8),END=$P(OR1,U,9)
I $L($G(WARD)) D
.Q:$L($$GET^XPAR(ORPDUZ,"ORLP DEFAULT WARD",1,"Q"))
.D EN^XPAR(ORPDUZ,"ORLP DEFAULT WARD",1,"`"_WARD,.ERR)
.I +ERR>0 S X="Error: "_ERR_" - converting default WARD "_WARD_" for user "_$G(NAME)_"!" D BMES^XPDUTL(X)
I $L($G(TEAM)) D
.Q:$L($$GET^XPAR(ORPDUZ,"ORLP DEFAULT TEAM",1,"Q"))
.D EN^XPAR(ORPDUZ,"ORLP DEFAULT TEAM",1,"`"_TEAM,.ERR)
.I +ERR>0 S X="Error: "_ERR_" - converting default TEAM "_TEAM_" for user "_$G(NAME)_"!" D BMES^XPDUTL(X)
I $L($G(FROM)) D
.S FROM=$S(FROM="P":"T",FROM="V":"P",1:FROM) ;convert to param codes
.Q:$L($$GET^XPAR(ORPDUZ,"ORLP DEFAULT LIST SOURCE",1,"Q"))
.D EN^XPAR(ORPDUZ,"ORLP DEFAULT LIST SOURCE",1,FROM,.ERR)
.I +ERR>0 S X="Error: "_ERR_" - converting default LIST SRC "_FROM_" for user "_$G(NAME)_"!" D BMES^XPDUTL(X)
I $L($G(CLIN)) D
.Q:$L($$GET^XPAR(ORPDUZ,"ORLP DEFAULT CLINIC MONDAY",1,"Q"))
.D EN^XPAR(ORPDUZ,"ORLP DEFAULT CLINIC MONDAY",1,"`"_CLIN,.ERR)
.I +ERR>0 S X="Error: "_ERR_" - converting default CLINIC MON "_CLIN_" for user "_$G(NAME)_"!" D BMES^XPDUTL(X)
.Q:$L($$GET^XPAR(ORPDUZ,"ORLP DEFAULT CLINIC TUESDAY",1,"Q"))
.D EN^XPAR(ORPDUZ,"ORLP DEFAULT CLINIC TUESDAY",1,"`"_CLIN,.ERR)
.I +ERR>0 S X="Error: "_ERR_" - converting default CLINIC TUE "_CLIN_" for user "_$G(NAME)_"!" D BMES^XPDUTL(X)
.Q:$L($$GET^XPAR(ORPDUZ,"ORLP DEFAULT CLINIC WEDNESDAY",1,"Q"))
.D EN^XPAR(ORPDUZ,"ORLP DEFAULT CLINIC WEDNESDAY",1,"`"_CLIN,.ERR)
.I +ERR>0 S X="Error: "_ERR_" - converting default CLINIC WED "_CLIN_" for user "_$G(NAME)_"!" D BMES^XPDUTL(X)
.Q:$L($$GET^XPAR(ORPDUZ,"ORLP DEFAULT CLINIC THURSDAY",1,"Q"))
.D EN^XPAR(ORPDUZ,"ORLP DEFAULT CLINIC THURSDAY",1,"`"_CLIN,.ERR)
.I +ERR>0 S X="Error: "_ERR_" - converting default CLINIC THU "_CLIN_" for user "_$G(NAME)_"!" D BMES^XPDUTL(X)
.Q:$L($$GET^XPAR(ORPDUZ,"ORLP DEFAULT CLINIC FRIDAY",1,"Q"))
.D EN^XPAR(ORPDUZ,"ORLP DEFAULT CLINIC FRIDAY",1,"`"_CLIN,.ERR)
.I +ERR>0 S X="Error: "_ERR_" - converting default CLINIC FRI "_CLIN_" for user "_$G(NAME)_"!" D BMES^XPDUTL(X)
.Q:$L($$GET^XPAR(ORPDUZ,"ORLP DEFAULT CLINIC SATURDAY",1,"Q"))
.D EN^XPAR(ORPDUZ,"ORLP DEFAULT CLINIC SATURDAY",1,"`"_CLIN,.ERR)
.I +ERR>0 S X="Error: "_ERR_" - converting default CLINIC SAT "_CLIN_" for user "_$G(NAME)_"!" D BMES^XPDUTL(X)
.Q:$L($$GET^XPAR(ORPDUZ,"ORLP DEFAULT CLINIC SUNDAY",1,"Q"))
.D EN^XPAR(ORPDUZ,"ORLP DEFAULT CLINIC SUNDAY",1,"`"_CLIN,.ERR)
.I +ERR>0 S X="Error: "_ERR_" - converting default CLINIC SUN "_CLIN_" for user "_$G(NAME)_"!" D BMES^XPDUTL(X)
I $L($G(BEG)) D
.Q:$L($$GET^XPAR(ORPDUZ,"ORLP DEFAULT CLINIC START DATE",1,"Q"))
.D EN^XPAR(ORPDUZ,"ORLP DEFAULT CLINIC START DATE",1,BEG,.ERR)
.I +ERR>0 S X="Error: "_ERR_" - converting default CLIN STRT DATE "_BEG_" for user "_$G(NAME)_"!" D BMES^XPDUTL(X)
I $L($G(END)) D
.Q:$L($$GET^XPAR(ORPDUZ,"ORLP DEFAULT CLINIC STOP DATE",1,"Q"))
.D EN^XPAR(ORPDUZ,"ORLP DEFAULT CLINIC STOP DATE",1,END,.ERR)
.I +ERR>0 S X="Error: "_ERR_" - converting default CLIN STOP DATE "_END_" for user "_$G(NAME)_"!" D BMES^XPDUTL(X)
Q
OR2 ;set defaults from ^VA(200,ORDUZ,100.2)
N X
S SORT=$P(OR2,U,2),PROV=$P(OR2,U,5),SPEC=$P(OR2,U,6)
I $L($G(SORT)) D
.Q:$L($$GET^XPAR(ORPDUZ,"ORLP DEFAULT LIST ORDER",1,"Q"))
.D EN^XPAR(ORPDUZ,"ORLP DEFAULT LIST ORDER",1,SORT,.ERR)
.I +ERR>0 S X="Error: "_ERR_" - converting default LIST ORDER "_SORT_" for user "_$G(NAME)_"!" D BMES^XPDUTL(X)
I $L($G(PROV)) D
.Q:$L($$GET^XPAR(ORPDUZ,"ORLP DEFAULT PROVIDER",1,"Q"))
.D EN^XPAR(ORPDUZ,"ORLP DEFAULT PROVIDER",1,"`"_PROV,.ERR)
.I +ERR>0 S X="Error: "_ERR_" - converting default PROVIDER "_PROV_" for user "_$G(NAME)_"!" D BMES^XPDUTL(X)
I $L($G(SPEC)) D
.Q:$L($$GET^XPAR(ORPDUZ,"ORLP DEFAULT SPECIALTY",1,"Q"))
.D EN^XPAR(ORPDUZ,"ORLP DEFAULT SPECIALTY",1,"`"_SPEC,.ERR)
.I +ERR>0 S X="Error: "_ERR_" - converting default SPECIALTY "_SPEC_" for user "_$G(NAME)_"!" D BMES^XPDUTL(X)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORLP3C1 5343 printed Apr 09, 2024@21:32:19 Page 2
ORLP3C1 ; slc/CLA - Utilities to convert OE/RR 2.5 lists ;12/15/97 [ 04/03/97 10:50 AM ]
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**9**;Dec 17, 1997
+2 QUIT
POSTORLP ;convert user defaults for pt from ^VA(200 to Parameters
+1 NEW ORLPC,ERR
+2 SET ORLPC=$$GET^XPAR("SYS","ORLPC CONVERSION",1,"Q")
+3 IF +$GET(ORLPC)>0
DO BMES^XPDUTL("User pt selection defaults already converted.")
QUIT
+4 DO BMES^XPDUTL("Converting user pt selection defaults to parameters...")
+5 DO USERDEF
+6 ;1:conversion done
DO EN^XPAR("SYS","ORLPC CONVERSION",1,"1",.ERR)
+7 SET ORLPC=$$GET^XPAR("SYS","ORLPC CONVERSION",1,"Q")
+8 DO BMES^XPDUTL("Conversion of user pt selection defaults completed.")
+9 QUIT
USERDEF ;move pt selection defaults from file 200 to parameter file [#8989.5]
+1 NEW NAME,ORDUZ,ORPDUZ,OR1,OR2,WARD,TEAM,FROM,CLIN,BEG,END,SORT,PROV,SPEC,ERR,ORCT
+2 SET XPDIDTOT=$PIECE(^VA(200,0),U,4)
SET ORCT=0
+3 DO UPDATE^XPDID(0)
+4 SET ORDUZ=0
SET NAME=""
+5 FOR
SET NAME=$ORDER(^VA(200,"B",NAME))
if NAME=""
QUIT
SET ORDUZ=0
SET ORDUZ=$ORDER(^(NAME,ORDUZ))
Begin DoDot:1
+6 if '$LENGTH($GET(ORDUZ))
QUIT
+7 SET ORPDUZ="USR.`"_ORDUZ
+8 SET (WARD,TEAM,FROM,CLIN,BEG,END,SORT,PROV,SPEC)=""
+9 SET OR1=$GET(^VA(200,ORDUZ,100.1))
SET OR2=$GET(^VA(200,ORDUZ,100.2))
+10 if $LENGTH($GET(OR1))
DO OR1
+11 if $LENGTH($GET(OR2))
DO OR2
+12 SET ORCT=ORCT+1
+13 IF '(ORCT#100)
DO UPDATE^XPDID(ORCT)
End DoDot:1
+14 KILL XPDIDTOT
+15 QUIT
OR1 ;set defaults from ^VA(200,ORDUZ,100.1)
+1 NEW X
+2 SET WARD=$PIECE(OR1,U,4)
SET TEAM=$PIECE(OR1,U,5)
SET FROM=$PIECE(OR1,U,6)
SET CLIN=$PIECE(OR1,U,7)
+3 SET BEG=$PIECE(OR1,U,8)
SET END=$PIECE(OR1,U,9)
+4 IF $LENGTH($GET(WARD))
Begin DoDot:1
+5 if $LENGTH($$GET^XPAR(ORPDUZ,"ORLP DEFAULT WARD",1,"Q"))
QUIT
+6 DO EN^XPAR(ORPDUZ,"ORLP DEFAULT WARD",1,"`"_WARD,.ERR)
+7 IF +ERR>0
SET X="Error: "_ERR_" - converting default WARD "_WARD_" for user "_$GET(NAME)_"!"
DO BMES^XPDUTL(X)
End DoDot:1
+8 IF $LENGTH($GET(TEAM))
Begin DoDot:1
+9 if $LENGTH($$GET^XPAR(ORPDUZ,"ORLP DEFAULT TEAM",1,"Q"))
QUIT
+10 DO EN^XPAR(ORPDUZ,"ORLP DEFAULT TEAM",1,"`"_TEAM,.ERR)
+11 IF +ERR>0
SET X="Error: "_ERR_" - converting default TEAM "_TEAM_" for user "_$GET(NAME)_"!"
DO BMES^XPDUTL(X)
End DoDot:1
+12 IF $LENGTH($GET(FROM))
Begin DoDot:1
+13 ;convert to param codes
SET FROM=$SELECT(FROM="P":"T",FROM="V":"P",1:FROM)
+14 if $LENGTH($$GET^XPAR(ORPDUZ,"ORLP DEFAULT LIST SOURCE",1,"Q"))
QUIT
+15 DO EN^XPAR(ORPDUZ,"ORLP DEFAULT LIST SOURCE",1,FROM,.ERR)
+16 IF +ERR>0
SET X="Error: "_ERR_" - converting default LIST SRC "_FROM_" for user "_$GET(NAME)_"!"
DO BMES^XPDUTL(X)
End DoDot:1
+17 IF $LENGTH($GET(CLIN))
Begin DoDot:1
+18 if $LENGTH($$GET^XPAR(ORPDUZ,"ORLP DEFAULT CLINIC MONDAY",1,"Q"))
QUIT
+19 DO EN^XPAR(ORPDUZ,"ORLP DEFAULT CLINIC MONDAY",1,"`"_CLIN,.ERR)
+20 IF +ERR>0
SET X="Error: "_ERR_" - converting default CLINIC MON "_CLIN_" for user "_$GET(NAME)_"!"
DO BMES^XPDUTL(X)
+21 if $LENGTH($$GET^XPAR(ORPDUZ,"ORLP DEFAULT CLINIC TUESDAY",1,"Q"))
QUIT
+22 DO EN^XPAR(ORPDUZ,"ORLP DEFAULT CLINIC TUESDAY",1,"`"_CLIN,.ERR)
+23 IF +ERR>0
SET X="Error: "_ERR_" - converting default CLINIC TUE "_CLIN_" for user "_$GET(NAME)_"!"
DO BMES^XPDUTL(X)
+24 if $LENGTH($$GET^XPAR(ORPDUZ,"ORLP DEFAULT CLINIC WEDNESDAY",1,"Q"))
QUIT
+25 DO EN^XPAR(ORPDUZ,"ORLP DEFAULT CLINIC WEDNESDAY",1,"`"_CLIN,.ERR)
+26 IF +ERR>0
SET X="Error: "_ERR_" - converting default CLINIC WED "_CLIN_" for user "_$GET(NAME)_"!"
DO BMES^XPDUTL(X)
+27 if $LENGTH($$GET^XPAR(ORPDUZ,"ORLP DEFAULT CLINIC THURSDAY",1,"Q"))
QUIT
+28 DO EN^XPAR(ORPDUZ,"ORLP DEFAULT CLINIC THURSDAY",1,"`"_CLIN,.ERR)
+29 IF +ERR>0
SET X="Error: "_ERR_" - converting default CLINIC THU "_CLIN_" for user "_$GET(NAME)_"!"
DO BMES^XPDUTL(X)
+30 if $LENGTH($$GET^XPAR(ORPDUZ,"ORLP DEFAULT CLINIC FRIDAY",1,"Q"))
QUIT
+31 DO EN^XPAR(ORPDUZ,"ORLP DEFAULT CLINIC FRIDAY",1,"`"_CLIN,.ERR)
+32 IF +ERR>0
SET X="Error: "_ERR_" - converting default CLINIC FRI "_CLIN_" for user "_$GET(NAME)_"!"
DO BMES^XPDUTL(X)
+33 if $LENGTH($$GET^XPAR(ORPDUZ,"ORLP DEFAULT CLINIC SATURDAY",1,"Q"))
QUIT
+34 DO EN^XPAR(ORPDUZ,"ORLP DEFAULT CLINIC SATURDAY",1,"`"_CLIN,.ERR)
+35 IF +ERR>0
SET X="Error: "_ERR_" - converting default CLINIC SAT "_CLIN_" for user "_$GET(NAME)_"!"
DO BMES^XPDUTL(X)
+36 if $LENGTH($$GET^XPAR(ORPDUZ,"ORLP DEFAULT CLINIC SUNDAY",1,"Q"))
QUIT
+37 DO EN^XPAR(ORPDUZ,"ORLP DEFAULT CLINIC SUNDAY",1,"`"_CLIN,.ERR)
+38 IF +ERR>0
SET X="Error: "_ERR_" - converting default CLINIC SUN "_CLIN_" for user "_$GET(NAME)_"!"
DO BMES^XPDUTL(X)
End DoDot:1
+39 IF $LENGTH($GET(BEG))
Begin DoDot:1
+40 if $LENGTH($$GET^XPAR(ORPDUZ,"ORLP DEFAULT CLINIC START DATE",1,"Q"))
QUIT
+41 DO EN^XPAR(ORPDUZ,"ORLP DEFAULT CLINIC START DATE",1,BEG,.ERR)
+42 IF +ERR>0
SET X="Error: "_ERR_" - converting default CLIN STRT DATE "_BEG_" for user "_$GET(NAME)_"!"
DO BMES^XPDUTL(X)
End DoDot:1
+43 IF $LENGTH($GET(END))
Begin DoDot:1
+44 if $LENGTH($$GET^XPAR(ORPDUZ,"ORLP DEFAULT CLINIC STOP DATE",1,"Q"))
QUIT
+45 DO EN^XPAR(ORPDUZ,"ORLP DEFAULT CLINIC STOP DATE",1,END,.ERR)
+46 IF +ERR>0
SET X="Error: "_ERR_" - converting default CLIN STOP DATE "_END_" for user "_$GET(NAME)_"!"
DO BMES^XPDUTL(X)
End DoDot:1
+47 QUIT
OR2 ;set defaults from ^VA(200,ORDUZ,100.2)
+1 NEW X
+2 SET SORT=$PIECE(OR2,U,2)
SET PROV=$PIECE(OR2,U,5)
SET SPEC=$PIECE(OR2,U,6)
+3 IF $LENGTH($GET(SORT))
Begin DoDot:1
+4 if $LENGTH($$GET^XPAR(ORPDUZ,"ORLP DEFAULT LIST ORDER",1,"Q"))
QUIT
+5 DO EN^XPAR(ORPDUZ,"ORLP DEFAULT LIST ORDER",1,SORT,.ERR)
+6 IF +ERR>0
SET X="Error: "_ERR_" - converting default LIST ORDER "_SORT_" for user "_$GET(NAME)_"!"
DO BMES^XPDUTL(X)
End DoDot:1
+7 IF $LENGTH($GET(PROV))
Begin DoDot:1
+8 if $LENGTH($$GET^XPAR(ORPDUZ,"ORLP DEFAULT PROVIDER",1,"Q"))
QUIT
+9 DO EN^XPAR(ORPDUZ,"ORLP DEFAULT PROVIDER",1,"`"_PROV,.ERR)
+10 IF +ERR>0
SET X="Error: "_ERR_" - converting default PROVIDER "_PROV_" for user "_$GET(NAME)_"!"
DO BMES^XPDUTL(X)
End DoDot:1
+11 IF $LENGTH($GET(SPEC))
Begin DoDot:1
+12 if $LENGTH($$GET^XPAR(ORPDUZ,"ORLP DEFAULT SPECIALTY",1,"Q"))
QUIT
+13 DO EN^XPAR(ORPDUZ,"ORLP DEFAULT SPECIALTY",1,"`"_SPEC,.ERR)
+14 IF +ERR>0
SET X="Error: "_ERR_" - converting default SPECIALTY "_SPEC_" for user "_$GET(NAME)_"!"
DO BMES^XPDUTL(X)
End DoDot:1
+15 QUIT
