- MCARAM4 ;WASH ISC/JKL-MUSE TRANSFER LAB DATA TO LOCAL ;5/20/94 15:35
- ;;2.3;Medicine;;09/13/1996
- ;
- ;
- ;Checks format and/or reformats data
- AR(MCA,MCAA,MCD,MCFP,MCLP,MCCK) ;Sets l/t stripped data field into an array
- ; USAGE: S X=$$AR^MCARAM4(.A,B,C,D,E)
- ; WHERE: .A = array where data is placed
- ; B = array argument for data field
- ; C = data field value
- ; D = first position of data field
- ; E = last position of data field
- ; F = 1 to check numeric data field value for positive int value
- ; 2 to check "" for both positive and negative int value
- ; 3 to check "" for pos,neg,int, and decimal values
- N MCI,MCERR
- I '$D(MCCK) S MCCK=""
- S MCA(MCAA)=$E(MCD,MCFP,MCLP),MCI=MCA(MCAA),MCERR=$$SLTS^MCARAM4(.MCI),MCA(MCAA)=MCI I +MCERR>0 Q MCERR
- I MCCK=1 S MCERR=$$DFCK^MCARAM4(MCA(MCAA),MCCK) I +MCERR>0 Q MCERR
- I MCCK=2 S MCERR=$$DFCK^MCARAM4(MCA(MCAA),MCCK) I +MCERR>0 Q MCERR
- I MCCK=3 S MCERR=$$DFCK^MCARAM4(MCA(MCAA),MCCK) I +MCERR>0 Q MCERR
- Q 0
- ;
- DFCK(MCV,MCCK) ; Checks numeric,negative,positive,integer,decimal value
- ; USAGE: S X=$$DFCK^MCARAM4(A,B)
- ; WHERE: A=data field value
- ; B=1 for positive value numeric (integer) check
- ; B=2 for positive and negative value numeric (integer) check
- ; B=3 for positive, negative, decimal, or integer numeric check
- ; if successful, returns function value of 0
- ; if unsuccessful, returns error message for incorrect field format
- N MCERR
- I MCV="" S MCERR="2-Null data field" Q MCERR
- I MCV=0 Q 0
- I $G(MCCK)=1 I MCV?1N.N Q 0
- I $G(MCCK)=2 I MCV?."-"1N.N,$P(MCV,"-",2,99)'["-",-MCV+-MCV'=0 Q 0
- I $G(MCCK)=3 I MCV?."-"."."1N.N.".".N,$P(MCV,".",2,99)'[".",$P(MCV,"-",2,99)'["-",-MCV+-MCV'=0 Q 0
- S MCERR="1-Data field not numeric" Q MCERR
- ;
- SLTS(MCV) ; Strips leading and trailing spaces from data fields
- ; USAGE: S X=$$SLTS^MCARAM4(.A)
- ; WHERE: MCV=data field value
- ; .A = value where data is placed
- ; if successful, returns function value of 0 and data field value
- ; if unsuccessful, returns error message for incorrect field format
- N MCERR,MCI,MCJ
- I MCV="" S MCERR="2-Null data field" Q MCERR
- F MCI=1:1 I $E(MCV,MCI,MCI)'=" " Q
- F MCJ=$L(MCV):-1 I $E(MCV,MCJ,MCJ)'=" " Q
- S MCV=$E(MCV,MCI,MCJ) I MCV="" S MCERR="2-Null data field" Q MCERR
- Q 0
- ;
- DGCK(MCA) ;Removes null lines and resets numbering of diagnosis array
- ; USAGE: S X=$$DGCK^MCARAM4(.A)
- ; WHERE: MCA=diagnosis array
- ; .A=diagnosis array renumbered without null lines
- ; A("DX,0")=total number of non-null diagnosis lines
- ; if successful, returns function value of 0 and diagnosis array
- ; if unsuccessful, returns error message and A("DX,0")=0
- N MCI,MCJ,MCK,MCERR
- S MCI=0,MCJ="DX,0"
- F S MCJ=$O(MCA(MCJ)) Q:MCJ=""!($E(MCJ)'=$E("DX,0")) S:MCA(MCJ)'="" MCI=MCI+1 I MCA(MCJ)="" K MCA(MCJ) S MCK=MCJ F S MCK=$O(MCA(MCK)) Q:MCK=""!($E(MCK)'=$E("DX,0")) I MCA(MCK)'="" S MCA(MCJ)=MCA(MCK),MCI=MCI+1,MCA(MCK)="" Q
- S MCA("DX,0")=MCI I MCI>0 Q 0
- S MCERR="62-Diagnosis is a null data field" Q MCERR
- ;
- RXCK(MCA) ;Removes null lines and resets numbering of medication array
- ; USAGE: S X=$$RXCK^MCARAM4(.A)
- ; WHERE: MCA=medication array
- ; .A=medication array renumbered without null lines
- ; A("RX,0")=total number of non-null medication lines
- ; if successful, returns function value of 0 and medication array
- ; if unsuccessful, returns error message and A("RX,0")=0
- N MCI,MCJ,MCK,MCERR
- I MCA("RX,0")="" S MCA("RX,0")=0,MCERR="4-Medication is a null data field" Q MCERR
- F MCJ=1:1 S MCK="RX,"_MCJ,MCA(MCK)=$P(MCA("RX,0"),", ",MCJ) Q:MCA(MCK)="" S MCI=$P(MCA(MCK)," ") I MCI'="",$D(^PSDRUG("B",MCI)) S MCA(MCK)=$O(^(MCI,0))_U_$P(MCA(MCK)," ",2)_U_$P(MCA(MCK)," ",3)
- K MCA(MCK)
- S MCA("RX,0")=MCJ-1 I MCJ-1=0 S MCERR="4-Medication is a null data field" Q MCERR
- Q 0
- ;
- DGCT(MCA,MCD,MCL) ;Fill diagnosis array from continuation record
- ; USAGE: S X=$$DGCT^MCARAM4(.A,B,C)
- ; WHERE: MCA=diagnosis array
- ; .A=diagnosis array renumbered without null lines
- ; B=data field value, C=line number of data
- ; A("DX,0")=total number of non-null diagnosis lines
- ; "DX,L"=12th line of diagnosis, "DX,V"=22nd line
- ; if successful, returns function value of 0 and diagnosis array
- ; if unsuccessful, returns error message and A("DX,0")=0
- N MCI,MCERR
- S MCI="DX,"_MCA("CONT")
- I MCL=13!(MCL=25) S MCERR=$$AR^MCARAM4(.MCA,MCI,MCD,32,78) Q:+MCERR>0 MCERR Q 0
- S MCERR=$$AR^MCARAM4(.MCA,MCI,MCD,32,134) Q:+MCERR>0 MCERR
- Q 0
- ;
- ERR ;Error return
- Q MCERR
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCARAM4 4623 printed Feb 18, 2025@23:38:32 Page 2
- MCARAM4 ;WASH ISC/JKL-MUSE TRANSFER LAB DATA TO LOCAL ;5/20/94 15:35
- +1 ;;2.3;Medicine;;09/13/1996
- +2 ;
- +3 ;
- +4 ;Checks format and/or reformats data
- AR(MCA,MCAA,MCD,MCFP,MCLP,MCCK) ;Sets l/t stripped data field into an array
- +1 ; USAGE: S X=$$AR^MCARAM4(.A,B,C,D,E)
- +2 ; WHERE: .A = array where data is placed
- +3 ; B = array argument for data field
- +4 ; C = data field value
- +5 ; D = first position of data field
- +6 ; E = last position of data field
- +7 ; F = 1 to check numeric data field value for positive int value
- +8 ; 2 to check "" for both positive and negative int value
- +9 ; 3 to check "" for pos,neg,int, and decimal values
- +10 NEW MCI,MCERR
- +11 IF '$DATA(MCCK)
- SET MCCK=""
- +12 SET MCA(MCAA)=$EXTRACT(MCD,MCFP,MCLP)
- SET MCI=MCA(MCAA)
- SET MCERR=$$SLTS^MCARAM4(.MCI)
- SET MCA(MCAA)=MCI
- IF +MCERR>0
- QUIT MCERR
- +13 IF MCCK=1
- SET MCERR=$$DFCK^MCARAM4(MCA(MCAA),MCCK)
- IF +MCERR>0
- QUIT MCERR
- +14 IF MCCK=2
- SET MCERR=$$DFCK^MCARAM4(MCA(MCAA),MCCK)
- IF +MCERR>0
- QUIT MCERR
- +15 IF MCCK=3
- SET MCERR=$$DFCK^MCARAM4(MCA(MCAA),MCCK)
- IF +MCERR>0
- QUIT MCERR
- +16 QUIT 0
- +17 ;
- DFCK(MCV,MCCK) ; Checks numeric,negative,positive,integer,decimal value
- +1 ; USAGE: S X=$$DFCK^MCARAM4(A,B)
- +2 ; WHERE: A=data field value
- +3 ; B=1 for positive value numeric (integer) check
- +4 ; B=2 for positive and negative value numeric (integer) check
- +5 ; B=3 for positive, negative, decimal, or integer numeric check
- +6 ; if successful, returns function value of 0
- +7 ; if unsuccessful, returns error message for incorrect field format
- +8 NEW MCERR
- +9 IF MCV=""
- SET MCERR="2-Null data field"
- QUIT MCERR
- +10 IF MCV=0
- QUIT 0
- +11 IF $GET(MCCK)=1
- IF MCV?1N.N
- QUIT 0
- +12 IF $GET(MCCK)=2
- IF MCV?."-"1N.N
- IF $PIECE(MCV,"-",2,99)'["-"
- IF -MCV+-MCV'=0
- QUIT 0
- +13 IF $GET(MCCK)=3
- IF MCV?."-"."."1N.N.".".N
- IF $PIECE(MCV,".",2,99)'["."
- IF $PIECE(MCV,"-",2,99)'["-"
- IF -MCV+-MCV'=0
- QUIT 0
- +14 SET MCERR="1-Data field not numeric"
- QUIT MCERR
- +15 ;
- SLTS(MCV) ; Strips leading and trailing spaces from data fields
- +1 ; USAGE: S X=$$SLTS^MCARAM4(.A)
- +2 ; WHERE: MCV=data field value
- +3 ; .A = value where data is placed
- +4 ; if successful, returns function value of 0 and data field value
- +5 ; if unsuccessful, returns error message for incorrect field format
- +6 NEW MCERR,MCI,MCJ
- +7 IF MCV=""
- SET MCERR="2-Null data field"
- QUIT MCERR
- +8 FOR MCI=1:1
- IF $EXTRACT(MCV,MCI,MCI)'=" "
- QUIT
- +9 FOR MCJ=$LENGTH(MCV):-1
- IF $EXTRACT(MCV,MCJ,MCJ)'=" "
- QUIT
- +10 SET MCV=$EXTRACT(MCV,MCI,MCJ)
- IF MCV=""
- SET MCERR="2-Null data field"
- QUIT MCERR
- +11 QUIT 0
- +12 ;
- DGCK(MCA) ;Removes null lines and resets numbering of diagnosis array
- +1 ; USAGE: S X=$$DGCK^MCARAM4(.A)
- +2 ; WHERE: MCA=diagnosis array
- +3 ; .A=diagnosis array renumbered without null lines
- +4 ; A("DX,0")=total number of non-null diagnosis lines
- +5 ; if successful, returns function value of 0 and diagnosis array
- +6 ; if unsuccessful, returns error message and A("DX,0")=0
- +7 NEW MCI,MCJ,MCK,MCERR
- +8 SET MCI=0
- SET MCJ="DX,0"
- +9 FOR
- SET MCJ=$ORDER(MCA(MCJ))
- if MCJ=""!($EXTRACT(MCJ)'=$EXTRACT("DX,0"))
- QUIT
- if MCA(MCJ)'=""
- SET MCI=MCI+1
- IF MCA(MCJ)=""
- KILL MCA(MCJ)
- SET MCK=MCJ
- FOR
- SET MCK=$ORDER(MCA(MCK))
- if MCK=""!($EXTRACT(MCK)'=$EXTRACT("DX,0"))
- QUIT
- IF MCA(MCK)'=""
- SET MCA(MCJ)=MCA(MCK)
- SET MCI=MCI+1
- SET MCA(MCK)=""
- QUIT
- +10 SET MCA("DX,0")=MCI
- IF MCI>0
- QUIT 0
- +11 SET MCERR="62-Diagnosis is a null data field"
- QUIT MCERR
- +12 ;
- RXCK(MCA) ;Removes null lines and resets numbering of medication array
- +1 ; USAGE: S X=$$RXCK^MCARAM4(.A)
- +2 ; WHERE: MCA=medication array
- +3 ; .A=medication array renumbered without null lines
- +4 ; A("RX,0")=total number of non-null medication lines
- +5 ; if successful, returns function value of 0 and medication array
- +6 ; if unsuccessful, returns error message and A("RX,0")=0
- +7 NEW MCI,MCJ,MCK,MCERR
- +8 IF MCA("RX,0")=""
- SET MCA("RX,0")=0
- SET MCERR="4-Medication is a null data field"
- QUIT MCERR
- +9 FOR MCJ=1:1
- SET MCK="RX,"_MCJ
- SET MCA(MCK)=$PIECE(MCA("RX,0"),", ",MCJ)
- if MCA(MCK)=""
- QUIT
- SET MCI=$PIECE(MCA(MCK)," ")
- IF MCI'=""
- IF $DATA(^PSDRUG("B",MCI))
- SET MCA(MCK)=$ORDER(^(MCI,0))_U_$PIECE(MCA(MCK)," ",2)_U_$PIECE(MCA(MCK)," ",3)
- +10 KILL MCA(MCK)
- +11 SET MCA("RX,0")=MCJ-1
- IF MCJ-1=0
- SET MCERR="4-Medication is a null data field"
- QUIT MCERR
- +12 QUIT 0
- +13 ;
- DGCT(MCA,MCD,MCL) ;Fill diagnosis array from continuation record
- +1 ; USAGE: S X=$$DGCT^MCARAM4(.A,B,C)
- +2 ; WHERE: MCA=diagnosis array
- +3 ; .A=diagnosis array renumbered without null lines
- +4 ; B=data field value, C=line number of data
- +5 ; A("DX,0")=total number of non-null diagnosis lines
- +6 ; "DX,L"=12th line of diagnosis, "DX,V"=22nd line
- +7 ; if successful, returns function value of 0 and diagnosis array
- +8 ; if unsuccessful, returns error message and A("DX,0")=0
- +9 NEW MCI,MCERR
- +10 SET MCI="DX,"_MCA("CONT")
- +11 IF MCL=13!(MCL=25)
- SET MCERR=$$AR^MCARAM4(.MCA,MCI,MCD,32,78)
- if +MCERR>0
- QUIT MCERR
- QUIT 0
- +12 SET MCERR=$$AR^MCARAM4(.MCA,MCI,MCD,32,134)
- if +MCERR>0
- QUIT MCERR
- +13 QUIT 0
- +14 ;
- ERR ;Error return
- +1 QUIT MCERR
