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 Dec 13, 2024@02:29:02 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 ;
