| 1 | BMXADOF ; IHS/CIHA/GIS - RPC CALL FOR EXTENDED FUNCTIONALITY OF BMXNet UTILITIES ;
|
|---|
| 2 | ;;2.31;BMX;;Jul 25, 2011
|
|---|
| 3 | ; THIS IS THE ADO RECORDSET FILER: ADO -> FILEMAN
|
|---|
| 4 | ; VISIT FILE UPDATES REPRESENT A SPECIAL CASE HTAT IS MANAGED IN BMXADOF1
|
|---|
| 5 | ; INCLUDES TRANSACTION CONTROLS
|
|---|
| 6 | ;
|
|---|
| 7 | ;
|
|---|
| 8 | ;
|
|---|
| 9 | N DAS,FILE,DATA,OUT S DAS=7,FILE=19707.82,DATA="2.02|120/83" D FILE(.OUT,FILE,DAS,DATA) W !,OUT Q
|
|---|
| 10 | ;
|
|---|
| 11 | FILED(OUT,FILE,DAS,DATA) ; RPC CALL: UNIVERSAL FILEMAN RECORD UPDATER UTILITY
|
|---|
| 12 | D DEBUG^%Serenji("FILE^BMXADOF(.OUT,FILE,DAS,DATA)") ; DEBUGGER ENTRY POINT
|
|---|
| 13 | ; K ^GREG S ^GREG("OUT")=$G(OUT),^("FILE")=$G(FILE),^("DAS")=$G(DAS),^("DATA")=$G(DATA) D FILE(.OUT,FILE,DAS,DATA)
|
|---|
| 14 | Q
|
|---|
| 15 | ;
|
|---|
| 16 | FILEX(OUT,FILE,DAS,DATA) ; EP - RPC CALL: INSURES THAT BMXIEN IS VALID - MOJO ONLY
|
|---|
| 17 | I '$L($G(DATA)) D
|
|---|
| 18 | . S DATA="",%=""
|
|---|
| 19 | . F S %=$O(DATA(%)) Q:'% S DATA=DATA_DATA(%) ; CONVERT DATA ARRAY INTO A DATA STRING
|
|---|
| 20 | . Q
|
|---|
| 21 | I '$L(DATA) Q
|
|---|
| 22 | I DATA["999|" S DAS=+$P(DATA,"999|",2) I 'DAS S DAS="" ; FORCE NEW ENTRY
|
|---|
| 23 | D FILE(.OUT,FILE,$G(DAS),DATA)
|
|---|
| 24 | Q
|
|---|
| 25 | ;
|
|---|
| 26 | FILE(OUT,FILE,DAS,DATA) ;EP - RPC CALL: UNIVERSAL FILEMAN RECORD UPDATER UTILITY
|
|---|
| 27 | ;
|
|---|
| 28 | ; OUT = OUTBOUND MESSAGE RETURNED TO CALLINING APP. 'OK'=SUCCESSFUL TRANSACTION, 'OK|5' NEW RECORD DAS=5 ADDED
|
|---|
| 29 | ; IF TRANSACTION FAILS, AN ERROR MESSAGE IS PASSED
|
|---|
| 30 | ; FILE = VALID FILEMAN FILE OR SUB-FILE NUMBER - WHERE UPDATE IS TO OCCUR
|
|---|
| 31 | ; DAS = THE DA STRING - TYPICALLY THE FILE INTERNAL ENTRY NUMBER OF THE RECORD TO BE UPDATED
|
|---|
| 32 | ; IF THIS IS A SUB-FILE, DAS MUST BE PRECEDED BY PARENT DAS(S) IN COMMA SEPARATED STRING - TOP TO BOTTOM ORDER
|
|---|
| 33 | ; DAS MAY BE PRECEDED BY '+' = ALL FIELDS ARE MANDATORY (REQD FOR TRANSACTION) OR '-' = DELETE THIS ENTRY
|
|---|
| 34 | ; IF DAS STRING = NULL OR = '+', THIS MEANS ADD A NEW RECORD WITH DATA SUPPLIED IN DATA PARAMETER
|
|---|
| 35 | ; EXAMPLES OF DAS STRINGS: '1' (EDIT RECORD #1), '5,2,-7' (DELETE RECORD #7 IN 3RD LEVEL SUBFILE)
|
|---|
| 36 | ; DATA = DATA STRING OR ARRAY REFERENCE. DATA CAN BE PASSED USING THE .PARAM SYNTAX
|
|---|
| 37 | ; DATA STRING FORMAT: FIELD#|VALUE_$C(30)_FIELD#|VALUE_$C(30)_...FIELD#|VALUE_$C(30)
|
|---|
| 38 | ; $C(30) [AKA EOR] IS THE DATA ELEMENT SEPARATOR
|
|---|
| 39 | ; $C(30) IS USED AS THE DATA DELIMITER BECAUSE OTHER CHARACTERS LIKE '^' COULD APPEAR IN THE VALUE PIECE!
|
|---|
| 40 | ; EA FIELD# MAY BE PRECEED BY '+' = MANDATORY (REQD FOR TRANSACTION) OR '-' = DELETE THE VALUE OF THIS FIELD
|
|---|
| 41 | ; EXAMPLE: ".03|1/5/46"_EOR_"-.02|"_EOR_"+.09|139394444"_EOR NOTE -.02| IS SAME AS .02|@ OR .02|
|
|---|
| 42 | ; '+' IN FRONT OF THE DAS IS THE SAME AS PUTTING A '+' IN FRONT OF EVERY FIELD# IN THE DATA STRING
|
|---|
| 43 | ;
|
|---|
| 44 | ;
|
|---|
| 45 | ;
|
|---|
| 46 | N VENDUZ,VUZ
|
|---|
| 47 | M VENDUZ=DUZ S VUZ=$C(68,85,90)
|
|---|
| 48 | N OREF,CREF,DIC,DIE,DA,DR,X,Y,%,I,FLD,CNT,FNO,VAL,@VUZ,TFLG,DFLG,TOT,UFLG,XTFLG,GTFLG,GDFLG,LVLS,IENS
|
|---|
| 49 | I $G(FILE)=9000010 N AUPNPAT,AUPNDOB,AUPNDOD,AUPNVSIT,AUPNTALK,APCDOVRR S (APCDOVRR,AUPNTALK)=1 ; THE VISIT FILE IS UPDATED IN THIS TRANSACTION
|
|---|
| 50 | X ("M "_$C(68,85,90)_"=VENDUZ S "_$C(68,85,90)_"(0)="_$C(34,64,34)) K VENDUZ ; ELININATES PERMISSION PROBLEMS
|
|---|
| 51 | S OUT="",FLD="",GTFLG=0,GDFLG=0
|
|---|
| 52 | S X="MERR^BMXADOF",@^%ZOSF("TRAP") ; SET MUMPS ERROR TRAP
|
|---|
| 53 | I '$D(^DD(+$G(FILE))) S OUT="Invalid file number" Q ; FILE # MUST BE VALID
|
|---|
| 54 | S DAS=$G(DAS) I $E(DAS)="," S DAS=$E(DAS,2,99) ; ACCURATE IF NON SUB-FILE DAS STRING DOSN'T CONTAIN A ","
|
|---|
| 55 | S LVLS=$L(DAS,",")
|
|---|
| 56 | S %=FILE F CNT=1:1 S %=$G(^DD(%,0,"UP")) I '% Q ; COUNT FILE/SUB-FILE LEVELS IN THE DATA DICTIONARY
|
|---|
| 57 | I LVLS'=CNT S OUT="Invalid DAS string" Q ; LEVELS IN DAS STRING MUST MATCH LEVELS IN THE DATA DICTIONARY
|
|---|
| 58 | I $E(DAS)="-" S DAS=$E(DAS,2,99),GDFLG=1 ; GLOBAL DELETE FLAG
|
|---|
| 59 | I $E(DAS)="+" S DAS=$E(DAS,2,99),GTFLG=1 ; GLOBAL TRANSACTION FLAG, ROLLBACK IF ANY FIELD FAILS TO UPDATE
|
|---|
| 60 | I LVLS>1 F I=1:1:LVLS D I DAS="ERR" S OUT="Invalid DAS string" Q ; MAKE DAS ARRAY. MIRRORS THE DA() ARRAY
|
|---|
| 61 | . I I=LVLS S DAS=$P(DAS,",",I) Q ; SET DAS OF SUBFILE
|
|---|
| 62 | . S %=$P(DAS,",",I) I '% S DAS="ERR" Q
|
|---|
| 63 | . S DAS(LVLS-I)=% ; SET DAS(S) OF PARENT FILE(S). LIKE DA(), THE LARGER THE DAS SUBSCRIPT, THE HIGHER THE LEVEL
|
|---|
| 64 | . Q
|
|---|
| 65 | I DAS="ERR" S OUT="Update cancelled. Invalid DAS string" Q
|
|---|
| 66 | I DAS="Add"!(DAS="ADD") S DAS=""
|
|---|
| 67 | S %=$E(DAS) I %="-" S GDFLG=1,DAS=$E(DAS,2,99) ; YET ANOTHER WAY TO SET GLOBAL DELETE FLAG
|
|---|
| 68 | S %=$$REF(FILE,.DAS) ; GET OPEN REF, CLOSED REF, AND IENS STRING
|
|---|
| 69 | S OREF=$P(%,"|"),CREF=$P(%,"|",2),IENS=$P(%,"|",3) I $L(OREF),$L(CREF)
|
|---|
| 70 | E S OUT="Update cancelled. Invalid file definition/global reference" Q ; ERROR REPORT
|
|---|
| 71 | I DAS,'$D(@CREF@(DAS)) S OUT="Update cancelled. Invalid DAS" Q ; IF THERE IS AN DAS, IT MUST BE VALID
|
|---|
| 72 | I '$G(DAS),FILE=9000010,'$$VVAR^BMXADOF2(DATA) Q ; VISIT FILE ADD REQUIRES THAT SPECIAL VARIABLES BE PRESENT AND VALID
|
|---|
| 73 | I 'GDFLG,DAS,DATA[".01|@" S GDFLG=1 ; ALTERNATE WAY TO SET GLOBAL DELETE FLAG: REMOVE .01 FIELD
|
|---|
| 74 | I GDFLG,'DAS S OUT="Deletion cancelled. Missing DAS" Q ; CAN'T DO DELETE WITHOUT AN DAS
|
|---|
| 75 | I GDFLG D DIK(OREF,DAS) S OUT="Record deleted|"_DAS Q ; DELETE AND QUIT
|
|---|
| 76 | S UFLG=$S($G(DAS):"E",1:"A") ; SET UPDATE FLAG: ADD OR EDIT
|
|---|
| 77 | I '$L($G(DATA)) D I '$L($G(DATA)) S OUT="Update cancelled. Missing/invalid data string" Q ; COMPRESS DATA ARRAY INTO A SINGLE STRING
|
|---|
| 78 | . S DATA="",%=""
|
|---|
| 79 | . F S %=$O(DATA(%)) Q:'% S DATA=DATA_DATA(%) ; CONVERT DATA ARRAY INTO A DATA STRING
|
|---|
| 80 | . Q
|
|---|
| 81 | S %=$L(DATA) S %=$E(DATA,%-1,%) D ; CHECK FOR PROPER TERMINATION OF DATA STRING
|
|---|
| 82 | . I %=$C(30,31) Q ; PROPER TERMINATION
|
|---|
| 83 | . I $E(%,2)=$C(30) S DATA=DATA_$C(31) Q
|
|---|
| 84 | . I $E(%,2)=$C(31) S DATA=$E(DATA,1,$L(DATA-1))_$C(30,31)
|
|---|
| 85 | . S DATA=DATA_$C(30,31)
|
|---|
| 86 | . Q
|
|---|
| 87 | S TOT=$L(DATA,$C(30)) I 'TOT S OUT="Update cancelled. Missing data string" Q
|
|---|
| 88 | SPEC S DATA=$$SPEC^BMXADOFS(FILE,DATA,UFLG) ; BASED ON FILE IEN, SPECIAL MODS MAY BE MADE TO THE DATA STRING
|
|---|
| 89 | S TOT=$L(DATA,$C(30)) I 'TOT S OUT="Update cancelled. SPEC analysis failed." Q
|
|---|
| 90 | F CNT=1:1:TOT S %=$P(DATA,$C(30),CNT) I $L(%) S DATA(CNT)=% ; BUILD PRIMARY FIELD ARRAY
|
|---|
| 91 | S %=$G(DATA(1)) I %=""!(%=$C(31)) S OUT="Update cancelled. Missing data string" Q
|
|---|
| 92 | S %=DATA(CNT) I %[$C(31) S %=$P(%,$C(31),1),DATA(CNT)=% ; STRIP OFF END OF FILE MARKER
|
|---|
| 93 | F CNT=1:1:TOT S X=$G(DATA(CNT)) I $L(X) D ; BUILD SECONDARY FIELD ARRAY
|
|---|
| 94 | . S TFLG=0,DFLG=0
|
|---|
| 95 | . I $E(X)="+" S TFLG=1,X=$E(X,2,999),$P(FLD,U)=1
|
|---|
| 96 | . I $E(X)="-" S DFLG=1,X=$E(X,2,999)
|
|---|
| 97 | . S FNO=$P(X,"|"),VAL=$P(X,"|",2)
|
|---|
| 98 | . I '$D(^DD(FILE,+$G(FNO),0)) S:$L(OUT) OUT=OUT_"~" S OUT=OUT_FNO_"|Invalid field number" Q
|
|---|
| 99 | . I DFLG,VAL'="" S:$L(OUT) OUT=OUT_"~" S OUT=OUT_FNO_"|Invalid deletion syntax" Q ; CANT DELETE IF A VALUE IS SENT
|
|---|
| 100 | . I VAL="@" S DFLG=1 ; SYNC DFLG AND VAL
|
|---|
| 101 | . S FLD(FNO)=VAL_U_TFLG_U_DFLG
|
|---|
| 102 | . I FNO=.01,TFLG S $P(FLD,U,2)=1
|
|---|
| 103 | . Q
|
|---|
| 104 | I $P($G(FLD(.01)),U,3),UFLG="A" S OUT="Record deletion cancelled. Missing DAS" Q ; CAN'T DELETE A RECORD WITHOUT A VALID DAS
|
|---|
| 105 | I $P($G(FLD(.01)),U,3)!($G(GDFLG)) S UFLG="D" ; DELETION
|
|---|
| 106 | DELREC I UFLG="D" D DIK(OREF,DAS) S OUT="OK" Q ; DELETE THE RECORD
|
|---|
| 107 | I UFLG="A",'$L($P($G(FLD(.01)),U)) S OUT="Record addition cancelled. Missing .01 field" Q ; CAN'T ADD A RECORD WITHOUT A VALID .01 FIELD
|
|---|
| 108 | DINUM I UFLG="A",$G(^DD(FILE,.01,0))["DINUM=X" D ; IF DINUM'D RECORD EXISTS, SWITCH TO MOD MODE
|
|---|
| 109 | . S %=FLD(.01)
|
|---|
| 110 | . I $E(%)="`" S %=+$E(%,2,99)
|
|---|
| 111 | . I '$D(@CREF@(%,0)) Q ; OK TO ADD BRAND NEW RECORD BUT EXISTING RECORDS MUST BE EDITED
|
|---|
| 112 | . K FLD(.01)
|
|---|
| 113 | . S DAS=%,UFLG="E"
|
|---|
| 114 | . Q
|
|---|
| 115 | ADDREC I UFLG="A" D ADD(OREF) Q ; ADD A NEW ENTRY TO A FILE
|
|---|
| 116 | EDITREC I UFLG="E" D EDIT(OREF,DAS) Q ; EDIT AN EXISTING RECORD
|
|---|
| 117 | Q
|
|---|
| 118 | ;
|
|---|
| 119 | DIK(DIK,DA) ; DELETE A RECORD
|
|---|
| 120 | ; PATCHED BY GIS 9/28/04 TO FIX PROBLEMS WITH SUBFILE DELETION
|
|---|
| 121 | I '$G(DAS(1)) G DIK1 ; CHECK FOR SUBFILE DELETION
|
|---|
| 122 | N DA,IENS,I,DIK
|
|---|
| 123 | I '$G(FILE) Q
|
|---|
| 124 | S I=0,IENS=DAS_","
|
|---|
| 125 | M DA=DAS
|
|---|
| 126 | F S I=$O(DAS(I)) Q:'I S IENS=IENS_DAS(I)_","
|
|---|
| 127 | S DIK=$$ROOT^DILFD(FILE,IENS) I '$L(DIK) Q
|
|---|
| 128 | DIK1 D ^DIK
|
|---|
| 129 | D ^XBFMK
|
|---|
| 130 | Q
|
|---|
| 131 | ;
|
|---|
| 132 | ADD(DIC) ; ADD A NEW ENTRY TO A FILE
|
|---|
| 133 | N X,Y,%,DA,DN,UP,SB,DNODE,ERR
|
|---|
| 134 | S X=$P($G(FLD(.01)),U) I '$L(X) S OUT="Unable to add a new record" Q
|
|---|
| 135 | S X=$$POINT(FILE,.01,X) ; ADD ACCENT GRAV IF NECESSARY
|
|---|
| 136 | S X=""""_X_"""" ; FORCE A NEW ENTRY
|
|---|
| 137 | S DIC(0)="L"
|
|---|
| 138 | I $O(DAS(0)) D I $G(ERR) S Y=-1 G AFAIL ; GET DIC("P") IF NECESSARY
|
|---|
| 139 | . S %=0 F S %=$O(DAS(%)) Q:'% S DA(%)=DAS(%) ; CREATE THE DA ARRAY
|
|---|
| 140 | . S UP=$G(^DD(FILE,0,"UP")) I 'UP S ERR=1 Q
|
|---|
| 141 | . S SB=$O(^DD(UP,"SB",FILE,0)) I 'SB S ERR=1 Q
|
|---|
| 142 | . S DIC("P")=$P($G(^DD(UP,SB,0)),U,2) I '$L(DIC("P")) S ERR=1 Q
|
|---|
| 143 | . S DN=DIC_"1,0)" I $D(DN) Q
|
|---|
| 144 | . S @DN=(U_DIC("P")_U_U) ; CREATE THE DICTIONARY NODE
|
|---|
| 145 | . Q
|
|---|
| 146 | ADIC D ^DIC
|
|---|
| 147 | AFAIL I Y=-1 S OUT="Unable to add a new record" G AX
|
|---|
| 148 | I $O(FLD(0)) D EDIT(DIC,+Y) Q
|
|---|
| 149 | S OUT="OK"_"|"_+Y
|
|---|
| 150 | AX D ^XBFMK
|
|---|
| 151 | Q
|
|---|
| 152 | ;
|
|---|
| 153 | EDIT(DIE,DA) ; EDIT AN EXISTING RECORD
|
|---|
| 154 | N DR,RFLG,ERR,FNO,VAL,TFLG,RESULT,MSG,DIERR,DISYS,SF,APCDALVR
|
|---|
| 155 | S FNO=0,DR="",APCDALVR=""
|
|---|
| 156 | I UFLG="A" S OUT="OK New record added|"_DA
|
|---|
| 157 | F S FNO=$O(FLD(FNO)) Q:'FNO S X=FLD(FNO) I $L(X) D I $G(RFLG) Q ; CHECK EA FIELD AND BUILD THE DR STRING AND ERROR STRING
|
|---|
| 158 | . S VAL(FNO)=$P(X,U),TFLG=$P(X,U,2) I '$L(VAL(FNO)) Q
|
|---|
| 159 | . S SF=$$WP(FILE,FNO)
|
|---|
| 160 | . I SF D WORD(FILE,DA,FNO,CREF,VAL(FNO)) Q ; WORD PROCESSING FIELDS MANAGED SEPARATELY
|
|---|
| 161 | . S VAL(FNO)=$$POINT(FILE,FNO,VAL(FNO)) ; ADD ACCENT GRAV IF NECESSARY
|
|---|
| 162 | . K ERR,RESULT
|
|---|
| 163 | . I VAL(FNO)="@"!(VAL(FNO)="") S RESULT="@"
|
|---|
| 164 | . I FNO=.01,UFLG="A" S:$E(VAL(.01))="`" VAL(.01)=$E(VAL(.01),2,999) Q ; NO NEED TO EDIT THE .01 FIELD OF A RECORD THAT HAS JUST BEEN CREATED
|
|---|
| 165 | . I FILE\1=9000010,$L($P(FILE,".",2))=2,UFLG="E",(FNO=.02!(FNO=.03)) Q ; CAN'T EDIT EXISTING PT AND VISIT FIELDS OF V FILES
|
|---|
| 166 | . I FILE\1=9000010,$L($P(FILE,".",2))=2,UFLG="A",FNO=.03,VAL(.03)?1"`"1.N S %=+$E(VAL(.03),2,99) I $D(^AUPNVSIT(%,0)) S RESULT=% G E1
|
|---|
| 167 | . I FILE=9000011,FNO=.07,VAL(.07)?1.N S RESULT=VAL(.07) G E1 ; THE VALIDITY CHECK FAILS - SO BYPASS THIS
|
|---|
| 168 | CHK . I VAL(FNO)'="@" D CHK^DIE(FILE,FNO,"",VAL(FNO),.RESULT,.ERR)
|
|---|
| 169 | E1 . I RESULT=U D Q
|
|---|
| 170 | .. S MSG=$G(ERR("DIERR",1,"TEXT",1),"Failed FileMan data validation")
|
|---|
| 171 | .. I $L(OUT) S OUT=OUT_"~"
|
|---|
| 172 | .. I TFLG!GTFLG S RFLG=1,OUT=FNO_"|"_MSG Q
|
|---|
| 173 | .. S OUT=OUT_FNO_"|"_MSG
|
|---|
| 174 | .. Q
|
|---|
| 175 | . S VAL(FNO)=RESULT
|
|---|
| 176 | . I $L(DR) S DR=DR_";"
|
|---|
| 177 | . I RESULT="@" S DR=DR_FNO_"////@" Q ; DELETE THIS VALUE
|
|---|
| 178 | . S DR=DR_FNO_"////^S X=VAL("_FNO_")" ; BUILD DR STRING
|
|---|
| 179 | . Q
|
|---|
| 180 | I $G(RFLG) D:UFLG="A" DIK(DIE,DA) S OUT="Record update cancelled"_"|"_OUT G EX ; TRANSACTION ROLLBACK FLAG IS SET, ENTRY DELETED (ADD MODE) OR UPDATE CANCELLED (EDIT MODE)
|
|---|
| 181 | S %=0 F S %=$O(DAS(%)) Q:'% S DA(%)=DAS(%) ; JUST IN CASE THIS IS A MILTIPLE, CREATE THE DA ARRAY
|
|---|
| 182 | DIE L +@CREF@(DA):2 I $T D ^DIE L -@CREF@(DA) G:OUT["valid" EX S OUT="OK" S:UFLG="A" OUT=OUT_"|"_DA G EX ; SUCCESS!!!!
|
|---|
| 183 | S OUT="Update cancelled. File locked" ; FILE LOCKED. UNABLE TO UPDATE
|
|---|
| 184 | I $L(FLD),UFLG="A" D DIK(DIE,DA) ; ROLLBACK THE NEW RECORD
|
|---|
| 185 | EX D ^XBFMK ; CLEANUP
|
|---|
| 186 | Q
|
|---|
| 187 | ;
|
|---|
| 188 | REF(FILE,DAS) ; GIVEN A FILE/SUBFILE NUMBER & DAS ARRAY, RETURN THE FM GLOBAL REFERENCE INFO: OREF|CREF|IENS
|
|---|
| 189 | N OREF,CREF,IENS,I,X
|
|---|
| 190 | S IENS=$$IENS^DILF(.DAS) I '$L(IENS) Q ""
|
|---|
| 191 | S OREF=$$ROOT^DILFD(FILE,IENS) I '$L(OREF) Q ""
|
|---|
| 192 | S CREF=$$CREF^DILF(OREF) I '$L(CREF) Q ""
|
|---|
| 193 | Q (OREF_"|"_CREF_"|"_IENS)
|
|---|
| 194 | ;
|
|---|
| 195 | POINT(FILE,FNO,VAL) ; ADD ACCENT GRAV IF NECESSARY
|
|---|
| 196 | I $E(VAL)="`" Q VAL
|
|---|
| 197 | I $P($G(^DD(FILE,FNO,0)),U,2)["P",VAL=+VAL,VAL\1=VAL S VAL="`"_VAL
|
|---|
| 198 | Q VAL
|
|---|
| 199 | ;
|
|---|
| 200 | WP(FILE,FLD) ; RETURN THE SUBFILE NUMBER IF IT IS A WORD PROCESSING FIELD
|
|---|
| 201 | N SF,DTYPE
|
|---|
| 202 | S SF=$P($G(^DD(+$G(FILE),+$G(FLD),0)),U,2) I 'SF Q 0
|
|---|
| 203 | S DTYPE=$P($G(^DD(SF,.01,0)),U,2)
|
|---|
| 204 | I DTYPE["W" Q SF
|
|---|
| 205 | Q 0
|
|---|
| 206 | ;
|
|---|
| 207 | WORD(FILE,DA,FLD,CREF,VAL) ; SUFF TEXT ENTRY INTO THE WP MULTIPLE FIELD
|
|---|
| 208 | N SS,TOT,A,B,I
|
|---|
| 209 | S SS=+$P($G(^DD(FILE,FLD,0)),U,4) I SS="" Q
|
|---|
| 210 | I VAL="@"!(VAL="") K @CREF@(DA,SS) Q ; DELETE THE WP RECORD: REMOVE DICTIONARY NODE AND DATA
|
|---|
| 211 | S TOT=0
|
|---|
| 212 | F Q:'$L(VAL) D
|
|---|
| 213 | . S A=$E(VAL,1,80),VAL=$E(VAL,81,999999) ; PEEL OFF AN 80 CHARACTER DATA BLOCK FROM THE FRONT OF THE TEXT STRING
|
|---|
| 214 | . I $L(A) S TOT=TOT+1,B(TOT)=A ; BUILD THE TEMP ARRAY
|
|---|
| 215 | . Q
|
|---|
| 216 | I '$D(B(1)) Q ; NOTHING TO STORE SO QUIT
|
|---|
| 217 | S @CREF@(DA,SS,0)="^^"_TOT_U_TOT_U_DT ; SET DICTIONARY NODE
|
|---|
| 218 | F I=1:1:TOT S @CREF@(DA,SS,I,0)=B(I) ; SET DATA NODES
|
|---|
| 219 | Q
|
|---|
| 220 | ;
|
|---|
| 221 | MERR ; MUMPS ERROR TRAP
|
|---|
| 222 | N ERR,X
|
|---|
| 223 | X ("S X=$"_"ZE")
|
|---|
| 224 | S ERR="M ERROR: "_X
|
|---|
| 225 | S ^GREG("ERR")=ERR
|
|---|
| 226 | S OUT=ERR
|
|---|
| 227 | Q
|
|---|
| 228 | ;
|
|---|
