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

PXRMINTR.m

Go to the documentation of this file.
  1. 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
  1. ;References ICR#
  1. ;^AUTTHF 3083
  1. ;^LAB(60,LABTEST,0) 91
  1. ;
  1. ;=======================================================
  1. VASP(DA,X) ;Check for valid associate sponsor in file 811.6.
  1. ;Do not execute as part of a verify fields.
  1. I $G(DIUTIL)="VERIFY FIELDS" Q 1
  1. ;Do not execute as part of exchange.
  1. I $G(PXRMEXCH) Q 1
  1. ;Make sure that an associated sponsor does not point to itself.
  1. I X=DA D Q 0
  1. . D EN^DDIOL("An associated sponsor cannot point to itself.")
  1. . I '$D(DIQUIET) H 2
  1. ;A sponsor cannot be an associated sponsor if it contains associated
  1. ;sponsors.
  1. I $D(^PXRMD(811.6,X,2,"B")) D Q 0
  1. . D EN^DDIOL("A sponsor cannot be selected as an associated sponsor if it contains associated sponsors.")
  1. . I '$D(DIQUIET) H 2
  1. ;The class of an associated sponsor must match that of the sponsor.
  1. N ASCLASS,SCLASS
  1. S SCLASS=$P(^PXRMD(811.6,DA,0),U,2)
  1. S ASCLASS=$P(^PXRMD(811.6,X,0),U,2)
  1. I ASCLASS'=SCLASS D Q 0
  1. . N TEXT
  1. . S TEXT="The associated sponsor's class is "_ASCLASS_", it does not match the sponsor's class which is "_SCLASS_". They must match."
  1. . D EN^DDIOL(TEXT)
  1. . I '$D(DIQUIET) H 2
  1. Q 1
  1. ;
  1. ;=======================================================
  1. VCLASS(X) ;Check for valid CLASS field, ordinary users cannot create
  1. ;National classes.
  1. ;Do not execute as part of a verify fields.
  1. I $G(DIUTIL)="VERIFY FIELDS" Q 1
  1. ;Do not execute as part of exchange.
  1. I $G(PXRMEXCH) Q 1
  1. I (X["N"),(($G(PXRMINST)'=1)!(DUZ(0)'="@")) D Q 0
  1. . D EN^DDIOL("You are not allowed to create a NATIONAL class")
  1. . I '$D(DIQUIET) H 2
  1. E Q 1
  1. ;
  1. ;=======================================================
  1. VDT(X) ;Check for a valid date/time. Input transform on
  1. ;beginning date/time and ending date/time fields.
  1. N FMDATE,PXRMINTR,VALID
  1. S PXRMINTR=1
  1. ;If X is already in internal FileMan format make sure it is valid.
  1. I X?7N0.1"."0.6N D DT^DILF("ST",X,.FMDATE,"","MSG")
  1. I X'?7N0.1"."0.6N S FMDATE=$$CTFMD^PXRMDATE(X)
  1. S VALID=$S(FMDATE=-1:0,1:1)
  1. I 'VALID D
  1. . N TEXT
  1. . S TEXT=X_" is not a valid date/time"
  1. . D EN^DDIOL(TEXT)
  1. . I '$D(DIQUIET) H 2
  1. Q VALID
  1. ;
  1. ;=======================================================
  1. 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
  1. ;definitions and terms.
  1. ;Include stubs for all possible finding types in case we need input
  1. ;transforms on them.
  1. ;I X["AUTTEDT(" Q 1
  1. ;I X["AUTTEXAM(" Q 1
  1. I X["AUTTHF(" Q $$VHF(X)
  1. ;I X["AUTTIMM(" Q 1
  1. ;I X["AUTTSK(" Q 1
  1. ;I X["GMRD(120.51," Q 1
  1. I X["LAB(60," Q $$VLAB(X)
  1. ;I X["ORD(101.43," Q 1
  1. I X["PXD(811.2," Q $$VTAX(X)
  1. ;I X["PXRMD(811.4," Q 1
  1. ;I X["PXRMD(811.5," Q 1
  1. ;I X["PS(50.605," Q 1
  1. ;I X["PSDRUG(" Q 1
  1. ;I X["PSNDF(50.6," Q 1
  1. ;I X["RAMIS(71," Q 1
  1. ;I X["YTT(601," Q 1
  1. Q 1
  1. ;
  1. ;=======================================================
  1. 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
  1. ;0 and 9999 inclusive. Valid units are: H (hours),
  1. ;D (days), W (weeks), M (months), and Y (years). Used as input
  1. ;transform for Baseline Frequency, finding multiple Reminder
  1. ;Frequency and called by Custom Date Due input transform.
  1. S X=$$UP^XLFSTR(X)
  1. Q X?1.4N1(1"H",1"D",1"W",1"M",1"Y")
  1. ;
  1. ;=======================================================
  1. VHF(X) ;Check for valid health factor findings. It must be a factor, not
  1. ;a category.
  1. N CAT,IEN,TEMP,TYPE
  1. S IEN=$P(X,";",1)
  1. S TEMP=$G(^AUTTHF(IEN,0))
  1. S TYPE=$P(TEMP,U,10)
  1. I TYPE="C" D Q 0
  1. . D EN^DDIOL("Category health factors cannot be used as a finding!")
  1. . I '$D(DIQUIET) H 2
  1. I TYPE'="F" D Q 0
  1. . D EN^DDIOL("Only factor health factors can be used as a finding!")
  1. . I '$D(DIQUIET) H 2
  1. ;Make sure that the health factor has a category.
  1. S CAT=$P(TEMP,U,3)
  1. I CAT="" D Q 0
  1. . D EN^DDIOL("Factor health factors must have a category!")
  1. . I '$D(DIQUIET) H 2
  1. I '$D(^AUTTHF(CAT)) D Q 0
  1. . D EN^DDIOL("The category for this health factor does not exist!")
  1. . I '$D(DIQUIET) H 2
  1. Q 1
  1. ;
  1. ;=======================================================
  1. 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
  1. ;IGNORE ON N/A field is 8 characters. The valid codes are:
  1. ; A - age
  1. ; I - inactive
  1. ; R - race
  1. ; S - sex
  1. ; * - wildcard matches anything.
  1. N LEN
  1. S LEN=$L(X)
  1. I (LEN>8)!(LEN<1) Q 0
  1. ;
  1. N TEMP,TEXT
  1. S TEMP=X
  1. S TEMP=$TR(TEMP,"A","")
  1. S TEMP=$TR(TEMP,"I","")
  1. S TEMP=$TR(TEMP,"R","")
  1. S TEMP=$TR(TEMP,"S","")
  1. S TEMP=$TR(TEMP,"*","")
  1. ;At this point TEMP should be NULL,if it is not then there are
  1. ;bad codes.
  1. S LEN=$L(TEMP)
  1. I LEN=1 D Q 0
  1. . S TEXT=TEMP_" is not a valid IGNORE ON N/A code!"
  1. . D EN^DDIOL(TEXT)
  1. . I '$D(DIQUIET) H 2
  1. I LEN>1 D Q 0
  1. . S TEXT=TEMP_" are not valid IGNORE ON N/A codes!"
  1. . D EN^DDIOL(TEXT)
  1. . I '$D(DIQUIET) H 2
  1. Q 1
  1. ;
  1. ;=======================================================
  1. VLAB(X) ;Check for valid lab findings. Everything but a panel is ok.
  1. I X'["LAB(60" Q 1
  1. N DATANAME,LAB0,LABTEST,SUB,TEST,TEXT
  1. S LABTEST=$P(X,";",1)
  1. ;DBIA #91-A
  1. S LAB0=^LAB(60,LABTEST,0)
  1. S SUB=$P(LAB0,U,4)
  1. ;BB and WK not allowed
  1. I (SUB="BB")!(SUB="WK") D Q 0
  1. . S TEXT=SUB_" tests cannot be used as reminder findings."
  1. . D EN^DDIOL(.TEXT)
  1. . I '$D(DIQUIET) H 2
  1. ;The concept of lab panel only applies to CH tests.
  1. I SUB'["CH" Q 1
  1. S DATANAME=$P(LAB0,U,5)
  1. ;If DATA NAME is null then it is a panel.
  1. I DATANAME="" D Q 0
  1. . S TEXT(1)=$P(LAB0,U,1)_" is a lab panel, it cannot be used as a reminder finding!"
  1. . S TEXT(2)="Contact your Lab ADPAC for help"
  1. . D EN^DDIOL(.TEXT)
  1. . I '$D(DIQUIET) H 2
  1. Q 1
  1. ;
  1. ;=======================================================
  1. 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
  1. ;create them.
  1. ;Do not execute as part of a verify fields.
  1. I $G(DIUTIL)="VERIFY FIELDS" Q 1
  1. ;Do not execute as part of exchange.
  1. I $G(PXRMEXCH) Q 1
  1. N AUTH,CHAR,LEN,STEXT,TEXT,VALID
  1. S NAME=$$UP^XLFSTR(NAME)
  1. S VALID=1
  1. I NAME["~" D
  1. . S TEXT="Name cannot contain the ""~"" character."
  1. . D EN^DDIOL(TEXT)
  1. . I '$D(DIQUIET) H 2
  1. . S VALID=0
  1. S STEXT=$E(NAME,1,3)
  1. I (STEXT="VA-") D
  1. . S AUTH=($G(PXRMINST)=1)&(DUZ(0)="@")
  1. . I 'AUTH D
  1. .. S TEXT="Name cannot start with ""VA-"", reserved for national reminder components!"
  1. .. D EN^DDIOL(TEXT)
  1. .. I '$D(DIQUIET) H 2
  1. .. S VALID=0
  1. S LEN=$L(NAME),CHAR=$E(NAME,LEN)
  1. I $A(CHAR)<33 D
  1. . S TEXT="Name cannot have trailing non-printing characters."
  1. . D EN^DDIOL(TEXT)
  1. . I '$D(DIQUIET) H 2
  1. . S VALID=0
  1. Q VALID
  1. ;
  1. ;=======================================================
  1. VPRIOL(X) ;Check for a valid Priority List.
  1. ;Do not execute as part of a verify fields.
  1. I $L(X)=0 Q 1
  1. I $G(DIUTIL)="VERIFY FIELDS" Q 1
  1. ;Do not execute as part of exchange.
  1. I $G(PXRMEXCH) Q 1
  1. N IND,CHAR,TEXT,VALID
  1. S X=$$UP^XLFSTR(X)
  1. S VALID=1
  1. F IND=1:1:$L(X) D
  1. . S CHAR=$E(X,IND)
  1. . I CHAR?0.1"A"0.1"C"0.1"U" Q
  1. . S VALID=0
  1. . S TEXT=CHAR_" is not valid for the Priority List"
  1. . D EN^DDIOL(TEXT)
  1. . I '$D(DIQUIET) H 2
  1. Q VALID
  1. ;
  1. ;=======================================================
  1. VSPONSOR(X) ;Make sure file Class and Sponsor Class match.
  1. ;If there is no sponsor don't do the check.
  1. I X="" Q 1
  1. ;Do not execute as part of a verify fields.
  1. I $G(DIUTIL)="VERIFY FIELDS" Q 1
  1. ;Do not execute as part of exchange.
  1. I $G(PXRMEXCH) Q 1
  1. N FCLASS,FILENUM,SCLASS,TEXT,VALID
  1. S VALID=1
  1. I $G(X)="" Q VALID
  1. I $G(DIC)="" Q 0
  1. S FILENUM=+$P(@(DIC_"0)"),U,2)
  1. S FCLASS=$P(@(DIC_DA_",100)"),U,1)
  1. S SCLASS=$P(^PXRMD(811.6,X,100),U,1)
  1. I SCLASS'=FCLASS D
  1. . S FCLASS=$$EXTERNAL^DILFD(FILENUM,100,"",FCLASS)
  1. . S SCLASS=$$EXTERNAL^DILFD(811.6,100,"",SCLASS)
  1. . S TEXT="Sponsor Class is "_SCLASS_", File Class is "_FCLASS_" they must match!"
  1. . D EN^DDIOL(TEXT)
  1. . I '$D(DIQUIET) H 2
  1. . S VALID=0
  1. Q VALID
  1. ;
  1. ;=======================================================
  1. VTAX(X) ;Make sure the taxonomy is active.
  1. N IEN,INACTIVE
  1. S IEN=$P(X,";",1)
  1. S INACTIVE=$P(^PXD(811.2,IEN,0),U,6)
  1. I INACTIVE D Q 0
  1. . D EN^DDIOL("This taxonomy is inactive and cannot be selected.")
  1. . I '$D(DIQUIET) H 2
  1. Q 1
  1. ;
  1. ;=======================================================
  1. 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
  1. ;USAGE field is 10 characters. The valid codes are:
  1. ; A - Action
  1. ; C - CPRS
  1. ; L - Reminder Patient List
  1. ; O - Reminder Order Checks
  1. ; P - Patient
  1. ; R - Reports
  1. ; X - Extracts
  1. ; * - Wildcard matches anything, except P.
  1. N LEN
  1. S LEN=$L(X)
  1. I (LEN>10)!(LEN<1) Q 0
  1. ;
  1. N TEMP,TEXT
  1. S TEMP=$$UP^XLFSTR(X)
  1. S TEMP=$TR(TEMP,"A","")
  1. S TEMP=$TR(TEMP,"C","")
  1. S TEMP=$TR(TEMP,"L","")
  1. S TEMP=$TR(TEMP,"O","")
  1. S TEMP=$TR(TEMP,"P","")
  1. S TEMP=$TR(TEMP,"R","")
  1. S TEMP=$TR(TEMP,"X","")
  1. S TEMP=$TR(TEMP,"*","")
  1. ;At this point TEMP should be NULL,if it is not then there are
  1. ;bad codes.
  1. S LEN=$L(TEMP)
  1. I LEN=1 D Q 0
  1. . S TEXT=TEMP_" is not a valid USAGE code!"
  1. . D EN^DDIOL(TEXT)
  1. . I '$D(DIQUIET) H 2
  1. I LEN>1 D Q 0
  1. . S TEXT=TEMP_" are not valid USAGE codes!"
  1. . D EN^DDIOL(TEXT)
  1. . I '$D(DIQUIET) H 2
  1. Q 1
  1. ;