Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: GMPLINTR

GMPLINTR.m

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