- 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
