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

PXINPTR.m

Go to the documentation of this file.
  1. PXINPTR ;SLC/PKR - Input transforms for some PCE files. ;03/16/2022
  1. ;;1.0;PCE PATIENT CARE ENCOUNTER;**211,217**;Aug 12, 1996;Build 134
  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(PXNAT)'=1) D Q 0
  1. . D EN^DDIOL("You are not allowed to create a NATIONAL class")
  1. E Q 1
  1. ;
  1. ;=========================================
  1. VCODE(FILENUM,DA,CODE) ;Check for a valid coding system, code pair.
  1. N CODESYS,VALID
  1. S CODESYS=$$GET^DDSVAL(FILENUM,.DA,"CODING SYSTEM")
  1. I CODESYS="" D Q 0
  1. . D EN^DDIOL("A coding system has not been specified.")
  1. . H 3
  1. I CODESYS'="BIR" S CODE=$$UP^XLFSTR(CODE)
  1. S VALID=$$VCODE^PXLEX(CODESYS,CODE)
  1. I 'VALID D EN^DDIOL(CODE_" is not a valid "_CODESYS_" code.")
  1. Q VALID
  1. ;
  1. ;=========================================
  1. VCODESYS(CODESYS) ;Check for a valid coding system.
  1. S CODESYS=$$UP^XLFSTR(CODESYS)
  1. Q $$VCODESYS^PXLEX(CODESYS,1)
  1. ;
  1. ;=========================================
  1. VMAGNITUDE(MAG) ;Check for a valid magnitude, a positive or negative number,
  1. ;up to 14 digits and 9 decimal places.
  1. I MAG'?0.1(0.1"-",0.1"+")0.14N0.1(1"."0.9N) Q 0
  1. S MAG=$$MAGFORMAT^PXMEASUREMENT(MAG)
  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 F3C,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. . H 2
  1. . S VALID=0
  1. S F3C=$E(NAME,1,3)
  1. I (F3C="VA-"),'$G(PXNAT) D
  1. . S TEXT="Name cannot start with ""VA-"", reserved for national PCE components!"
  1. . D EN^DDIOL(TEXT)
  1. . H 2
  1. . S VALID=0
  1. Q VALID
  1. ;
  1. ;=========================================
  1. VSPONSOR(FILENUM,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 ERROR,FCLASS,FNAME,SCLASS,TEXT,VALID
  1. S VALID=1
  1. I $G(X)="" Q VALID
  1. ;If +DA=0 a new entry is being added.
  1. I +DA=0 Q VALID
  1. S FCLASS=$S($D(DDS):$$GET^DDSVAL(FILENUM,DA,100,.ERROR,"E"),1:$$GET1^DIQ(FILENUM,DA,100))
  1. S SCLASS=$$GET1^DIQ(811.6,X,100)
  1. I SCLASS'=FCLASS D
  1. . S FNAME=$$GET1^DID(FILENUM,"","","NAME")
  1. . S TEXT="Sponsor Class is "_SCLASS_", "_FNAME_" Class is "_FCLASS_" they must match!"
  1. . D EN^DDIOL(TEXT)
  1. . S VALID=0
  1. Q VALID
  1. ;