Changeset 623 for WorldVistAEHR/trunk/r/BAR_CODE_MED_ADMIN-ALPB-PSB/ALPBUTL1.m

Timestamp:

Dec 4, 2009, 12:11:15 AM (14 years ago)

Author:

George Lilly

Message:

revised back to 6/30/08 version

File:

• WorldVistAEHR/trunk/r/BAR_CODE_MED_ADMIN-ALPB-PSB/ALPBUTL1.m (modified) (1 diff)

WorldVistAEHR/trunk/r/BAR_CODE_MED_ADMIN-ALPB-PSB/ALPBUTL1.m

@@ -1 @@
-ALPBUTL1        ;OIFO-DALLAS MW,SED,KC-BCBU BACKUP REPORT FUNCTIONS AND UTILITIES  ;01/01/03
-        ;;3.0;BAR CODE MED ADMIN;**8,37**;Mar 2004;Build 10
-        ;;Per VHA Directive 2004-038, this routine should not be modified.
-        ;
-        ; Reference/IA
-        ; INP^VADPT/10061
-        ; DIC(42/10039
-        ; DIC(42/2440
-        ;
-ERRBLD(SEG,MSG,ERR)     ; build an error array for non-FileMan-related errors...
-        ; SEG = HL7 segment name
-        ; MSG = a message that will be used in the error text portion of the array (optional -- if not passed, the
-        ;       default will be used)
-        ; ERR = array passed by reference in which error will be returned
-        ; note:  code 999 is a code indicating a non-FileMan error for filing the error message in file 53.71
-        S ERR("DIERR")=1
-        S ERR("DIERR",1)=999
-        S ERR("DIERR",1,"TEXT",1)=$S($G(MSG)'="":MSG,1:"Invalid parameter passed to "_SEG_" module in routine ALPBHL1U")
-        Q
-        ;
-ERRLOG(IEN,OIEN,MSGREC,SEGNAME,SEGDATA,ERRTEXT) ; log filing errors...
-        ; this module logs error data in the BCMA BACKUP PARAMETERS file (53.71).  These
-        ; errors usually occur as the result of missing or bad data passed to one of the
-        ; File Manager DBS calls used by this package.
-        ; 
-        ; IEN       = the patient's record number in file 53.7
-        ; OIEN      = the order number's sub-file record number in file 53.7
-        ; MSGREC    = the HL7 message's record number in file 772
-        ; SEGNAME   = the HL7 segment associated with the error (optional)
-        ; SEGDATA   = the HL7 segment's data (optional)
-        ; ERRTEXT   = an array passed by reference which contains the error
-        ;             code (numeric) and the error text to be filed.  It is
-        ;             expected that this is usually the error array returned
-        ;             from a FileMan DBS call, so the format is specific:
-        ;
-        ;             ERRTEXT("DIERR",n)=error code (numeric)
-        ;             ERRTEXT("DIERR",n,"TEXT",1)=first line of error text
-        ;             ERRTEXT("DIERR",n,"TEXT",2)=second line of error text
-        ;             ERRTEXT("DIERR",n,"TEXT",n)=last line of error text
-        ;
-        ;             However, any error message can be passed to this module
-        ;             as long as the above format is used.
-        N ALPBCODE,ALPBFERR,ALPBFILE,ALPBLOGD,ALPBN1,ALPBN2,ALPBPIEN,ALPBTEXT,ALPBX
-        S ALPBLOGD=$$NOW^XLFDT()
-        S ALPBPIEN=+$O(^ALPB(53.71,0))
-        I ALPBPIEN=0 D
-        .S X="ONE"
-        .S DIC="^ALPB(53.71,"
-        .S DIC(0)="LZ"
-        .S DIC("DR")="1///^S X=3"
-        .S DINUM=1
-        .S DLAYGO=53.71
-        .D FILE^DICN K DIC
-        .S ALPBPIEN=+Y
-        I ALPBPIEN'>0 Q
-        S ALPBN1=+$O(^ALPB(53.71,ALPBPIEN,1," "),-1)+1
-        S ALPBFILE(53.713,"+"_ALPBN1_","_ALPBPIEN_",",.01)=ALPBLOGD
-        S ALPBFILE(53.713,"+"_ALPBN1_","_ALPBPIEN_",",1)=+$G(IEN)
-        S ALPBFILE(53.713,"+"_ALPBN1_","_ALPBPIEN_",",2)=+$G(OIEN)
-        S ALPBFILE(53.713,"+"_ALPBN1_","_ALPBPIEN_",",3)=+$G(MSGREC)
-        S ALPBFILE(53.713,"+"_ALPBN1_","_ALPBPIEN_",",3.1)=$G(SEGNAME)
-        S ALPBFILE(53.713,"+"_ALPBN1_","_ALPBPIEN_",",3.2)=$G(SEGDATA)
-        D UPDATE^DIE("","ALPBFILE","ALPBN1","ALPBFERR")
-        K ALPBFERR,ALPBFILE
-        S ALPBX=0
-        F  S ALPBX=$O(ERRTEXT("DIERR",ALPBX)) Q:'ALPBX  D
-        .S ALPBCODE=ERRTEXT("DIERR",ALPBX)
-        .; file the error code...
-        .S ALPBN2=+$O(^ALPB(53.71,ALPBPIEN,1,ALPBN1,2," "),-1)+1
-        .S ALPBFILE(53.7135,"+"_ALPBN2_","_ALPBN1_","_ALPBPIEN_",",.01)=ALPBCODE
-        .D UPDATE^DIE("","ALPBFILE","ALPBN2","ALPBFERR")
-        .K ALPBFERR,ALPBFILE
-        .; file the error text...
-        .M ALPBTEXT=ERRTEXT("DIERR",ALPBX,"TEXT")
-        .D WP^DIE(53.7135,ALPBN2_","_ALPBN1_","_ALPBPIEN_",",1,"","ALPBTEXT","ALPBFERR")
-        .;S ALPBFILE(53.7135,"+"_ALPBN2_","_ALPBN1_","_ALPBPIEN_",",1)=ALPBTEXT
-        .;D UPDATE^DIE("","ALPBFILE","ALPBN2","ALPBFERR")
-        .K ALPBCODE,ALPBFERR,ALPBFILE,ALPBN2,ALPBTEXT
-        Q
-        ;
-CLEAN(IEN)      ; check error log records to see if the patients' whose records
-        ; are noted still exist in file 53.7.  if not, delete the error log
-        ; record(s) in file 53.71...
-        ; IEN = patient record number in file 53.7
-        ; Note:  this function is also called from DELPT^ALPBUTL when a patient's
-        ; record is deleted (as a result of a discharge action) from 53.7.
-        ;
-        N ALPBX,ALPBY,DA,DIK,X,Y
-        ; patient still has record in 53.7?  if so, quit...
-        I $G(^ALPB(53.7,IEN,0))'="" Q
-        S ALPBX=0
-        F  S ALPBX=$O(^ALPB(53.71,"C",IEN,ALPBX)) Q:'ALPBX  D
-        .S ALPBY=0
-        .F  S ALPBY=$O(^ALPB(53.71,"C",IEN,ALPBX,ALPBY)) Q:'ALPBY  D
-        ..S DA=ALPBY
-        ..S DA(1)=ALPBX
-        ..S DIK="^ALPB(53.71,"_DA(1)_",1,"
-        ..D ^DIK
-        ..K DA,DIK
-        .K ALPBY
-        K ALPBX
-        Q
-        ;
-DELERR(ERRIEN)  ; delete an error log entry from file 53.71...
-        ; ERRIEN = error log entry's internal record number
-        N ALPBPARM,DA,DIK,X,Y
-        S ALPBPARM=+$O(^ALPB(53.71,0))
-        I ALPBPARM'>0 Q
-        S DA=ERRIEN
-        S DA(1)=ALPBPARM
-        S DIK="^ALPB(53.71,"_DA(1)_",1,"
-        D ^DIK
-        Q
-        ;
-PTLIST(LTYPE,RESULTS)   ; get list of patients in file 53.7...
-        ; LTYPE   = passed = "ALL" to list all patients or
-        ;                  = <wardname> to list patients on a selected ward
-        ; RESULTS = an array passed by reference in which data will be returned
-        N ALPBDATA,ALPBIEN,ALPBPTN,ALPBX
-        I $G(LTYPE)="" S LTYPE="ALL"
-        S ALPBX=0
-        I LTYPE="ALL" D
-        .S ALPBPTN=""
-        .F  S ALPBPTN=$O(^ALPB(53.7,"B",ALPBPTN)) Q:ALPBPTN=""  D
-        ..S ALPBIEN=0
-        ..F  S ALPBIEN=$O(^ALPB(53.7,"B",ALPBPTN,ALPBIEN)) Q:'ALPBIEN  D
-        ...S ALPBDATA=$G(^ALPB(53.7,ALPBIEN,0))
-        ...I ALPBDATA="" K ALPBDATA Q
-        ...S ALPBX=ALPBX+1
-        ...S RESULTS(ALPBX)=ALPBPTN_"^"_$P(ALPBDATA,"^",2)_"^"_$P(ALPBDATA,"^",5)_"^"_$P(ALPBDATA,"^",6)_"^"_$P(ALPBDATA,"^",7)
-        ...K ALPBDATA
-        ..K ALPBIEN
-        .K ALPBPTN
-        I LTYPE'="ALL" D
-        .S ALPBPTN=""
-        .F  S ALPBPTN=$O(^ALPB(53.7,"AW",LTYPE,ALPBPTN)) Q:ALPBPTN=""  D
-        ..S ALPBIEN=0
-        ..F  S ALPBIEN=$O(^ALPB(53.7,"AW",LTYPE,ALPBPTN,ALPBIEN)) Q:'ALPBIEN  D
-        ...S ALPBDATA=$G(^ALPB(53.7,ALPBIEN,0))
-        ...I ALPBDATA="" K ALPBDATA Q
-        ...S ALPBX=ALPBX+1
-        ...S RESULTS(ALPBX)=ALPBPTN_"^"_$P(ALPBDATA,"^",2)_"^"_$P(ALPBDATA,"^",5)_"^"_$P(ALPBDATA,"^",6)_"^"_$P(ALPBDATA,"^",7)
-        ...K ALPBDATA
-        ..K ALPBIEN
-        .K ALPBPTN
-        Q
-        ;
-STAT(ST)        ;This will return the value of a status code for pharmacy
-        I $G(ST)="" Q ""
-        I $L($T(@ST)) G @ST
-        Q ""
-IP      Q "pending"
-CM      Q "finished/verified by pharmacist(active)"
-DC      Q "discontinued"
-RP      Q "replaced"
-HD      Q "on hold"
-ZE      Q "expired"
-ZS      Q "suspended(active)"
-ZU      Q "un-suspended(active)"
-ZX      Q "unreleased"
-ZZ      Q "renewed"
-        ;
-STAT2(CODE)     ; convert order status code for output...
-        ; this function is used primarily by the workstation software
-        ; CODE = an order status code
-        ; returns printable status code
-        I $G(CODE)="" Q "Unknown"
-        I CODE="IP"!(CODE="ZX") Q "Pending"
-        I CODE="CM"!(CODE="ZU")!(CODE="ZZ") Q "Active"
-        I CODE="HD"!(CODE="ZS") Q "Hold"
-        I CODE="DC"!(CODE="RP")!(CODE="ZE") Q "Expired"
-        Q "Unknown"
-        ;
-DIV(DFN,ALPBMDT)        ;get the Division for a patient
-        I +$G(DFN)'>0 Q ""
-        N ALPBDIV,ALPWRD,VAIN,VAINDT
-        S:+$G(ALPBMDT)>0 VAINDT=$P(ALPBMDT,".",1)
-        K ALPBMDT
-        D INP^VADPT
-        S ALPWRD=$P($G(VAIN(4)),U,1)
-        Q:+ALPWRD'>0 ""
-        ;Check to see if ward is a DOMICILIARY 
-        I $P($G(^DIC(42,ALPWRD,0)),U,3)="D",+$$GET^XPAR("PKG.BAR CODE MED ADMIN","PSB BKUP DOM FILTER",1,"Q")>0 Q "DOM"
-        S ALPBDIV=$P($G(^DIC(42,ALPWRD,0)),U,11)
-        Q:+ALPBDIV'>0 ""
-        Q ALPBDIV
-        ;
-CNV(A,B,X)      ;CONVERT A STRING
-        ;This API will take a HL7 segment and convert characters
-        ;defined in the input
-        ;Example:
-        ;Single encoding characters can be converted such as ^ to ~
-        ;or multiple encoding characters can be converted such as
-        ;  |~^@/ to ^~|/@
-        ;A is the string of HL7 encoding characters to be converted
-        ;B is the string of HL7 encoding characters to be converted to
-        ;X is te message string to be converted
-        I A=""!B=""!X="" Q ""
-        F I=1:1:$L(A) S A(I)=$E(A,I,I),A(I,1)=""
-        F I=1:1:$L(B) S B(I)=$E(B,I,I)
-        S J=0
-        F  S J=$O(A(J)) Q:+J'>0  D
-        . F I=1:1:$L(X) S:$E(X,I,I)=A(J) A(J,1)=A(J,1)_I_U
-        S J=0
-        F  S J=$O(A(J)) Q:+J'>0  D
-        . Q:'$D(A(J,1))!'$D(B(J))
-        . F I=1:1:$L(A(J,1),U) S C=$P(A(J,1),U,I) S:+C>0 $E(X,C,C)=B(J)
-        Q X
+ALPBUTL1 ;OIFO-DALLAS MW,SED,KC-BCBU BACKUP REPORT FUNCTIONS AND UTILITIES  ;01/01/03
+ ;;3.0;BAR CODE MED ADMIN;**8**;Mar 2004
+ ;
+ ; Reference/IA
+ ; INP^VADPT/10061
+ ; DIC(42/10039
+ ; DIC(42/2440
+ ;
+ERRBLD(SEG,MSG,ERR) ; build an error array for non-FileMan-related errors...
+ ; SEG = HL7 segment name
+ ; MSG = a message that will be used in the error text portion of the array (optional -- if not passed, the
+ ;       default will be used)
+ ; ERR = array passed by reference in which error will be returned
+ ; note:  code 999 is a code indicating a non-FileMan error for filing the error message in file 53.71
+ S ERR("DIERR")=1
+ S ERR("DIERR",1)=999
+ S ERR("DIERR",1,"TEXT",1)=$S($G(MSG)'="":MSG,1:"Invalid parameter passed to "_SEG_" module in routine ALPBHL1U")
+ Q
+ ;
+ERRLOG(IEN,OIEN,MSGREC,SEGNAME,SEGDATA,ERRTEXT) ; log filing errors...
+ ; this module logs error data in the BCMA BACKUP PARAMETERS file (53.71).  These
+ ; errors usually occur as the result of missing or bad data passed to one of the
+ ; File Manager DBS calls used by this package.
+ ; 
+ ; IEN       = the patient's record number in file 53.7
+ ; OIEN      = the order number's sub-file record number in file 53.7
+ ; MSGREC    = the HL7 message's record number in file 772
+ ; SEGNAME   = the HL7 segment associated with the error (optional)
+ ; SEGDATA   = the HL7 segment's data (optional)
+ ; ERRTEXT   = an array passed by reference which contains the error
+ ;             code (numeric) and the error text to be filed.  It is
+ ;             expected that this is usually the error array returned
+ ;             from a FileMan DBS call, so the format is specific:
+ ;
+ ;             ERRTEXT("DIERR",n)=error code (numeric)
+ ;             ERRTEXT("DIERR",n,"TEXT",1)=first line of error text
+ ;             ERRTEXT("DIERR",n,"TEXT",2)=second line of error text
+ ;             ERRTEXT("DIERR",n,"TEXT",n)=last line of error text
+ ;
+ ;             However, any error message can be passed to this module
+ ;             as long as the above format is used.
+ N ALPBCODE,ALPBFERR,ALPBFILE,ALPBLOGD,ALPBN1,ALPBN2,ALPBPIEN,ALPBTEXT,ALPBX
+ S ALPBLOGD=$$NOW^XLFDT()
+ S ALPBPIEN=+$O(^ALPB(53.71,0))
+ I ALPBPIEN=0 D
+ .S X="ONE"
+ .S DIC="^ALPB(53.71,"
+ .S DIC(0)="LZ"
+ .S DIC("DR")="1///^S X=3"
+ .S DINUM=1
+ .S DLAYGO=53.71
+ .D FILE^DICN K DIC
+ .S ALPBPIEN=+Y
+ I ALPBPIEN'>0 Q
+ S ALPBN1=+$O(^ALPB(53.71,ALPBPIEN,1," "),-1)+1
+ S ALPBFILE(53.713,"+"_ALPBN1_","_ALPBPIEN_",",.01)=ALPBLOGD
+ S ALPBFILE(53.713,"+"_ALPBN1_","_ALPBPIEN_",",1)=+$G(IEN)
+ S ALPBFILE(53.713,"+"_ALPBN1_","_ALPBPIEN_",",2)=+$G(OIEN)
+ S ALPBFILE(53.713,"+"_ALPBN1_","_ALPBPIEN_",",3)=+$G(MSGREC)
+ S ALPBFILE(53.713,"+"_ALPBN1_","_ALPBPIEN_",",3.1)=$G(SEGNAME)
+ S ALPBFILE(53.713,"+"_ALPBN1_","_ALPBPIEN_",",3.2)=$G(SEGDATA)
+ D UPDATE^DIE("","ALPBFILE","ALPBN1","ALPBFERR")
+ K ALPBFERR,ALPBFILE
+ S ALPBX=0
+ F  S ALPBX=$O(ERRTEXT("DIERR",ALPBX)) Q:'ALPBX  D
+ .S ALPBCODE=ERRTEXT("DIERR",ALPBX)
+ .; file the error code...
+ .S ALPBN2=+$O(^ALPB(53.71,ALPBPIEN,1,ALPBN1,2," "),-1)+1
+ .S ALPBFILE(53.7135,"+"_ALPBN2_","_ALPBN1_","_ALPBPIEN_",",.01)=ALPBCODE
+ .D UPDATE^DIE("","ALPBFILE","ALPBN2","ALPBFERR")
+ .K ALPBFERR,ALPBFILE
+ .; file the error text...
+ .M ALPBTEXT=ERRTEXT("DIERR",ALPBX,"TEXT")
+ .D WP^DIE(53.7135,ALPBN2_","_ALPBN1_","_ALPBPIEN_",",1,"","ALPBTEXT","ALPBFERR")
+ .;S ALPBFILE(53.7135,"+"_ALPBN2_","_ALPBN1_","_ALPBPIEN_",",1)=ALPBTEXT
+ .;D UPDATE^DIE("","ALPBFILE","ALPBN2","ALPBFERR")
+ .K ALPBCODE,ALPBFERR,ALPBFILE,ALPBN2,ALPBTEXT
+ Q
+ ;
+CLEAN(IEN) ; check error log records to see if the patients' whose records
+ ; are noted still exist in file 53.7.  if not, delete the error log
+ ; record(s) in file 53.71...
+ ; IEN = patient record number in file 53.7
+ ; Note:  this function is also called from DELPT^ALPBUTL when a patient's
+ ; record is deleted (as a result of a discharge action) from 53.7.
+ ;
+ N ALPBX,ALPBY,DA,DIK,X,Y
+ ; patient still has record in 53.7?  if so, quit...
+ I $G(^ALPB(53.7,IEN,0))'="" Q
+ S ALPBX=0
+ F  S ALPBX=$O(^ALPB(53.71,"C",IEN,ALPBX)) Q:'ALPBX  D
+ .S ALPBY=0
+ .F  S ALPBY=$O(^ALPB(53.71,"C",IEN,ALPBX,ALPBY)) Q:'ALPBY  D
+ ..S DA=ALPBY
+ ..S DA(1)=ALPBX
+ ..S DIK="^ALPB(53.71,"_DA(1)_",1,"
+ ..D ^DIK
+ ..K DA,DIK
+ .K ALPBY
+ K ALPBX
+ Q
+ ;
+DELERR(ERRIEN) ; delete an error log entry from file 53.71...
+ ; ERRIEN = error log entry's internal record number
+ N ALPBPARM,DA,DIK,X,Y
+ S ALPBPARM=+$O(^ALPB(53.71,0))
+ I ALPBPARM'>0 Q
+ S DA=ERRIEN
+ S DA(1)=ALPBPARM
+ S DIK="^ALPB(53.71,"_DA(1)_",1,"
+ D ^DIK
+ Q
+ ;
+PTLIST(LTYPE,RESULTS) ; get list of patients in file 53.7...
+ ; LTYPE   = passed = "ALL" to list all patients or
+ ;                  = <wardname> to list patients on a selected ward
+ ; RESULTS = an array passed by reference in which data will be returned
+ N ALPBDATA,ALPBIEN,ALPBPTN,ALPBX
+ I $G(LTYPE)="" S LTYPE="ALL"
+ S ALPBX=0
+ I LTYPE="ALL" D
+ .S ALPBPTN=""
+ .F  S ALPBPTN=$O(^ALPB(53.7,"B",ALPBPTN)) Q:ALPBPTN=""  D
+ ..S ALPBIEN=0
+ ..F  S ALPBIEN=$O(^ALPB(53.7,"B",ALPBPTN,ALPBIEN)) Q:'ALPBIEN  D
+ ...S ALPBDATA=$G(^ALPB(53.7,ALPBIEN,0))
+ ...I ALPBDATA="" K ALPBDATA Q
+ ...S ALPBX=ALPBX+1
+ ...S RESULTS(ALPBX)=ALPBPTN_"^"_$P(ALPBDATA,"^",2)_"^"_$P(ALPBDATA,"^",5)_"^"_$P(ALPBDATA,"^",6)_"^"_$P(ALPBDATA,"^",7)
+ ...K ALPBDATA
+ ..K ALPBIEN
+ .K ALPBPTN
+ I LTYPE'="ALL" D
+ .S ALPBPTN=""
+ .F  S ALPBPTN=$O(^ALPB(53.7,"AW",LTYPE,ALPBPTN)) Q:ALPBPTN=""  D
+ ..S ALPBIEN=0
+ ..F  S ALPBIEN=$O(^ALPB(53.7,"AW",LTYPE,ALPBPTN,ALPBIEN)) Q:'ALPBIEN  D
+ ...S ALPBDATA=$G(^ALPB(53.7,ALPBIEN,0))
+ ...I ALPBDATA="" K ALPBDATA Q
+ ...S ALPBX=ALPBX+1
+ ...S RESULTS(ALPBX)=ALPBPTN_"^"_$P(ALPBDATA,"^",2)_"^"_$P(ALPBDATA,"^",5)_"^"_$P(ALPBDATA,"^",6)_"^"_$P(ALPBDATA,"^",7)
+ ...K ALPBDATA
+ ..K ALPBIEN
+ .K ALPBPTN
+ Q
+ ;
+STAT(ST) ;This will return the value of a status code for pharmacy
+ I $G(ST)="" Q ""
+ I $L($T(@ST)) G @ST
+ Q ""
+IP Q "pending"
+CM Q "finished/verified by pharmacist(active)"
+DC Q "discontinued"
+RP Q "replaced"
+HD Q "on hold"
+ZE Q "expired"
+ZS Q "suspended(active)"
+ZU Q "un-suspended(active)"
+ZX Q "unreleased"
+ZZ Q "renewed"
+ ;
+STAT2(CODE) ; convert order status code for output...
+ ; this function is used primarily by the workstation software
+ ; CODE = an order status code
+ ; returns printable status code
+ I $G(CODE)="" Q "Unknown"
+ I CODE="IP"!(CODE="ZX") Q "Pending"
+ I CODE="CM"!(CODE="ZU")!(CODE="ZZ") Q "Active"
+ I CODE="HD"!(CODE="ZS") Q "Hold"
+ I CODE="DC"!(CODE="RP")!(CODE="ZE") Q "Expired"
+ Q "Unknown"
+ ;
+DIV(DFN,ALPBMDT) ;get the Division for a patient
+ I +$G(DFN)'>0 Q ""
+ N ALPBDIV,ALPWRD,VAIN,VAINDT
+ S:+$G(ALPBMDT)>0 VAINDT=$P(ALPBMDT,".",1)
+ K ALPBMDT
+ D INP^VADPT
+ S ALPWRD=$P($G(VAIN(4)),U,1)
+ Q:+ALPWRD'>0 ""
+ ;Check to see if ward is a DOMICILIARY 
+ I $P($G(^DIC(42,ALPWRD,0)),U,3)="D" Q "DOM"
+ S ALPBDIV=$P($G(^DIC(42,ALPWRD,0)),U,11)
+ Q:+ALPBDIV'>0 ""
+ Q ALPBDIV
+ ;
+CNV(A,B,X) ;CONVERT A STRING
+ ;This API will take a HL7 segment and convert characters
+ ;defined in the input
+ ;Example:
+ ;Single encoding characters can be converted such as ^ to ~
+ ;or multiple encoding characters can be converted such as
+ ;  |~^@/ to ^~|/@
+ ;A is the string of HL7 encoding characters to be converted
+ ;B is the string of HL7 encoding characters to be converted to
+ ;X is te message string to be converted
+ I A=""!B=""!X="" Q ""
+ F I=1:1:$L(A) S A(I)=$E(A,I,I),A(I,1)=""
+ F I=1:1:$L(B) S B(I)=$E(B,I,I)
+ S J=0
+ F  S J=$O(A(J)) Q:+J'>0  D
+ . F I=1:1:$L(X) S:$E(X,I,I)=A(J) A(J,1)=A(J,1)_I_U
+ S J=0
+ F  S J=$O(A(J)) Q:+J'>0  D
+ . Q:'$D(A(J,1))!'$D(B(J))
+ . F I=1:1:$L(A(J,1),U) S C=$P(A(J,1),U,I) S:+C>0 $E(X,C,C)=B(J)
+ Q X