- 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
