BQI22PSC ;VNGT/HS/ALA-PostInstall Conversion ; 21 Mar 2011 2:39 PM
;;2.2;ICARE MANAGEMENT SYSTEM;;Jul 28, 2011;Build 37
;
EN ;EP - Entry Point
; Description
; For each user and their panels, recalculate the parameter string with the new format for visit data
; and then file it using the BQI SET PANEL FILTERS RPC
;
NEW OWNR,PLIEN
S OWNR=0
I $D(^BQICARE(.5)) K ^BQICARE(.5)
F S OWNR=$O(^BQICARE(OWNR)) Q:'OWNR D
. S PLIEN=0
. F S PLIEN=$O(^BQICARE(OWNR,1,PLIEN)) Q:'PLIEN D
.. D PAR(OWNR,PLIEN)
Q
;
PAR(COWNR,CPLIEN) ; Set up PARMS String
NEW DA,IENS,FSOURCE,PPIEN,PTYP,N,NN,PARMS,MPARMS,NPARM,AN,ASN,ASPM
NEW ATYP,BMXSEC,MASP,MM,MSN,NM,DATA,OKAY,PM,PRVAL,VM
NEW CPARMS
S DA(1)=COWNR,DA=CPLIEN,IENS=$$IENS^DILF(.DA)
S FSOURCE=$$GET1^DIQ(90505.01,IENS,.14,"E")
;
; Find definition
I FSOURCE="" Q
S PPIEN=$$PP^BQIDCDF(FSOURCE) I PPIEN=-1 S BMXSEC="Pre-defined panel type "_FSOURCE_" was not found" Q
;
S N=0,PARMS="",MPARMS="",OKAY=0
I FSOURCE="FILTER",$G(^BQICARE(COWNR,1,CPLIEN,15,0))="" D Q
. NEW DIK,DA
. S DA(1)=COWNR,DA=CPLIEN,DIK="^BQICARE("_DA(1)_",1,"
. D ^DIK
F S N=$O(^BQICARE(COWNR,1,CPLIEN,15,N)) Q:'N D
. NEW DA,IENS
. S DA(2)=COWNR,DA(1)=CPLIEN,DA=N,IENS=$$IENS^DILF(.DA)
. S NAME=$$GET1^DIQ(90505.115,IENS,.01,"E")
. I NAME="NUMVIS"!(NAME="CLIN")!(NAME="PROV") S OKAY=1
. S PTYP=$$PTYP^BQIDCDF(FSOURCE,NAME)
. S FILTER(N)=NAME
. I '$D(^BQICARE(COWNR,1,CPLIEN,15,N,1)) D Q
.. NEW DA,IENS,NAME,VALUE
.. S DA(2)=COWNR,DA(1)=CPLIEN,DA=N,IENS=$$IENS^DILF(.DA)
.. I PTYP="T" S VALUE=$$GET1^DIQ(90505.115,IENS,.03,"E")
.. I PTYP'="T" S VALUE=$$GET1^DIQ(90505.115,IENS,.02,"E")
.. I PTYP="D" S VALUE=$$FMTE^BQIUL1(VALUE)
.. S FILTER(N,1)=VALUE
.. ; Check for associated parameters
.. S ASN=0
.. F S ASN=$O(^BQICARE(COWNR,1,CPLIEN,15,N,2,ASN)) Q:'ASN D
... NEW DA,IENS,ASSOC,AVALUE,VALUE
... S DA(3)=COWNR,DA(2)=CPLIEN,DA(1)=N,DA=ASN,IENS=$$IENS^DILF(.DA)
... S ASSOC=$$GET1^DIQ(90505.1152,IENS,.01,"E")
... S ATYP=$$PTYP^BQIDCDF(FSOURCE,ASSOC)
... S FILTER(N,1,ASN)=ASSOC
... I '$D(^BQICARE(COWNR,1,CPLIEN,15,N,2,ASN,1)) D Q
.... I ATYP="T" S VALUE=$$GET1^DIQ(90505.1152,IENS,.03,"E")
.... I ATYP'="T" S VALUE=$$GET1^DIQ(90505.1152,IENS,.02,"E")
.... I ATYP="D" S VALUE=$$FMTE^BQIUL1(VALUE)
.... S FILTER(N,1,ASN,1)=VALUE
... S MSN=0
... F S MSN=$O(^BQICARE(COWNR,1,CPLIEN,15,N,2,ASN,1,MSN)) Q:'MSN D
.... NEW DA,IENS,VALUE
.... S DA(4)=COWNR,DA(3)=CPLIEN,DA(2)=N,DA(1)=ASN,DA=MSN,IENS=$$IENS^DILF(.DA)
.... I ATYP="T" S VALUE=$$GET1^DIQ(90505.11521,IENS,.02,"E")
.... I ATYP'="T" S VALUE=$$GET1^DIQ(90505.11521,IENS,.01,"E")
.... I ATYP="D" S VALUE=$$FMTE^BQIUL1(VALUE)
.... S FILTER(N,1,ASN,MSN)=VALUE
. ;
. S NN=0
. F S NN=$O(^BQICARE(COWNR,1,CPLIEN,15,N,1,NN)) Q:'NN D
.. NEW DA,IENS,VALUE
.. S DA(3)=COWNR,DA(2)=CPLIEN,DA(1)=N,DA=NN,IENS=$$IENS^DILF(.DA)
.. I PTYP="T" S VALUE=$$GET1^DIQ(90505.1151,IENS,.02,"E")
.. I PTYP'="T" S VALUE=$$GET1^DIQ(90505.1151,IENS,.01,"E")
.. I PTYP="D" S VALUE=$$FMTE^BQIUL1(VALUE)
.. S FILTER(N,NN)=VALUE
.. ; Check for associated parameters
.. S ASN=0
.. F S ASN=$O(^BQICARE(COWNR,1,CPLIEN,15,N,1,NN,2,ASN)) Q:'ASN D
... NEW DA,IENS,ASSOC,AVALUE,VALUE
... S DA(4)=COWNR,DA(3)=CPLIEN,DA(2)=N,DA(1)=NN,DA=ASN,IENS=$$IENS^DILF(.DA)
... S ASSOC=$$GET1^DIQ(90505.11512,IENS,.01,"E")
... S ATYP=$$PTYP^BQIDCDF(FSOURCE,ASSOC)
... S FILTER(N,NN,ASN)=ASSOC
... I '$D(^BQICARE(COWNR,1,CPLIEN,15,N,1,NN,2,ASN,1)) D Q
.... I ATYP="T" S VALUE=$$GET1^DIQ(90505.11512,IENS,.03,"E")
.... I ATYP'="T" S VALUE=$$GET1^DIQ(90505.11512,IENS,.02,"E")
.... I ATYP="D" S VALUE=$$FMTE^BQIUL1(VALUE)
.... S FILTER(N,NN,ASN,1)=VALUE
... S MSN=0
... F S MSN=$O(^BQICARE(COWNR,1,CPLIEN,15,N,1,NN,2,ASN,1,MSN)) Q:'MSN D
.... NEW DA,IENS,VALUE
.... S DA(5)=COWNR,DA(4)=CPLIEN,DA(3)=N,DA(2)=NN,DA(1)=ASN,DA=MSN,IENS=$$IENS^DILF(.DA)
.... I ATYP="T" S VALUE=$$GET1^DIQ(90505.115121,IENS,.02,"E")
.... I ATYP'="T" S VALUE=$$GET1^DIQ(90505.115121,IENS,.01,"E")
.... I ATYP="D" S VALUE=$$FMTE^BQIUL1(VALUE)
.... S FILTER(N,NN,ASN,MSN)=VALUE
;
I 'OKAY K FILTER Q
; Recreate PARMS string if panel definition contains visit detail
D PAS(1)
I $D(FILTER) D PAS(2)
S PARMS=$$TKO^BQIUL1(PARMS,$C(28))
S PM=""
F S PM=$O(FILTER(PM)) Q:PM="" D
. S NAME=FILTER(PM)
. I NAME="PROV" D
.. S VM=1,PRVAL=NAME_"="_FILTER(PM,VM)
.. I PARMS'["RANGE",PARMS'["FROM" D
... I $E(PARMS,$L(PARMS))'=$C(28),PARMS'="" S PARMS=PARMS_$C(28)_"RANGE=Ever"_$C(28) Q
... S PARMS=PARMS_"RANGE=Ever"_$C(28)
.. I PARMS'["NUMVIS" D
... I $E(PARMS,$L(PARMS))'=$C(28),PARMS'="" S PARMS=PARMS_$C(28)_"NUMVIS='<1" Q
... S PARMS=PARMS_"NUMVIS='<1"
.. S PARMS=PARMS_$C(25)_PRVAL
. I NAME="CLIN" D
.. S VM=""
.. F S VM=$O(FILTER(PM,VM)) Q:VM="" D
... S PARMS=PARMS_$C(25)_NAME_"="_FILTER(PM,VM)_$C(29)
... I $O(FILTER(PM,VM))'="" S PARMS=PARMS_NPARM
.. S PARMS=$$TKO^BQIUL1(PARMS,$C(29))
S CPARMS=$$TKO^BQIUL1(PARMS,$C(29))
K FILTER,PARMS,NPARM,ADA,ADTM,ASSOC,AVAL,NAME,FNAME,MDA,Y
D CON^BQIPLFL(.DATA,COWNR,CPLIEN,CPARMS)
Q
;
PAS(PS) ; Build PARMS from each pass
S PM=""
F S PM=$O(FILTER(PM)) Q:PM="" D
. S NAME=FILTER(PM)
. I PS=1,NAME="PROV"!(NAME="CLIN")!(NAME="NUMVIS") Q
. I PS=2,NAME="PROV"!(NAME="CLIN") Q
. ;I PS=3 S PARMS=PARMS_$S($E(PARMS,$L(PARMS),$L(PARMS))'=$C(25):$C(25),1:"")
. S PARMS=$G(PARMS)_NAME_"="
. S VM=""
. F S VM=$O(FILTER(PM,VM)) Q:VM="" D
.. S AN=""
.. F S AN=$O(FILTER(PM,VM,AN)) Q:AN="" D
... S MM="",MASP=""
... F S MM=$O(FILTER(PM,VM,AN,MM)) Q:MM="" D
.... S MASP=$G(MASP)_FILTER(PM,VM,AN,MM)_$C(24)
... S MASP=$$TKO^BQIUL1(MASP,$C(24))
... S ASPM=FILTER(PM,VM,AN)_"="_MASP
... S MPRM(VM)=$S(AN'<2:$$TKO^BQIUL1(MPRM(VM),$C(29)),1:FILTER(PM,VM))_$C(25)_ASPM_$C(29)
.. I '$D(MPRM(VM)) D
... I NAME'="NUMVIS" S MPRM(VM)=FILTER(PM,VM)_$C(29) Q
... I NAME="NUMVIS" S MPRM(VM)=FILTER(PM,VM)_"~"
. S NM="",NPARM=""
. F S NM=$O(MPRM(NM)) Q:NM="" D
.. S PARMS=PARMS_MPRM(NM)
.. I NAME="NUMVIS" S NPARM=NPARM_MPRM(NM)
. I NAME'="NUMVIS" S PARMS=$$TKO^BQIUL1(PARMS,$C(29))
. I NAME="NUMVIS" S PARMS=$$TKO^BQIUL1(PARMS,"~"),NPARM=$$TKO^BQIUL1(NPARM,"~")
. S PARMS=PARMS_$S(PS<3:$C(28),$E(PARMS,$L(PARMS),$L(PARMS))'=$C(25):$C(25),1:"")
. K MPRM,FILTER(PM)
Q
BQI22PSC ;VNGT/HS/ALA-PostInstall Conversion ; 21 Mar 2011 2:39 PM
+1 ;;2.2;ICARE MANAGEMENT SYSTEM;;Jul 28, 2011;Build 37
+2 ;
EN ;EP - Entry Point
+1 ; Description
+2 ; For each user and their panels, recalculate the parameter string with the new format for visit data
+3 ; and then file it using the BQI SET PANEL FILTERS RPC
+4 ;
+5 NEW OWNR,PLIEN
+6 SET OWNR=0
+7 IF $DATA(^BQICARE(.5))
KILL ^BQICARE(.5)
+8 FOR
SET OWNR=$ORDER(^BQICARE(OWNR))
IF 'OWNR
QUIT
Begin DoDot:1
+9 SET PLIEN=0
+10 FOR
SET PLIEN=$ORDER(^BQICARE(OWNR,1,PLIEN))
IF 'PLIEN
QUIT
Begin DoDot:2
+11 DO PAR(OWNR,PLIEN)
End DoDot:2
End DoDot:1
+12 QUIT
+13 ;
PAR(COWNR,CPLIEN) ; Set up PARMS String
+1 NEW DA,IENS,FSOURCE,PPIEN,PTYP,N,NN,PARMS,MPARMS,NPARM,AN,ASN,ASPM
+2 NEW ATYP,BMXSEC,MASP,MM,MSN,NM,DATA,OKAY,PM,PRVAL,VM
+3 NEW CPARMS
+4 SET DA(1)=COWNR
SET DA=CPLIEN
SET IENS=$$IENS^DILF(.DA)
+5 SET FSOURCE=$$GET1^DIQ(90505.01,IENS,.14,"E")
+6 ;
+7 ; Find definition
+8 IF FSOURCE=""
QUIT
+9 SET PPIEN=$$PP^BQIDCDF(FSOURCE)
IF PPIEN=-1
SET BMXSEC="Pre-defined panel type "_FSOURCE_" was not found"
QUIT
+10 ;
+11 SET N=0
SET PARMS=""
SET MPARMS=""
SET OKAY=0
+12 IF FSOURCE="FILTER"
IF $GET(^BQICARE(COWNR,1,CPLIEN,15,0))=""
Begin DoDot:1
+13 NEW DIK,DA
+14 SET DA(1)=COWNR
SET DA=CPLIEN
SET DIK="^BQICARE("_DA(1)_",1,"
+15 DO ^DIK
End DoDot:1
QUIT
+16 FOR
SET N=$ORDER(^BQICARE(COWNR,1,CPLIEN,15,N))
IF 'N
QUIT
Begin DoDot:1
+17 NEW DA,IENS
+18 SET DA(2)=COWNR
SET DA(1)=CPLIEN
SET DA=N
SET IENS=$$IENS^DILF(.DA)
+19 SET NAME=$$GET1^DIQ(90505.115,IENS,.01,"E")
+20 IF NAME="NUMVIS"!(NAME="CLIN")!(NAME="PROV")
SET OKAY=1
+21 SET PTYP=$$PTYP^BQIDCDF(FSOURCE,NAME)
+22 SET FILTER(N)=NAME
+23 IF '$DATA(^BQICARE(COWNR,1,CPLIEN,15,N,1))
Begin DoDot:2
+24 NEW DA,IENS,NAME,VALUE
+25 SET DA(2)=COWNR
SET DA(1)=CPLIEN
SET DA=N
SET IENS=$$IENS^DILF(.DA)
+26 IF PTYP="T"
SET VALUE=$$GET1^DIQ(90505.115,IENS,.03,"E")
+27 IF PTYP'="T"
SET VALUE=$$GET1^DIQ(90505.115,IENS,.02,"E")
+28 IF PTYP="D"
SET VALUE=$$FMTE^BQIUL1(VALUE)
+29 SET FILTER(N,1)=VALUE
+30 ; Check for associated parameters
+31 SET ASN=0
+32 FOR
SET ASN=$ORDER(^BQICARE(COWNR,1,CPLIEN,15,N,2,ASN))
IF 'ASN
QUIT
Begin DoDot:3
+33 NEW DA,IENS,ASSOC,AVALUE,VALUE
+34 SET DA(3)=COWNR
SET DA(2)=CPLIEN
SET DA(1)=N
SET DA=ASN
SET IENS=$$IENS^DILF(.DA)
+35 SET ASSOC=$$GET1^DIQ(90505.1152,IENS,.01,"E")
+36 SET ATYP=$$PTYP^BQIDCDF(FSOURCE,ASSOC)
+37 SET FILTER(N,1,ASN)=ASSOC
+38 IF '$DATA(^BQICARE(COWNR,1,CPLIEN,15,N,2,ASN,1))
Begin DoDot:4
+39 IF ATYP="T"
SET VALUE=$$GET1^DIQ(90505.1152,IENS,.03,"E")
+40 IF ATYP'="T"
SET VALUE=$$GET1^DIQ(90505.1152,IENS,.02,"E")
+41 IF ATYP="D"
SET VALUE=$$FMTE^BQIUL1(VALUE)
+42 SET FILTER(N,1,ASN,1)=VALUE
End DoDot:4
QUIT
+43 SET MSN=0
+44 FOR
SET MSN=$ORDER(^BQICARE(COWNR,1,CPLIEN,15,N,2,ASN,1,MSN))
IF 'MSN
QUIT
Begin DoDot:4
+45 NEW DA,IENS,VALUE
+46 SET DA(4)=COWNR
SET DA(3)=CPLIEN
SET DA(2)=N
SET DA(1)=ASN
SET DA=MSN
SET IENS=$$IENS^DILF(.DA)
+47 IF ATYP="T"
SET VALUE=$$GET1^DIQ(90505.11521,IENS,.02,"E")
+48 IF ATYP'="T"
SET VALUE=$$GET1^DIQ(90505.11521,IENS,.01,"E")
+49 IF ATYP="D"
SET VALUE=$$FMTE^BQIUL1(VALUE)
+50 SET FILTER(N,1,ASN,MSN)=VALUE
End DoDot:4
End DoDot:3
End DoDot:2
QUIT
+51 ;
+52 SET NN=0
+53 FOR
SET NN=$ORDER(^BQICARE(COWNR,1,CPLIEN,15,N,1,NN))
IF 'NN
QUIT
Begin DoDot:2
+54 NEW DA,IENS,VALUE
+55 SET DA(3)=COWNR
SET DA(2)=CPLIEN
SET DA(1)=N
SET DA=NN
SET IENS=$$IENS^DILF(.DA)
+56 IF PTYP="T"
SET VALUE=$$GET1^DIQ(90505.1151,IENS,.02,"E")
+57 IF PTYP'="T"
SET VALUE=$$GET1^DIQ(90505.1151,IENS,.01,"E")
+58 IF PTYP="D"
SET VALUE=$$FMTE^BQIUL1(VALUE)
+59 SET FILTER(N,NN)=VALUE
+60 ; Check for associated parameters
+61 SET ASN=0
+62 FOR
SET ASN=$ORDER(^BQICARE(COWNR,1,CPLIEN,15,N,1,NN,2,ASN))
IF 'ASN
QUIT
Begin DoDot:3
+63 NEW DA,IENS,ASSOC,AVALUE,VALUE
+64 SET DA(4)=COWNR
SET DA(3)=CPLIEN
SET DA(2)=N
SET DA(1)=NN
SET DA=ASN
SET IENS=$$IENS^DILF(.DA)
+65 SET ASSOC=$$GET1^DIQ(90505.11512,IENS,.01,"E")
+66 SET ATYP=$$PTYP^BQIDCDF(FSOURCE,ASSOC)
+67 SET FILTER(N,NN,ASN)=ASSOC
+68 IF '$DATA(^BQICARE(COWNR,1,CPLIEN,15,N,1,NN,2,ASN,1))
Begin DoDot:4
+69 IF ATYP="T"
SET VALUE=$$GET1^DIQ(90505.11512,IENS,.03,"E")
+70 IF ATYP'="T"
SET VALUE=$$GET1^DIQ(90505.11512,IENS,.02,"E")
+71 IF ATYP="D"
SET VALUE=$$FMTE^BQIUL1(VALUE)
+72 SET FILTER(N,NN,ASN,1)=VALUE
End DoDot:4
QUIT
+73 SET MSN=0
+74 FOR
SET MSN=$ORDER(^BQICARE(COWNR,1,CPLIEN,15,N,1,NN,2,ASN,1,MSN))
IF 'MSN
QUIT
Begin DoDot:4
+75 NEW DA,IENS,VALUE
+76 SET DA(5)=COWNR
SET DA(4)=CPLIEN
SET DA(3)=N
SET DA(2)=NN
SET DA(1)=ASN
SET DA=MSN
SET IENS=$$IENS^DILF(.DA)
+77 IF ATYP="T"
SET VALUE=$$GET1^DIQ(90505.115121,IENS,.02,"E")
+78 IF ATYP'="T"
SET VALUE=$$GET1^DIQ(90505.115121,IENS,.01,"E")
+79 IF ATYP="D"
SET VALUE=$$FMTE^BQIUL1(VALUE)
+80 SET FILTER(N,NN,ASN,MSN)=VALUE
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+81 ;
+82 IF 'OKAY
KILL FILTER
QUIT
+83 ; Recreate PARMS string if panel definition contains visit detail
+84 DO PAS(1)
+85 IF $DATA(FILTER)
DO PAS(2)
+86 SET PARMS=$$TKO^BQIUL1(PARMS,$CHAR(28))
+87 SET PM=""
+88 FOR
SET PM=$ORDER(FILTER(PM))
IF PM=""
QUIT
Begin DoDot:1
+89 SET NAME=FILTER(PM)
+90 IF NAME="PROV"
Begin DoDot:2
+91 SET VM=1
SET PRVAL=NAME_"="_FILTER(PM,VM)
+92 IF PARMS'["RANGE"
IF PARMS'["FROM"
Begin DoDot:3
+93 IF $EXTRACT(PARMS,$LENGTH(PARMS))'=$CHAR(28)
IF PARMS'=""
SET PARMS=PARMS_$CHAR(28)_"RANGE=Ever"_$CHAR(28)
QUIT
+94 SET PARMS=PARMS_"RANGE=Ever"_$CHAR(28)
End DoDot:3
+95 IF PARMS'["NUMVIS"
Begin DoDot:3
+96 IF $EXTRACT(PARMS,$LENGTH(PARMS))'=$CHAR(28)
IF PARMS'=""
SET PARMS=PARMS_$CHAR(28)_"NUMVIS='<1"
QUIT
+97 SET PARMS=PARMS_"NUMVIS='<1"
End DoDot:3
+98 SET PARMS=PARMS_$CHAR(25)_PRVAL
End DoDot:2
+99 IF NAME="CLIN"
Begin DoDot:2
+100 SET VM=""
+101 FOR
SET VM=$ORDER(FILTER(PM,VM))
IF VM=""
QUIT
Begin DoDot:3
+102 SET PARMS=PARMS_$CHAR(25)_NAME_"="_FILTER(PM,VM)_$CHAR(29)
+103 IF $ORDER(FILTER(PM,VM))'=""
SET PARMS=PARMS_NPARM
End DoDot:3
+104 SET PARMS=$$TKO^BQIUL1(PARMS,$CHAR(29))
End DoDot:2
End DoDot:1
+105 SET CPARMS=$$TKO^BQIUL1(PARMS,$CHAR(29))
+106 KILL FILTER,PARMS,NPARM,ADA,ADTM,ASSOC,AVAL,NAME,FNAME,MDA,Y
+107 DO CON^BQIPLFL(.DATA,COWNR,CPLIEN,CPARMS)
+108 QUIT
+109 ;
PAS(PS) ; Build PARMS from each pass
+1 SET PM=""
+2 FOR
SET PM=$ORDER(FILTER(PM))
IF PM=""
QUIT
Begin DoDot:1
+3 SET NAME=FILTER(PM)
+4 IF PS=1
IF NAME="PROV"!(NAME="CLIN")!(NAME="NUMVIS")
QUIT
+5 IF PS=2
IF NAME="PROV"!(NAME="CLIN")
QUIT
+6 ;I PS=3 S PARMS=PARMS_$S($E(PARMS,$L(PARMS),$L(PARMS))'=$C(25):$C(25),1:"")
+7 SET PARMS=$GET(PARMS)_NAME_"="
+8 SET VM=""
+9 FOR
SET VM=$ORDER(FILTER(PM,VM))
IF VM=""
QUIT
Begin DoDot:2
+10 SET AN=""
+11 FOR
SET AN=$ORDER(FILTER(PM,VM,AN))
IF AN=""
QUIT
Begin DoDot:3
+12 SET MM=""
SET MASP=""
+13 FOR
SET MM=$ORDER(FILTER(PM,VM,AN,MM))
IF MM=""
QUIT
Begin DoDot:4
+14 SET MASP=$GET(MASP)_FILTER(PM,VM,AN,MM)_$CHAR(24)
End DoDot:4
+15 SET MASP=$$TKO^BQIUL1(MASP,$CHAR(24))
+16 SET ASPM=FILTER(PM,VM,AN)_"="_MASP
+17 SET MPRM(VM)=$SELECT(AN'<2:$$TKO^BQIUL1(MPRM(VM),$CHAR(29)),1:FILTER(PM,VM))_$CHAR(25)_ASPM_$CHAR(29)
End DoDot:3
+18 IF '$DATA(MPRM(VM))
Begin DoDot:3
+19 IF NAME'="NUMVIS"
SET MPRM(VM)=FILTER(PM,VM)_$CHAR(29)
QUIT
+20 IF NAME="NUMVIS"
SET MPRM(VM)=FILTER(PM,VM)_"~"
End DoDot:3
End DoDot:2
+21 SET NM=""
SET NPARM=""
+22 FOR
SET NM=$ORDER(MPRM(NM))
IF NM=""
QUIT
Begin DoDot:2
+23 SET PARMS=PARMS_MPRM(NM)
+24 IF NAME="NUMVIS"
SET NPARM=NPARM_MPRM(NM)
End DoDot:2
+25 IF NAME'="NUMVIS"
SET PARMS=$$TKO^BQIUL1(PARMS,$CHAR(29))
+26 IF NAME="NUMVIS"
SET PARMS=$$TKO^BQIUL1(PARMS,"~")
SET NPARM=$$TKO^BQIUL1(NPARM,"~")
+27 SET PARMS=PARMS_$SELECT(PS<3:$CHAR(28),$EXTRACT(PARMS,$LENGTH(PARMS),$LENGTH(PARMS))'=$CHAR(25):$CHAR(25),1:"")
+28 KILL MPRM,FILTER(PM)
End DoDot:1
+29 QUIT
