- PXRMINTR ;SLC/PKR,PJH - Input transforms for Clinical Reminders. ;06/27/2024
- ;;2.0;CLINICAL REMINDERS;**4,12,16,18,26,45,88**;Feb 04, 2005;Build 13
- ;References ICR#
- ;^AUTTHF 3083
- ;^LAB(60,LABTEST,0) 91
- ;
- ;=======================================================
- VASP(DA,X) ;Check for valid associate sponsor in file 811.6.
- ;Do not execute as part of a verify fields.
- I $G(DIUTIL)="VERIFY FIELDS" Q 1
- ;Do not execute as part of exchange.
- I $G(PXRMEXCH) Q 1
- ;Make sure that an associated sponsor does not point to itself.
- I X=DA D Q 0
- . D EN^DDIOL("An associated sponsor cannot point to itself.")
- . I '$D(DIQUIET) H 2
- ;A sponsor cannot be an associated sponsor if it contains associated
- ;sponsors.
- I $D(^PXRMD(811.6,X,2,"B")) D Q 0
- . D EN^DDIOL("A sponsor cannot be selected as an associated sponsor if it contains associated sponsors.")
- . I '$D(DIQUIET) H 2
- ;The class of an associated sponsor must match that of the sponsor.
- N ASCLASS,SCLASS
- S SCLASS=$P(^PXRMD(811.6,DA,0),U,2)
- S ASCLASS=$P(^PXRMD(811.6,X,0),U,2)
- I ASCLASS'=SCLASS D Q 0
- . N TEXT
- . S TEXT="The associated sponsor's class is "_ASCLASS_", it does not match the sponsor's class which is "_SCLASS_". They must match."
- . D EN^DDIOL(TEXT)
- . I '$D(DIQUIET) H 2
- Q 1
- ;
- ;=======================================================
- VCLASS(X) ;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
- ;Do not execute as part of exchange.
- I $G(PXRMEXCH) Q 1
- I (X["N"),(($G(PXRMINST)'=1)!(DUZ(0)'="@")) D Q 0
- . D EN^DDIOL("You are not allowed to create a NATIONAL class")
- . I '$D(DIQUIET) H 2
- E Q 1
- ;
- ;=======================================================
- VDT(X) ;Check for a valid date/time. Input transform on
- ;beginning date/time and ending date/time fields.
- N FMDATE,PXRMINTR,VALID
- S PXRMINTR=1
- ;If X is already in internal FileMan format make sure it is valid.
- I X?7N0.1"."0.6N D DT^DILF("ST",X,.FMDATE,"","MSG")
- I X'?7N0.1"."0.6N S FMDATE=$$CTFMD^PXRMDATE(X)
- S VALID=$S(FMDATE=-1:0,1:1)
- I 'VALID D
- . N TEXT
- . S TEXT=X_" is not a valid date/time"
- . D EN^DDIOL(TEXT)
- . I '$D(DIQUIET) H 2
- Q VALID
- ;
- ;=======================================================
- VFINDING(X) ;Check X to see if it is a valid finding. This is the input
- ;transform on the .01 field of the reminder findings multiple for
- ;definitions and terms.
- ;Include stubs for all possible finding types in case we need input
- ;transforms on them.
- ;I X["AUTTEDT(" Q 1
- ;I X["AUTTEXAM(" Q 1
- I X["AUTTHF(" Q $$VHF(X)
- ;I X["AUTTIMM(" Q 1
- ;I X["AUTTSK(" Q 1
- ;I X["GMRD(120.51," Q 1
- I X["LAB(60," Q $$VLAB(X)
- ;I X["ORD(101.43," Q 1
- I X["PXD(811.2," Q $$VTAX(X)
- ;I X["PXRMD(811.4," Q 1
- ;I X["PXRMD(811.5," Q 1
- ;I X["PS(50.605," Q 1
- ;I X["PSDRUG(" Q 1
- ;I X["PSNDF(50.6," Q 1
- ;I X["RAMIS(71," Q 1
- ;I X["YTT(601," Q 1
- Q 1
- ;
- ;=======================================================
- VFREQ(X) ;Check for a valid frequency. It must be of the form NU,
- ;where N is an integer and U is unit. The integer can be between
- ;0 and 9999 inclusive. Valid units are: H (hours),
- ;D (days), W (weeks), M (months), and Y (years). Used as input
- ;transform for Baseline Frequency, finding multiple Reminder
- ;Frequency and called by Custom Date Due input transform.
- S X=$$UP^XLFSTR(X)
- Q X?1.4N1(1"H",1"D",1"W",1"M",1"Y")
- ;
- ;=======================================================
- VHF(X) ;Check for valid health factor findings. It must be a factor, not
- ;a category.
- N CAT,IEN,TEMP,TYPE
- S IEN=$P(X,";",1)
- S TEMP=$G(^AUTTHF(IEN,0))
- S TYPE=$P(TEMP,U,10)
- I TYPE="C" D Q 0
- . D EN^DDIOL("Category health factors cannot be used as a finding!")
- . I '$D(DIQUIET) H 2
- I TYPE'="F" D Q 0
- . D EN^DDIOL("Only factor health factors can be used as a finding!")
- . I '$D(DIQUIET) H 2
- ;Make sure that the health factor has a category.
- S CAT=$P(TEMP,U,3)
- I CAT="" D Q 0
- . D EN^DDIOL("Factor health factors must have a category!")
- . I '$D(DIQUIET) H 2
- I '$D(^AUTTHF(CAT)) D Q 0
- . D EN^DDIOL("The category for this health factor does not exist!")
- . I '$D(DIQUIET) H 2
- Q 1
- ;
- ;=======================================================
- VIGNAC(X) ;Check X to see if it contains valid IGNORE ON N/A codes.
- ;This is part of the input transform for this field. The length of the
- ;IGNORE ON N/A field is 8 characters. The valid codes are:
- ; A - age
- ; I - inactive
- ; R - race
- ; S - sex
- ; * - wildcard matches anything.
- N LEN
- S LEN=$L(X)
- I (LEN>8)!(LEN<1) Q 0
- ;
- N TEMP,TEXT
- S TEMP=X
- S TEMP=$TR(TEMP,"A","")
- S TEMP=$TR(TEMP,"I","")
- S TEMP=$TR(TEMP,"R","")
- S TEMP=$TR(TEMP,"S","")
- S TEMP=$TR(TEMP,"*","")
- ;At this point TEMP should be NULL,if it is not then there are
- ;bad codes.
- S LEN=$L(TEMP)
- I LEN=1 D Q 0
- . S TEXT=TEMP_" is not a valid IGNORE ON N/A code!"
- . D EN^DDIOL(TEXT)
- . I '$D(DIQUIET) H 2
- I LEN>1 D Q 0
- . S TEXT=TEMP_" are not valid IGNORE ON N/A codes!"
- . D EN^DDIOL(TEXT)
- . I '$D(DIQUIET) H 2
- Q 1
- ;
- ;=======================================================
- VLAB(X) ;Check for valid lab findings. Everything but a panel is ok.
- I X'["LAB(60" Q 1
- N DATANAME,LAB0,LABTEST,SUB,TEST,TEXT
- S LABTEST=$P(X,";",1)
- ;DBIA #91-A
- S LAB0=^LAB(60,LABTEST,0)
- S SUB=$P(LAB0,U,4)
- ;BB and WK not allowed
- I (SUB="BB")!(SUB="WK") D Q 0
- . S TEXT=SUB_" tests cannot be used as reminder findings."
- . D EN^DDIOL(.TEXT)
- . I '$D(DIQUIET) H 2
- ;The concept of lab panel only applies to CH tests.
- I SUB'["CH" Q 1
- S DATANAME=$P(LAB0,U,5)
- ;If DATA NAME is null then it is a panel.
- I DATANAME="" D Q 0
- . S TEXT(1)=$P(LAB0,U,1)_" is a lab panel, it cannot be used as a reminder finding!"
- . S TEXT(2)="Contact your Lab ADPAC for help"
- . D EN^DDIOL(.TEXT)
- . I '$D(DIQUIET) H 2
- Q 1
- ;
- ;=======================================================
- VNAME(NAME) ;Check for a valid .01 value. The names of national reminder
- ;components start with "VA-" and normal users are not allowed to
- ;create them.
- ;Do not execute as part of a verify fields.
- I $G(DIUTIL)="VERIFY FIELDS" Q 1
- ;Do not execute as part of exchange.
- I $G(PXRMEXCH) Q 1
- N AUTH,CHAR,LEN,STEXT,TEXT,VALID
- S NAME=$$UP^XLFSTR(NAME)
- S VALID=1
- I NAME["~" D
- . S TEXT="Name cannot contain the ""~"" character."
- . D EN^DDIOL(TEXT)
- . I '$D(DIQUIET) H 2
- . S VALID=0
- S STEXT=$E(NAME,1,3)
- I (STEXT="VA-") D
- . S AUTH=($G(PXRMINST)=1)&(DUZ(0)="@")
- . I 'AUTH D
- .. S TEXT="Name cannot start with ""VA-"", reserved for national reminder components!"
- .. D EN^DDIOL(TEXT)
- .. I '$D(DIQUIET) H 2
- .. S VALID=0
- S LEN=$L(NAME),CHAR=$E(NAME,LEN)
- I $A(CHAR)<33 D
- . S TEXT="Name cannot have trailing non-printing characters."
- . D EN^DDIOL(TEXT)
- . I '$D(DIQUIET) H 2
- . S VALID=0
- Q VALID
- ;
- ;=======================================================
- VPRIOL(X) ;Check for a valid Priority List.
- ;Do not execute as part of a verify fields.
- I $L(X)=0 Q 1
- I $G(DIUTIL)="VERIFY FIELDS" Q 1
- ;Do not execute as part of exchange.
- I $G(PXRMEXCH) Q 1
- N IND,CHAR,TEXT,VALID
- S X=$$UP^XLFSTR(X)
- S VALID=1
- F IND=1:1:$L(X) D
- . S CHAR=$E(X,IND)
- . I CHAR?0.1"A"0.1"C"0.1"U" Q
- . S VALID=0
- . S TEXT=CHAR_" is not valid for the Priority List"
- . D EN^DDIOL(TEXT)
- . I '$D(DIQUIET) H 2
- Q VALID
- ;
- ;=======================================================
- ;If there is no sponsor don't do the check.
- I X="" Q 1
- ;Do not execute as part of a verify fields.
- I $G(DIUTIL)="VERIFY FIELDS" Q 1
- ;Do not execute as part of exchange.
- I $G(PXRMEXCH) Q 1
- N FCLASS,FILENUM,SCLASS,TEXT,VALID
- S VALID=1
- I $G(X)="" Q VALID
- I $G(DIC)="" Q 0
- S FILENUM=+$P(@(DIC_"0)"),U,2)
- S FCLASS=$P(@(DIC_DA_",100)"),U,1)
- S SCLASS=$P(^PXRMD(811.6,X,100),U,1)
- I SCLASS'=FCLASS D
- . S FCLASS=$$EXTERNAL^DILFD(FILENUM,100,"",FCLASS)
- . S SCLASS=$$EXTERNAL^DILFD(811.6,100,"",SCLASS)
- . S TEXT="Sponsor Class is "_SCLASS_", File Class is "_FCLASS_" they must match!"
- . D EN^DDIOL(TEXT)
- . I '$D(DIQUIET) H 2
- . S VALID=0
- Q VALID
- ;
- ;=======================================================
- VTAX(X) ;Make sure the taxonomy is active.
- N IEN,INACTIVE
- S IEN=$P(X,";",1)
- S INACTIVE=$P(^PXD(811.2,IEN,0),U,6)
- I INACTIVE D Q 0
- . D EN^DDIOL("This taxonomy is inactive and cannot be selected.")
- . I '$D(DIQUIET) H 2
- Q 1
- ;
- ;=======================================================
- VUSAGE(X) ;Check X to see if it contains valid USAGE codes.
- ;This is part of the input transform for this field. The length of the
- ;USAGE field is 10 characters. The valid codes are:
- ; A - Action
- ; C - CPRS
- ; L - Reminder Patient List
- ; O - Reminder Order Checks
- ; P - Patient
- ; R - Reports
- ; X - Extracts
- ; * - Wildcard matches anything, except P.
- N LEN
- S LEN=$L(X)
- I (LEN>10)!(LEN<1) Q 0
- ;
- N TEMP,TEXT
- S TEMP=$$UP^XLFSTR(X)
- S TEMP=$TR(TEMP,"A","")
- S TEMP=$TR(TEMP,"C","")
- S TEMP=$TR(TEMP,"L","")
- S TEMP=$TR(TEMP,"O","")
- S TEMP=$TR(TEMP,"P","")
- S TEMP=$TR(TEMP,"R","")
- S TEMP=$TR(TEMP,"X","")
- S TEMP=$TR(TEMP,"*","")
- ;At this point TEMP should be NULL,if it is not then there are
- ;bad codes.
- S LEN=$L(TEMP)
- I LEN=1 D Q 0
- . S TEXT=TEMP_" is not a valid USAGE code!"
- . D EN^DDIOL(TEXT)
- . I '$D(DIQUIET) H 2
- I LEN>1 D Q 0
- . S TEXT=TEMP_" are not valid USAGE codes!"
- . D EN^DDIOL(TEXT)
- . I '$D(DIQUIET) H 2
- Q 1
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMINTR 9659 printed Jan 18, 2025@02:47:28 Page 2
- PXRMINTR ;SLC/PKR,PJH - Input transforms for Clinical Reminders. ;06/27/2024
- +1 ;;2.0;CLINICAL REMINDERS;**4,12,16,18,26,45,88**;Feb 04, 2005;Build 13
- +2 ;References ICR#
- +3 ;^AUTTHF 3083
- +4 ;^LAB(60,LABTEST,0) 91
- +5 ;
- +6 ;=======================================================
- VASP(DA,X) ;Check for valid associate sponsor in file 811.6.
- +1 ;Do not execute as part of a verify fields.
- +2 IF $GET(DIUTIL)="VERIFY FIELDS"
- QUIT 1
- +3 ;Do not execute as part of exchange.
- +4 IF $GET(PXRMEXCH)
- QUIT 1
- +5 ;Make sure that an associated sponsor does not point to itself.
- +6 IF X=DA
- Begin DoDot:1
- +7 DO EN^DDIOL("An associated sponsor cannot point to itself.")
- +8 IF '$DATA(DIQUIET)
- HANG 2
- End DoDot:1
- QUIT 0
- +9 ;A sponsor cannot be an associated sponsor if it contains associated
- +10 ;sponsors.
- +11 IF $DATA(^PXRMD(811.6,X,2,"B"))
- Begin DoDot:1
- +12 DO EN^DDIOL("A sponsor cannot be selected as an associated sponsor if it contains associated sponsors.")
- +13 IF '$DATA(DIQUIET)
- HANG 2
- End DoDot:1
- QUIT 0
- +14 ;The class of an associated sponsor must match that of the sponsor.
- +15 NEW ASCLASS,SCLASS
- +16 SET SCLASS=$PIECE(^PXRMD(811.6,DA,0),U,2)
- +17 SET ASCLASS=$PIECE(^PXRMD(811.6,X,0),U,2)
- +18 IF ASCLASS'=SCLASS
- Begin DoDot:1
- +19 NEW TEXT
- +20 SET TEXT="The associated sponsor's class is "_ASCLASS_", it does not match the sponsor's class which is "_SCLASS_". They must match."
- +21 DO EN^DDIOL(TEXT)
- +22 IF '$DATA(DIQUIET)
- HANG 2
- End DoDot:1
- QUIT 0
- +23 QUIT 1
- +24 ;
- +25 ;=======================================================
- VCLASS(X) ;Check for valid CLASS field, ordinary users cannot create
- +1 ;National classes.
- +2 ;Do not execute as part of a verify fields.
- +3 IF $GET(DIUTIL)="VERIFY FIELDS"
- QUIT 1
- +4 ;Do not execute as part of exchange.
- +5 IF $GET(PXRMEXCH)
- QUIT 1
- +6 IF (X["N")
- IF (($GET(PXRMINST)'=1)!(DUZ(0)'="@"))
- Begin DoDot:1
- +7 DO EN^DDIOL("You are not allowed to create a NATIONAL class")
- +8 IF '$DATA(DIQUIET)
- HANG 2
- End DoDot:1
- QUIT 0
- +9 IF '$TEST
- QUIT 1
- +10 ;
- +11 ;=======================================================
- VDT(X) ;Check for a valid date/time. Input transform on
- +1 ;beginning date/time and ending date/time fields.
- +2 NEW FMDATE,PXRMINTR,VALID
- +3 SET PXRMINTR=1
- +4 ;If X is already in internal FileMan format make sure it is valid.
- +5 IF X?7N0.1"."0.6N
- DO DT^DILF("ST",X,.FMDATE,"","MSG")
- +6 IF X'?7N0.1"."0.6N
- SET FMDATE=$$CTFMD^PXRMDATE(X)
- +7 SET VALID=$SELECT(FMDATE=-1:0,1:1)
- +8 IF 'VALID
- Begin DoDot:1
- +9 NEW TEXT
- +10 SET TEXT=X_" is not a valid date/time"
- +11 DO EN^DDIOL(TEXT)
- +12 IF '$DATA(DIQUIET)
- HANG 2
- End DoDot:1
- +13 QUIT VALID
- +14 ;
- +15 ;=======================================================
- VFINDING(X) ;Check X to see if it is a valid finding. This is the input
- +1 ;transform on the .01 field of the reminder findings multiple for
- +2 ;definitions and terms.
- +3 ;Include stubs for all possible finding types in case we need input
- +4 ;transforms on them.
- +5 ;I X["AUTTEDT(" Q 1
- +6 ;I X["AUTTEXAM(" Q 1
- +7 IF X["AUTTHF("
- QUIT $$VHF(X)
- +8 ;I X["AUTTIMM(" Q 1
- +9 ;I X["AUTTSK(" Q 1
- +10 ;I X["GMRD(120.51," Q 1
- +11 IF X["LAB(60,"
- QUIT $$VLAB(X)
- +12 ;I X["ORD(101.43," Q 1
- +13 IF X["PXD(811.2,"
- QUIT $$VTAX(X)
- +14 ;I X["PXRMD(811.4," Q 1
- +15 ;I X["PXRMD(811.5," Q 1
- +16 ;I X["PS(50.605," Q 1
- +17 ;I X["PSDRUG(" Q 1
- +18 ;I X["PSNDF(50.6," Q 1
- +19 ;I X["RAMIS(71," Q 1
- +20 ;I X["YTT(601," Q 1
- +21 QUIT 1
- +22 ;
- +23 ;=======================================================
- VFREQ(X) ;Check for a valid frequency. It must be of the form NU,
- +1 ;where N is an integer and U is unit. The integer can be between
- +2 ;0 and 9999 inclusive. Valid units are: H (hours),
- +3 ;D (days), W (weeks), M (months), and Y (years). Used as input
- +4 ;transform for Baseline Frequency, finding multiple Reminder
- +5 ;Frequency and called by Custom Date Due input transform.
- +6 SET X=$$UP^XLFSTR(X)
- +7 QUIT X?1.4N1(1"H",1"D",1"W",1"M",1"Y")
- +8 ;
- +9 ;=======================================================
- VHF(X) ;Check for valid health factor findings. It must be a factor, not
- +1 ;a category.
- +2 NEW CAT,IEN,TEMP,TYPE
- +3 SET IEN=$PIECE(X,";",1)
- +4 SET TEMP=$GET(^AUTTHF(IEN,0))
- +5 SET TYPE=$PIECE(TEMP,U,10)
- +6 IF TYPE="C"
- Begin DoDot:1
- +7 DO EN^DDIOL("Category health factors cannot be used as a finding!")
- +8 IF '$DATA(DIQUIET)
- HANG 2
- End DoDot:1
- QUIT 0
- +9 IF TYPE'="F"
- Begin DoDot:1
- +10 DO EN^DDIOL("Only factor health factors can be used as a finding!")
- +11 IF '$DATA(DIQUIET)
- HANG 2
- End DoDot:1
- QUIT 0
- +12 ;Make sure that the health factor has a category.
- +13 SET CAT=$PIECE(TEMP,U,3)
- +14 IF CAT=""
- Begin DoDot:1
- +15 DO EN^DDIOL("Factor health factors must have a category!")
- +16 IF '$DATA(DIQUIET)
- HANG 2
- End DoDot:1
- QUIT 0
- +17 IF '$DATA(^AUTTHF(CAT))
- Begin DoDot:1
- +18 DO EN^DDIOL("The category for this health factor does not exist!")
- +19 IF '$DATA(DIQUIET)
- HANG 2
- End DoDot:1
- QUIT 0
- +20 QUIT 1
- +21 ;
- +22 ;=======================================================
- VIGNAC(X) ;Check X to see if it contains valid IGNORE ON N/A codes.
- +1 ;This is part of the input transform for this field. The length of the
- +2 ;IGNORE ON N/A field is 8 characters. The valid codes are:
- +3 ; A - age
- +4 ; I - inactive
- +5 ; R - race
- +6 ; S - sex
- +7 ; * - wildcard matches anything.
- +8 NEW LEN
- +9 SET LEN=$LENGTH(X)
- +10 IF (LEN>8)!(LEN<1)
- QUIT 0
- +11 ;
- +12 NEW TEMP,TEXT
- +13 SET TEMP=X
- +14 SET TEMP=$TRANSLATE(TEMP,"A","")
- +15 SET TEMP=$TRANSLATE(TEMP,"I","")
- +16 SET TEMP=$TRANSLATE(TEMP,"R","")
- +17 SET TEMP=$TRANSLATE(TEMP,"S","")
- +18 SET TEMP=$TRANSLATE(TEMP,"*","")
- +19 ;At this point TEMP should be NULL,if it is not then there are
- +20 ;bad codes.
- +21 SET LEN=$LENGTH(TEMP)
- +22 IF LEN=1
- Begin DoDot:1
- +23 SET TEXT=TEMP_" is not a valid IGNORE ON N/A code!"
- +24 DO EN^DDIOL(TEXT)
- +25 IF '$DATA(DIQUIET)
- HANG 2
- End DoDot:1
- QUIT 0
- +26 IF LEN>1
- Begin DoDot:1
- +27 SET TEXT=TEMP_" are not valid IGNORE ON N/A codes!"
- +28 DO EN^DDIOL(TEXT)
- +29 IF '$DATA(DIQUIET)
- HANG 2
- End DoDot:1
- QUIT 0
- +30 QUIT 1
- +31 ;
- +32 ;=======================================================
- VLAB(X) ;Check for valid lab findings. Everything but a panel is ok.
- +1 IF X'["LAB(60"
- QUIT 1
- +2 NEW DATANAME,LAB0,LABTEST,SUB,TEST,TEXT
- +3 SET LABTEST=$PIECE(X,";",1)
- +4 ;DBIA #91-A
- +5 SET LAB0=^LAB(60,LABTEST,0)
- +6 SET SUB=$PIECE(LAB0,U,4)
- +7 ;BB and WK not allowed
- +8 IF (SUB="BB")!(SUB="WK")
- Begin DoDot:1
- +9 SET TEXT=SUB_" tests cannot be used as reminder findings."
- +10 DO EN^DDIOL(.TEXT)
- +11 IF '$DATA(DIQUIET)
- HANG 2
- End DoDot:1
- QUIT 0
- +12 ;The concept of lab panel only applies to CH tests.
- +13 IF SUB'["CH"
- QUIT 1
- +14 SET DATANAME=$PIECE(LAB0,U,5)
- +15 ;If DATA NAME is null then it is a panel.
- +16 IF DATANAME=""
- Begin DoDot:1
- +17 SET TEXT(1)=$PIECE(LAB0,U,1)_" is a lab panel, it cannot be used as a reminder finding!"
- +18 SET TEXT(2)="Contact your Lab ADPAC for help"
- +19 DO EN^DDIOL(.TEXT)
- +20 IF '$DATA(DIQUIET)
- HANG 2
- End DoDot:1
- QUIT 0
- +21 QUIT 1
- +22 ;
- +23 ;=======================================================
- VNAME(NAME) ;Check for a valid .01 value. The names of national reminder
- +1 ;components start with "VA-" and normal users are not allowed to
- +2 ;create them.
- +3 ;Do not execute as part of a verify fields.
- +4 IF $GET(DIUTIL)="VERIFY FIELDS"
- QUIT 1
- +5 ;Do not execute as part of exchange.
- +6 IF $GET(PXRMEXCH)
- QUIT 1
- +7 NEW AUTH,CHAR,LEN,STEXT,TEXT,VALID
- +8 SET NAME=$$UP^XLFSTR(NAME)
- +9 SET VALID=1
- +10 IF NAME["~"
- Begin DoDot:1
- +11 SET TEXT="Name cannot contain the ""~"" character."
- +12 DO EN^DDIOL(TEXT)
- +13 IF '$DATA(DIQUIET)
- HANG 2
- +14 SET VALID=0
- End DoDot:1
- +15 SET STEXT=$EXTRACT(NAME,1,3)
- +16 IF (STEXT="VA-")
- Begin DoDot:1
- +17 SET AUTH=($GET(PXRMINST)=1)&(DUZ(0)="@")
- +18 IF 'AUTH
- Begin DoDot:2
- +19 SET TEXT="Name cannot start with ""VA-"", reserved for national reminder components!"
- +20 DO EN^DDIOL(TEXT)
- +21 IF '$DATA(DIQUIET)
- HANG 2
- +22 SET VALID=0
- End DoDot:2
- End DoDot:1
- +23 SET LEN=$LENGTH(NAME)
- SET CHAR=$EXTRACT(NAME,LEN)
- +24 IF $ASCII(CHAR)<33
- Begin DoDot:1
- +25 SET TEXT="Name cannot have trailing non-printing characters."
- +26 DO EN^DDIOL(TEXT)
- +27 IF '$DATA(DIQUIET)
- HANG 2
- +28 SET VALID=0
- End DoDot:1
- +29 QUIT VALID
- +30 ;
- +31 ;=======================================================
- VPRIOL(X) ;Check for a valid Priority List.
- +1 ;Do not execute as part of a verify fields.
- +2 IF $LENGTH(X)=0
- QUIT 1
- +3 IF $GET(DIUTIL)="VERIFY FIELDS"
- QUIT 1
- +4 ;Do not execute as part of exchange.
- +5 IF $GET(PXRMEXCH)
- QUIT 1
- +6 NEW IND,CHAR,TEXT,VALID
- +7 SET X=$$UP^XLFSTR(X)
- +8 SET VALID=1
- +9 FOR IND=1:1:$LENGTH(X)
- Begin DoDot:1
- +10 SET CHAR=$EXTRACT(X,IND)
- +11 IF CHAR?0.1"A"0.1"C"0.1"U"
- QUIT
- +12 SET VALID=0
- +13 SET TEXT=CHAR_" is not valid for the Priority List"
- +14 DO EN^DDIOL(TEXT)
- +15 IF '$DATA(DIQUIET)
- HANG 2
- End DoDot:1
- +16 QUIT VALID
- +17 ;
- +18 ;=======================================================
- +1 ;If there is no sponsor don't do the check.
- +2 IF X=""
- QUIT 1
- +3 ;Do not execute as part of a verify fields.
- +4 IF $GET(DIUTIL)="VERIFY FIELDS"
- QUIT 1
- +5 ;Do not execute as part of exchange.
- +6 IF $GET(PXRMEXCH)
- QUIT 1
- +7 NEW FCLASS,FILENUM,SCLASS,TEXT,VALID
- +8 SET VALID=1
- +9 IF $GET(X)=""
- QUIT VALID
- +10 IF $GET(DIC)=""
- QUIT 0
- +11 SET FILENUM=+$PIECE(@(DIC_"0)"),U,2)
- +12 SET FCLASS=$PIECE(@(DIC_DA_",100)"),U,1)
- +13 SET SCLASS=$PIECE(^PXRMD(811.6,X,100),U,1)
- +14 IF SCLASS'=FCLASS
- Begin DoDot:1
- +15 SET FCLASS=$$EXTERNAL^DILFD(FILENUM,100,"",FCLASS)
- +16 SET SCLASS=$$EXTERNAL^DILFD(811.6,100,"",SCLASS)
- +17 SET TEXT="Sponsor Class is "_SCLASS_", File Class is "_FCLASS_" they must match!"
- +18 DO EN^DDIOL(TEXT)
- +19 IF '$DATA(DIQUIET)
- HANG 2
- +20 SET VALID=0
- End DoDot:1
- +21 QUIT VALID
- +22 ;
- +23 ;=======================================================
- VTAX(X) ;Make sure the taxonomy is active.
- +1 NEW IEN,INACTIVE
- +2 SET IEN=$PIECE(X,";",1)
- +3 SET INACTIVE=$PIECE(^PXD(811.2,IEN,0),U,6)
- +4 IF INACTIVE
- Begin DoDot:1
- +5 DO EN^DDIOL("This taxonomy is inactive and cannot be selected.")
- +6 IF '$DATA(DIQUIET)
- HANG 2
- End DoDot:1
- QUIT 0
- +7 QUIT 1
- +8 ;
- +9 ;=======================================================
- VUSAGE(X) ;Check X to see if it contains valid USAGE codes.
- +1 ;This is part of the input transform for this field. The length of the
- +2 ;USAGE field is 10 characters. The valid codes are:
- +3 ; A - Action
- +4 ; C - CPRS
- +5 ; L - Reminder Patient List
- +6 ; O - Reminder Order Checks
- +7 ; P - Patient
- +8 ; R - Reports
- +9 ; X - Extracts
- +10 ; * - Wildcard matches anything, except P.
- +11 NEW LEN
- +12 SET LEN=$LENGTH(X)
- +13 IF (LEN>10)!(LEN<1)
- QUIT 0
- +14 ;
- +15 NEW TEMP,TEXT
- +16 SET TEMP=$$UP^XLFSTR(X)
- +17 SET TEMP=$TRANSLATE(TEMP,"A","")
- +18 SET TEMP=$TRANSLATE(TEMP,"C","")
- +19 SET TEMP=$TRANSLATE(TEMP,"L","")
- +20 SET TEMP=$TRANSLATE(TEMP,"O","")
- +21 SET TEMP=$TRANSLATE(TEMP,"P","")
- +22 SET TEMP=$TRANSLATE(TEMP,"R","")
- +23 SET TEMP=$TRANSLATE(TEMP,"X","")
- +24 SET TEMP=$TRANSLATE(TEMP,"*","")
- +25 ;At this point TEMP should be NULL,if it is not then there are
- +26 ;bad codes.
- +27 SET LEN=$LENGTH(TEMP)
- +28 IF LEN=1
- Begin DoDot:1
- +29 SET TEXT=TEMP_" is not a valid USAGE code!"
- +30 DO EN^DDIOL(TEXT)
- +31 IF '$DATA(DIQUIET)
- HANG 2
- End DoDot:1
- QUIT 0
- +32 IF LEN>1
- Begin DoDot:1
- +33 SET TEXT=TEMP_" are not valid USAGE codes!"
- +34 DO EN^DDIOL(TEXT)
- +35 IF '$DATA(DIQUIET)
- HANG 2
- End DoDot:1
- QUIT 0
- +36 QUIT 1
- +37 ;