- PXINPTR ;SLC/PKR - Input transforms for some PCE files. ;03/16/2022
- ;;1.0;PCE PATIENT CARE ENCOUNTER;**211,217**;Aug 12, 1996;Build 134
- ;=========================================
- 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(PXNAT)'=1) D Q 0
- . D EN^DDIOL("You are not allowed to create a NATIONAL class")
- E Q 1
- ;
- ;=========================================
- VCODE(FILENUM,DA,CODE) ;Check for a valid coding system, code pair.
- N CODESYS,VALID
- S CODESYS=$$GET^DDSVAL(FILENUM,.DA,"CODING SYSTEM")
- I CODESYS="" D Q 0
- . D EN^DDIOL("A coding system has not been specified.")
- . H 3
- I CODESYS'="BIR" S CODE=$$UP^XLFSTR(CODE)
- S VALID=$$VCODE^PXLEX(CODESYS,CODE)
- I 'VALID D EN^DDIOL(CODE_" is not a valid "_CODESYS_" code.")
- Q VALID
- ;
- ;=========================================
- VCODESYS(CODESYS) ;Check for a valid coding system.
- S CODESYS=$$UP^XLFSTR(CODESYS)
- Q $$VCODESYS^PXLEX(CODESYS,1)
- ;
- ;=========================================
- VMAGNITUDE(MAG) ;Check for a valid magnitude, a positive or negative number,
- ;up to 14 digits and 9 decimal places.
- I MAG'?0.1(0.1"-",0.1"+")0.14N0.1(1"."0.9N) Q 0
- S MAG=$$MAGFORMAT^PXMEASUREMENT(MAG)
- 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 F3C,TEXT,VALID
- S NAME=$$UP^XLFSTR(NAME)
- S VALID=1
- I NAME["~" D
- . S TEXT="Name cannot contain the ""~"" character."
- . D EN^DDIOL(TEXT)
- . H 2
- . S VALID=0
- S F3C=$E(NAME,1,3)
- I (F3C="VA-"),'$G(PXNAT) D
- . S TEXT="Name cannot start with ""VA-"", reserved for national PCE components!"
- . D EN^DDIOL(TEXT)
- . H 2
- . S VALID=0
- 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 ERROR,FCLASS,FNAME,SCLASS,TEXT,VALID
- S VALID=1
- I $G(X)="" Q VALID
- ;If +DA=0 a new entry is being added.
- I +DA=0 Q VALID
- S FCLASS=$S($D(DDS):$$GET^DDSVAL(FILENUM,DA,100,.ERROR,"E"),1:$$GET1^DIQ(FILENUM,DA,100))
- S SCLASS=$$GET1^DIQ(811.6,X,100)
- I SCLASS'=FCLASS D
- . S FNAME=$$GET1^DID(FILENUM,"","","NAME")
- . S TEXT="Sponsor Class is "_SCLASS_", "_FNAME_" Class is "_FCLASS_" they must match!"
- . D EN^DDIOL(TEXT)
- . S VALID=0
- Q VALID
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXINPTR 2871 printed Feb 18, 2025@23:55:19 Page 2
- 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
- +2 ;=========================================
- 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(PXNAT)'=1)
- Begin DoDot:1
- +7 DO EN^DDIOL("You are not allowed to create a NATIONAL class")
- End DoDot:1
- QUIT 0
- +8 IF '$TEST
- QUIT 1
- +9 ;
- +10 ;=========================================
- VCODE(FILENUM,DA,CODE) ;Check for a valid coding system, code pair.
- +1 NEW CODESYS,VALID
- +2 SET CODESYS=$$GET^DDSVAL(FILENUM,.DA,"CODING SYSTEM")
- +3 IF CODESYS=""
- Begin DoDot:1
- +4 DO EN^DDIOL("A coding system has not been specified.")
- +5 HANG 3
- End DoDot:1
- QUIT 0
- +6 IF CODESYS'="BIR"
- SET CODE=$$UP^XLFSTR(CODE)
- +7 SET VALID=$$VCODE^PXLEX(CODESYS,CODE)
- +8 IF 'VALID
- DO EN^DDIOL(CODE_" is not a valid "_CODESYS_" code.")
- +9 QUIT VALID
- +10 ;
- +11 ;=========================================
- VCODESYS(CODESYS) ;Check for a valid coding system.
- +1 SET CODESYS=$$UP^XLFSTR(CODESYS)
- +2 QUIT $$VCODESYS^PXLEX(CODESYS,1)
- +3 ;
- +4 ;=========================================
- VMAGNITUDE(MAG) ;Check for a valid magnitude, a positive or negative number,
- +1 ;up to 14 digits and 9 decimal places.
- +2 IF MAG'?0.1(0.1"-",0.1"+")0.14N0.1(1"."0.9N)
- QUIT 0
- +3 SET MAG=$$MAGFORMAT^PXMEASUREMENT(MAG)
- +4 QUIT 1
- +5 ;
- +6 ;=========================================
- 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 F3C,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 HANG 2
- +14 SET VALID=0
- End DoDot:1
- +15 SET F3C=$EXTRACT(NAME,1,3)
- +16 IF (F3C="VA-")
- IF '$GET(PXNAT)
- Begin DoDot:1
- +17 SET TEXT="Name cannot start with ""VA-"", reserved for national PCE components!"
- +18 DO EN^DDIOL(TEXT)
- +19 HANG 2
- +20 SET VALID=0
- End DoDot:1
- +21 QUIT VALID
- +22 ;
- +23 ;=========================================
- +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 ERROR,FCLASS,FNAME,SCLASS,TEXT,VALID
- +8 SET VALID=1
- +9 IF $GET(X)=""
- QUIT VALID
- +10 ;If +DA=0 a new entry is being added.
- +11 IF +DA=0
- QUIT VALID
- +12 SET FCLASS=$SELECT($DATA(DDS):$$GET^DDSVAL(FILENUM,DA,100,.ERROR,"E"),1:$$GET1^DIQ(FILENUM,DA,100))
- +13 SET SCLASS=$$GET1^DIQ(811.6,X,100)
- +14 IF SCLASS'=FCLASS
- Begin DoDot:1
- +15 SET FNAME=$$GET1^DID(FILENUM,"","","NAME")
- +16 SET TEXT="Sponsor Class is "_SCLASS_", "_FNAME_" Class is "_FCLASS_" they must match!"
- +17 DO EN^DDIOL(TEXT)
- +18 SET VALID=0
- End DoDot:1
- +19 QUIT VALID
- +20 ;