GMPLINTR ;ISP/TC - Problem List Input Transform ;08/09/17 08:17
;;2.0;Problem List;**49**;Aug 25, 1994;Build 43
;
VCLASS(X,GMPIMPRT,GMPTYPE) ;Check for valid CLASS field
; Ordinary users cannot create National classes.
; Do not execute as part of a verify fields.
I $G(DIUTIL)="VERIFY FIELDS" Q 1
S:'$D(GMPIMPRT) GMPIMPRT=0
S:'$D(GMPTYPE) GMPTYPE=""
I '$L(X) D EN^DDIOL(" Error: "_GMPTYPE_" class cannot be empty.") Q 0
I (X["N"),(DUZ(0)'="@"),('GMPIMPRT) D Q 0
. D EN^DDIOL("You are not allowed to create a NATIONAL class")
S X=$$UP^XLFSTR(X)
I X="NATIONAL"!(X="LOCAL")!(X="VISN")!(X="N")!(X="L")!(X="V") Q 1
E D EN^DDIOL(" Error: Invalid "_GMPTYPE_" class value, "_X_".") Q 0
Q 1
VFLAG(GMPLFLAG) ;Check for a valid flag in CSV file
N GMPLTXT,GMPLINV S GMPLINV=0
I '$L(GMPLFLAG) S GMPLTXT(1)=" Add/delete cell cannot be empty.",GMPLINV=1
E I GMPLFLAG="#"!(GMPLFLAG="@") S GMPLINV=0
E S GMPLTXT(1)=" '"_GMPLFLAG_"' is an invalid character.",GMPLINV=1
I GMPLINV D Q 0
. S GMPLTXT(1)=GMPLTXT(1)_" Must contain # (to add) or @ (to delete)."
. S GMPLTXT(2)=" Please verify cell in import file and correct any errors."
. D EN^DDIOL(.GMPLTXT)
E Q 1
VNAME(GMPNAME,GMPIMPRT,GMPTYPE) ;Check for a valid NAME value.
; The names of selection list components start with "VA-"
; and normal users are not allowed to create them.
; Do not execute as part of a verify fields.
N GMPAUTH,GMPSTEXT,GMPTEXT,GMPVALID
I $G(DIUTIL)="VERIFY FIELDS" Q 1
S:'$D(GMPIMPRT) GMPIMPRT=0
S:'$D(GMPTYPE) GMPTYPE=""
I '$L(GMPNAME) D Q GMPVALID
. S GMPTEXT=" Error: "_GMPTYPE_" name cannot be empty."
. D EN^DDIOL(GMPTEXT) S GMPVALID=0
S GMPNAME=$$UP^XLFSTR(GMPNAME)
S GMPVALID=1
I GMPNAME["~" D
. S GMPTEXT=" Name cannot contain the ""~"" character."
. D EN^DDIOL(GMPTEXT)
. H 2
. S GMPVALID=0
S GMPSTEXT=$E(GMPNAME,1,3)
I (GMPSTEXT="VA-"),('GMPIMPRT) D
. S GMPAUTH=(DUZ(0)="@")
. I 'GMPAUTH D
. . S GMPTEXT=" Name cannot start with ""VA-"", reserved for national selection list components!"
. . D EN^DDIOL(GMPTEXT)
. . H 2
. . S GMPVALID=0
Q GMPVALID
;
VICD(GMPLICD) ;Check for a valid ICD code
N GMI,GMPDT,GMPVALID S GMPDT=$$DT^XLFDT,GMPVALID=0
; Do not execute if ICD-9 code and as part of verify fields report
I GMPLICD?1.3(1.3N1"."0.3N0.1"/"),($G(DIUTIL)="VERIFY FIELDS") S GMPVALID=1
I GMPLICD?1.3(1U2N1".".4N0.1"/")!(GMPLICD?1.3(1U2N1".".4U0.1"/")) S GMPVALID=1
I GMPLICD?1.3(1U2N1".".3N.1U0.1"/")!(GMPLICD?1.3(1U2N1".".1U.3N0.1"/")) S GMPVALID=1
I GMPLICD?1.3(1U2N1".".1N.1U0.2N0.1"/")!(GMPLICD?1.3(1U2N1"."0.2N.1U.1N0.1"/")) S GMPVALID=1
I GMPVALID D
. F GMI=1:1:$L(GMPLICD,"/") D
. . N GMPLCPTR S GMPLCPTR=$P($$CODECS^ICDEX($P(GMPLICD,"/",GMI),80,GMPDT),U)
. . I '$$STATCHK^ICDEX($P(GMPLICD,"/",GMI),GMPDT,GMPLCPTR) D Q
. . . D EN^DDIOL(" ICD Code: "_GMPLICD_" is inactive.")
. . . S GMPVALID=0
E D EN^DDIOL(" ICD Code: "_GMPLICD_" is invalid.")
Q GMPVALID
;
VSCTCODE(GMPLSCTC) ;Check for a valid SNOMED CT code
N GMPDT,GMPVALID,GMPSCHK S GMPDT=$$DT^XLFDT,GMPVALID=1
S GMPSCHK=$$STATCHK^LEXSRC2(GMPLSCTC,GMPDT,"","SCT")
I '+GMPSCHK,($L($P(GMPSCHK,U,3))) D
. D EN^DDIOL(" SNOMED CT Concept: "_GMPLSCTC_" is inactive.")
. S GMPVALID=0
E I '+GMPSCHK,($P(GMPSCHK,U,2)<0) D
. D EN^DDIOL(" SNOMED CT Concept: "_GMPLSCTC_" is invalid.")
. S GMPVALID=0
E I '+GMPSCHK,('$L($P(GMPSCHK,U,3))) D
. D EN^DDIOL(" SNOMED CT Concept: "_GMPLSCTC_" is not yet active.")
. S GMPVALID=0
Q GMPVALID
;
VSCTDSGN(GMPLSCTC,GMPLSCTD,GMPLDTXT) ;Check for a valid SNOMED CT designation code
N GMPDT,GMPVALID,GMPLSDGN,GMPQT,GMPSYN,GMPTYP,GMPNUM,GMPLRSLT,GMPLTXT
S GMPDT=$$DT^XLFDT,GMPVALID=1,(GMPQT,GMPNUM)=0,(GMPTYP,GMPLSDGN)=""
S GMPLRSLT=$$GETSYN^LEXTRAN1("SCT",GMPLSCTC,GMPDT,"GMPSYN",1,1)
I +GMPLRSLT<0 D G VSCTDX Q
. S GMPLTXT(2)=" Error: "_$P(GMPLRSLT,U,2)
. S GMPVALID=0
S GMPLDTXT=$$STRIPSPC^GMPLX(GMPLDTXT)
F S GMPTYP=$O(GMPSYN(GMPTYP)) Q:GMPTYP=""!(GMPQT) D
. I GMPTYP="S" F S GMPNUM=$O(GMPSYN(GMPTYP,GMPNUM)) Q:GMPNUM=""!(GMPQT) D
. . I $$STRIPSPC^GMPLX($P(GMPSYN(GMPTYP,GMPNUM),U))=GMPLDTXT S GMPLSDGN=$P(GMPSYN(GMPTYP,GMPNUM),U,3),GMPQT=1 Q
. I (GMPNUM=""),(GMPLSDGN="") D G VSCTDX Q
. . S GMPLTXT(2)=" Error: Check failed, problem description does not match that of system."
. . S GMPVALID=0,GMPQT=1
. Q:GMPQT
. I $$STRIPSPC^GMPLX($P(GMPSYN(GMPTYP),U))=GMPLDTXT S GMPLSDGN=$P(GMPSYN(GMPTYP),U,3),GMPQT=1 Q
I 'GMPVALID G VSCTDX1
I +GMPLRSLT>0 D
. I GMPLSCTD'=GMPLSDGN S GMPLTXT(2)=" Error: Check failed, designation code does not match that of system.",GMPVALID=0
VSCTDX I 'GMPVALID D
. S GMPLTXT(1)=" SNOMED CT Designation: "_GMPLSCTD_" is invalid."
. D EN^DDIOL(.GMPLTXT)
VSCTDX1 Q GMPVALID
;
VSEQ(X,GMPLTYPE) ; Check for valid SEQUENCE field
N GMPLTXT,GMPLINV S GMPLINV=0
I '$L(X) S GMPLTXT=" Error: "_GMPLTYPE_" sequence cannot be empty.",GMPLINV=1
E I +X'=X!(X>999.99)!(X<.01)!(X?.E1"."3N.N) S GMPLTXT=" "_GMPLTYPE_" Sequence: "_X_" is invalid.",GMPLINV=1
I GMPLINV D EN^DDIOL(GMPLTXT) Q 0
E Q 1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMPLINTR 5100 printed Sep 23, 2025@20:06:16 Page 2
GMPLINTR ;ISP/TC - Problem List Input Transform ;08/09/17 08:17
+1 ;;2.0;Problem List;**49**;Aug 25, 1994;Build 43
+2 ;
VCLASS(X,GMPIMPRT,GMPTYPE) ;Check for valid CLASS field
+1 ; Ordinary users cannot create National classes.
+2 ; Do not execute as part of a verify fields.
+3 IF $GET(DIUTIL)="VERIFY FIELDS"
QUIT 1
+4 if '$DATA(GMPIMPRT)
SET GMPIMPRT=0
+5 if '$DATA(GMPTYPE)
SET GMPTYPE=""
+6 IF '$LENGTH(X)
DO EN^DDIOL(" Error: "_GMPTYPE_" class cannot be empty.")
QUIT 0
+7 IF (X["N")
IF (DUZ(0)'="@")
IF ('GMPIMPRT)
Begin DoDot:1
+8 DO EN^DDIOL("You are not allowed to create a NATIONAL class")
End DoDot:1
QUIT 0
+9 SET X=$$UP^XLFSTR(X)
+10 IF X="NATIONAL"!(X="LOCAL")!(X="VISN")!(X="N")!(X="L")!(X="V")
QUIT 1
+11 IF '$TEST
DO EN^DDIOL(" Error: Invalid "_GMPTYPE_" class value, "_X_".")
QUIT 0
+12 QUIT 1
VFLAG(GMPLFLAG) ;Check for a valid flag in CSV file
+1 NEW GMPLTXT,GMPLINV
SET GMPLINV=0
+2 IF '$LENGTH(GMPLFLAG)
SET GMPLTXT(1)=" Add/delete cell cannot be empty."
SET GMPLINV=1
+3 IF '$TEST
IF GMPLFLAG="#"!(GMPLFLAG="@")
SET GMPLINV=0
+4 IF '$TEST
SET GMPLTXT(1)=" '"_GMPLFLAG_"' is an invalid character."
SET GMPLINV=1
+5 IF GMPLINV
Begin DoDot:1
+6 SET GMPLTXT(1)=GMPLTXT(1)_" Must contain # (to add) or @ (to delete)."
+7 SET GMPLTXT(2)=" Please verify cell in import file and correct any errors."
+8 DO EN^DDIOL(.GMPLTXT)
End DoDot:1
QUIT 0
+9 IF '$TEST
QUIT 1
VNAME(GMPNAME,GMPIMPRT,GMPTYPE) ;Check for a valid NAME value.
+1 ; The names of selection list components start with "VA-"
+2 ; and normal users are not allowed to create them.
+3 ; Do not execute as part of a verify fields.
+4 NEW GMPAUTH,GMPSTEXT,GMPTEXT,GMPVALID
+5 IF $GET(DIUTIL)="VERIFY FIELDS"
QUIT 1
+6 if '$DATA(GMPIMPRT)
SET GMPIMPRT=0
+7 if '$DATA(GMPTYPE)
SET GMPTYPE=""
+8 IF '$LENGTH(GMPNAME)
Begin DoDot:1
+9 SET GMPTEXT=" Error: "_GMPTYPE_" name cannot be empty."
+10 DO EN^DDIOL(GMPTEXT)
SET GMPVALID=0
End DoDot:1
QUIT GMPVALID
+11 SET GMPNAME=$$UP^XLFSTR(GMPNAME)
+12 SET GMPVALID=1
+13 IF GMPNAME["~"
Begin DoDot:1
+14 SET GMPTEXT=" Name cannot contain the ""~"" character."
+15 DO EN^DDIOL(GMPTEXT)
+16 HANG 2
+17 SET GMPVALID=0
End DoDot:1
+18 SET GMPSTEXT=$EXTRACT(GMPNAME,1,3)
+19 IF (GMPSTEXT="VA-")
IF ('GMPIMPRT)
Begin DoDot:1
+20 SET GMPAUTH=(DUZ(0)="@")
+21 IF 'GMPAUTH
Begin DoDot:2
+22 SET GMPTEXT=" Name cannot start with ""VA-"", reserved for national selection list components!"
+23 DO EN^DDIOL(GMPTEXT)
+24 HANG 2
+25 SET GMPVALID=0
End DoDot:2
End DoDot:1
+26 QUIT GMPVALID
+27 ;
VICD(GMPLICD) ;Check for a valid ICD code
+1 NEW GMI,GMPDT,GMPVALID
SET GMPDT=$$DT^XLFDT
SET GMPVALID=0
+2 ; Do not execute if ICD-9 code and as part of verify fields report
+3 IF GMPLICD?1.3(1.3N1"."0.3N0.1"/")
IF ($GET(DIUTIL)="VERIFY FIELDS")
SET GMPVALID=1
+4 IF GMPLICD?1.3(1U2N1".".4N0.1"/")!(GMPLICD?1.3(1U2N1".".4U0.1"/"))
SET GMPVALID=1
+5 IF GMPLICD?1.3(1U2N1".".3N.1U0.1"/")!(GMPLICD?1.3(1U2N1".".1U.3N0.1"/"))
SET GMPVALID=1
+6 IF GMPLICD?1.3(1U2N1".".1N.1U0.2N0.1"/")!(GMPLICD?1.3(1U2N1"."0.2N.1U.1N0.1"/"))
SET GMPVALID=1
+7 IF GMPVALID
Begin DoDot:1
+8 FOR GMI=1:1:$LENGTH(GMPLICD,"/")
Begin DoDot:2
+9 NEW GMPLCPTR
SET GMPLCPTR=$PIECE($$CODECS^ICDEX($PIECE(GMPLICD,"/",GMI),80,GMPDT),U)
+10 IF '$$STATCHK^ICDEX($PIECE(GMPLICD,"/",GMI),GMPDT,GMPLCPTR)
Begin DoDot:3
+11 DO EN^DDIOL(" ICD Code: "_GMPLICD_" is inactive.")
+12 SET GMPVALID=0
End DoDot:3
QUIT
End DoDot:2
End DoDot:1
+13 IF '$TEST
DO EN^DDIOL(" ICD Code: "_GMPLICD_" is invalid.")
+14 QUIT GMPVALID
+15 ;
VSCTCODE(GMPLSCTC) ;Check for a valid SNOMED CT code
+1 NEW GMPDT,GMPVALID,GMPSCHK
SET GMPDT=$$DT^XLFDT
SET GMPVALID=1
+2 SET GMPSCHK=$$STATCHK^LEXSRC2(GMPLSCTC,GMPDT,"","SCT")
+3 IF '+GMPSCHK
IF ($LENGTH($PIECE(GMPSCHK,U,3)))
Begin DoDot:1
+4 DO EN^DDIOL(" SNOMED CT Concept: "_GMPLSCTC_" is inactive.")
+5 SET GMPVALID=0
End DoDot:1
+6 IF '$TEST
IF '+GMPSCHK
IF ($PIECE(GMPSCHK,U,2)<0)
Begin DoDot:1
+7 DO EN^DDIOL(" SNOMED CT Concept: "_GMPLSCTC_" is invalid.")
+8 SET GMPVALID=0
End DoDot:1
+9 IF '$TEST
IF '+GMPSCHK
IF ('$LENGTH($PIECE(GMPSCHK,U,3)))
Begin DoDot:1
+10 DO EN^DDIOL(" SNOMED CT Concept: "_GMPLSCTC_" is not yet active.")
+11 SET GMPVALID=0
End DoDot:1
+12 QUIT GMPVALID
+13 ;
VSCTDSGN(GMPLSCTC,GMPLSCTD,GMPLDTXT) ;Check for a valid SNOMED CT designation code
+1 NEW GMPDT,GMPVALID,GMPLSDGN,GMPQT,GMPSYN,GMPTYP,GMPNUM,GMPLRSLT,GMPLTXT
+2 SET GMPDT=$$DT^XLFDT
SET GMPVALID=1
SET (GMPQT,GMPNUM)=0
SET (GMPTYP,GMPLSDGN)=""
+3 SET GMPLRSLT=$$GETSYN^LEXTRAN1("SCT",GMPLSCTC,GMPDT,"GMPSYN",1,1)
+4 IF +GMPLRSLT<0
Begin DoDot:1
+5 SET GMPLTXT(2)=" Error: "_$PIECE(GMPLRSLT,U,2)
+6 SET GMPVALID=0
End DoDot:1
GOTO VSCTDX
QUIT
+7 SET GMPLDTXT=$$STRIPSPC^GMPLX(GMPLDTXT)
+8 FOR
SET GMPTYP=$ORDER(GMPSYN(GMPTYP))
if GMPTYP=""!(GMPQT)
QUIT
Begin DoDot:1
+9 IF GMPTYP="S"
FOR
SET GMPNUM=$ORDER(GMPSYN(GMPTYP,GMPNUM))
if GMPNUM=""!(GMPQT)
QUIT
Begin DoDot:2
+10 IF $$STRIPSPC^GMPLX($PIECE(GMPSYN(GMPTYP,GMPNUM),U))=GMPLDTXT
SET GMPLSDGN=$PIECE(GMPSYN(GMPTYP,GMPNUM),U,3)
SET GMPQT=1
QUIT
End DoDot:2
+11 IF (GMPNUM="")
IF (GMPLSDGN="")
Begin DoDot:2
+12 SET GMPLTXT(2)=" Error: Check failed, problem description does not match that of system."
+13 SET GMPVALID=0
SET GMPQT=1
End DoDot:2
GOTO VSCTDX
QUIT
+14 if GMPQT
QUIT
+15 IF $$STRIPSPC^GMPLX($PIECE(GMPSYN(GMPTYP),U))=GMPLDTXT
SET GMPLSDGN=$PIECE(GMPSYN(GMPTYP),U,3)
SET GMPQT=1
QUIT
End DoDot:1
+16 IF 'GMPVALID
GOTO VSCTDX1
+17 IF +GMPLRSLT>0
Begin DoDot:1
+18 IF GMPLSCTD'=GMPLSDGN
SET GMPLTXT(2)=" Error: Check failed, designation code does not match that of system."
SET GMPVALID=0
End DoDot:1
VSCTDX IF 'GMPVALID
Begin DoDot:1
+1 SET GMPLTXT(1)=" SNOMED CT Designation: "_GMPLSCTD_" is invalid."
+2 DO EN^DDIOL(.GMPLTXT)
End DoDot:1
VSCTDX1 QUIT GMPVALID
+1 ;
VSEQ(X,GMPLTYPE) ; Check for valid SEQUENCE field
+1 NEW GMPLTXT,GMPLINV
SET GMPLINV=0
+2 IF '$LENGTH(X)
SET GMPLTXT=" Error: "_GMPLTYPE_" sequence cannot be empty."
SET GMPLINV=1
+3 IF '$TEST
IF +X'=X!(X>999.99)!(X<.01)!(X?.E1"."3N.N)
SET GMPLTXT=" "_GMPLTYPE_" Sequence: "_X_" is invalid."
SET GMPLINV=1
+4 IF GMPLINV
DO EN^DDIOL(GMPLTXT)
QUIT 0
+5 IF '$TEST
QUIT 1
