ORBINPTR ;SLC/TC - Input transforms for OE/RR Notifications ;10/30/12 08:02
;;3.0;ORDER ENTRY/RESULTS REPORTING;**348**;Dec 17, 1997;Build 14
;
;
VALNUM(X) ; Called by input transform of ^DD(100.9,.001,0), Number field
N VALID,LSTREC S VALID=1,LSTREC=$P($G(^ORD(100.9,0)),U,3)
I $G(DIUTIL)="VERIFY FIELDS" Q VALID
I DUZ(0)'="@" S VALID=0 Q VALID ; No access to create notifications
I X<10101 S VALID=0 Q VALID ;Numbers 1-9999 are reserved for National notifications
I $L(X)=5 D
. N LSTNUM,EXPNUM
. S LSTNUM=$S($L(LSTREC)=5&($E(LSTREC,1,3)=+$$SITE^VASITE):$E(LSTREC,4,5),1:"")
. S EXPNUM=$S('$L(LSTNUM):(+$$SITE^VASITE)_"01",1:(LSTREC+1))
. I ($E(X,1,3)'=(+$$SITE^VASITE))&($E(X,4,5)'=(LSTNUM+1)) D
. . S VALID=0 D EN^DDIOL("Invalid number scheme. Expecting number "_EXPNUM_".")
Q VALID
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORBINPTR 819 printed Nov 22, 2024@17:37:38 Page 2
ORBINPTR ;SLC/TC - Input transforms for OE/RR Notifications ;10/30/12 08:02
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**348**;Dec 17, 1997;Build 14
+2 ;
+3 ;
VALNUM(X) ; Called by input transform of ^DD(100.9,.001,0), Number field
+1 NEW VALID,LSTREC
SET VALID=1
SET LSTREC=$PIECE($GET(^ORD(100.9,0)),U,3)
+2 IF $GET(DIUTIL)="VERIFY FIELDS"
QUIT VALID
+3 ; No access to create notifications
IF DUZ(0)'="@"
SET VALID=0
QUIT VALID
+4 ;Numbers 1-9999 are reserved for National notifications
IF X<10101
SET VALID=0
QUIT VALID
+5 IF $LENGTH(X)=5
Begin DoDot:1
+6 NEW LSTNUM,EXPNUM
+7 SET LSTNUM=$SELECT($LENGTH(LSTREC)=5&($EXTRACT(LSTREC,1,3)=+$$SITE^VASITE):$E(LSTREC,4,5),1:"")
+8 SET EXPNUM=$SELECT('$LENGTH(LSTNUM):(+$$SITE^VASITE)_"01",1:(LSTREC+1))
+9 IF ($EXTRACT(X,1,3)'=(+$$SITE^VASITE))&($EXTRACT(X,4,5)'=(LSTNUM+1))
Begin DoDot:2
+10 SET VALID=0
DO EN^DDIOL("Invalid number scheme. Expecting number "_EXPNUM_".")
End DoDot:2
End DoDot:1
+11 QUIT VALID
