SDES2VAL44A ;ALB/BWF/MGD,TJB - SDES2 Clinic validation utilities ;OCT 18, 2024
;;5.3;Scheduling;**853,857,869,878,893**;Aug 13, 1993;Build 6
;;Per VHA Directive 6402, this routine should not be modified
;
; Reference to $$CODEC^ICDEX in ICR-5747
; Reference to $$STATCHK^ICDEX in ICR-5747
Q
;
VALPROVIDERS(ERRORS,SDCLINIC,FDATA,CLINICIEN) ;
N PROVIEN,PROVERRORS,DEFCNT
S (PROVIEN,DEFCNT)=0 F S PROVIEN=$O(SDCLINIC("PROVIDER",PROVIEN)) Q:'PROVIEN D
.I $G(CLINICIEN),$D(^SC(CLINICIEN,"PR","B",PROVIEN)),$G(SDCLINIC("PROVIDER",PROVIEN))="@" Q
.D VALPROVIDER^SDES2VAL200(.ERRORS,PROVIEN)
.I $D(SDCLINIC("PROVIDER",PROVIEN,"DEFAULT")) S DEFCNT=DEFCNT+1
I DEFCNT>1 D ERRLOG^SDES2JSON(.ERRORS,488) Q
M FDATA("PROVIDER")=SDCLINIC("PROVIDER")
Q
VALDIAG(ERRORS,SDCLINIC,FDATA,CLINICIEN) ;
N DIAGCODE,DIAGIEN,DEFDIAGCNT,NEWDIAGIEN,DIAGSTAT
S DEFDIAGCNT=0
S DIAGCODE="" F S DIAGCODE=$O(SDCLINIC("DIAGNOSIS",DIAGCODE)) Q:DIAGCODE="" D
.S DIAGIEN=$$CODEN^ICDEX(DIAGCODE,80)
.I +DIAGIEN=-1 D ERRLOG^SDES2JSON(.ERRORS,85,DIAGCODE) Q
.I $G(CLINICIEN),$D(^SC(CLINICIEN,"DX","B",+DIAGIEN)),$G(SDCLINIC("DIAGNOSIS",DIAGCODE))="@" Q
.S DIAGSTAT=+$$STATCHK^ICDEX(DIAGCODE)
.I 'DIAGSTAT D ERRLOG^SDES2JSON(.ERRORS,363,DIAGCODE) Q
.I $D(SDCLINIC("DIAGNOSIS",DIAGCODE,"DEFAULT")) S DEFDIAGCNT=DEFDIAGCNT+1
I DEFDIAGCNT>1 D ERRLOG^SDES2JSON(.ERRORS,490) Q
M FDATA("DIAGNOSIS")=SDCLINIC("DIAGNOSIS")
Q
VALSPECINSTRUCT(ERRORS,SPECINST,FDATA,SDIEN) ;
N INSTRUCT,INSDATA,INSIEN,INSTEXT
S INSTRUCT=0 F S INSTRUCT=$O(SPECINST("SPECIAL INSTRUCTIONS",INSTRUCT)) Q:'INSTRUCT D
.S INSDATA=$G(SPECINST("SPECIAL INSTRUCTIONS",INSTRUCT))
.S INSIEN=$P(INSDATA,"|")
.S INSTEXT=$P(INSDATA,"|",2,99)
.S INSTEXT=$TR(INSTEXT,"^"," ")
.I INSIEN,'$D(^SC(SDIEN,"SI",INSIEN)) D ERRLOG^SDES2JSON(.ERRORS,52,"Invalid Instruction ID: "_INSIEN) Q
.I INSTEXT="@"!(INSTEXT="") Q
.I $L(INSTEXT)<1!($L(INSTEXT)>80) D ERRLOG^SDES2JSON(.ERRORS,487)
M FDATA("SPECIAL INSTRUCTIONS")=SPECINST("SPECIAL INSTRUCTIONS")
Q
VALPRIVUSERS(ERRORS,PRIVUSERS,FDATA,CLINICIEN) ;
N PUSER
S PUSER=0 F S PUSER=$O(PRIVUSERS("PRIVILEGED USER",PUSER)) Q:'PUSER D
.I $G(CLINICIEN),$D(^SC(CLINICIEN,"SDPRIV",PUSER)),$G(PRIVUSERS("PRIVILEGED USER",PUSER))="@" Q
.D VALUSERDUZ^SDES2VAL200(.ERRORS,PUSER)
M FDATA("PRIVILEGED USER")=PRIVUSERS("PRIVILEGED USER")
Q
VALCLINICHASH(ERRORS,CLINIEN,INPUTHASH) ;
I INPUTHASH="" Q
I $$GET1^DIQ(44,CLINIEN,2900,"I")'=INPUTHASH D ERRLOG^SDES2JSON(.ERRORS,252)
Q
VALVETSLFCAN(SDERRORS,SDCLINIC,FDATA) ; Check for "VETERAN SELF-CANCEL" value required
N VRES,VETSCAN,SDVETSCAN,CLINICIEN
S CLINICIEN=$G(SDCLINIC("CLINIC IEN"))
S VETSCAN=$G(SDCLINIC("VETERAN SELF-CANCEL"))
I $G(CLINICIEN)="" D ; We are in create without a clinic ien
. I VETSCAN="" D ERRLOG^SDES2JSON(.SDERRORS,571,"VETERAN SELF-CANCEL value must be supplied") Q ; required not sent
. D VALBOOLEAN^SDES2VALUTIL(.VRES,.SDERRORS,44,63,VETSCAN,1,,,571) I $D(SDERRORS)>1 Q
. S FDATA("VETERAN SELF-CANCEL")=VRES(44,63,"I")
I $G(CLINICIEN)'="" D ; In edit with a clininc
. S SDVETSCAN=$$GET1^DIQ(44,$G(CLINICIEN),63,"I")
. I VETSCAN'="" D VALBOOLEAN^SDES2VALUTIL(.VRES,.ERRORS,44,63,$G(VETSCAN),1,,,571) I $D(ERRORS)>1 M SDERRORS=ERRORS Q
. I VETSCAN="",$G(SDVETSCAN)'="" S FDATA("VETERAN SELF-CANCEL")=SDVETSCAN ; If no Vet Self Cancel value passed then use the one on the record
. I VETSCAN'="" S FDATA("VETERAN SELF-CANCEL")=VRES(44,63,"I") ; If Vet Self Cancel value passed in then use it
. I VETSCAN="",$G(SDVETSCAN)="" D ERRLOG^SDES2JSON(.SDERRORS,571,"VETERAN SELF-CANCEL value missing on clinic and not supplied to edit clinic")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDES2VAL44A 3692 printed Dec 13, 2024@02:54:52 Page 2
SDES2VAL44A ;ALB/BWF/MGD,TJB - SDES2 Clinic validation utilities ;OCT 18, 2024
+1 ;;5.3;Scheduling;**853,857,869,878,893**;Aug 13, 1993;Build 6
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 ; Reference to $$CODEC^ICDEX in ICR-5747
+5 ; Reference to $$STATCHK^ICDEX in ICR-5747
+6 QUIT
+7 ;
VALPROVIDERS(ERRORS,SDCLINIC,FDATA,CLINICIEN) ;
+1 NEW PROVIEN,PROVERRORS,DEFCNT
+2 SET (PROVIEN,DEFCNT)=0
FOR
SET PROVIEN=$ORDER(SDCLINIC("PROVIDER",PROVIEN))
if 'PROVIEN
QUIT
Begin DoDot:1
+3 IF $GET(CLINICIEN)
IF $DATA(^SC(CLINICIEN,"PR","B",PROVIEN))
IF $GET(SDCLINIC("PROVIDER",PROVIEN))="@"
QUIT
+4 DO VALPROVIDER^SDES2VAL200(.ERRORS,PROVIEN)
+5 IF $DATA(SDCLINIC("PROVIDER",PROVIEN,"DEFAULT"))
SET DEFCNT=DEFCNT+1
End DoDot:1
+6 IF DEFCNT>1
DO ERRLOG^SDES2JSON(.ERRORS,488)
QUIT
+7 MERGE FDATA("PROVIDER")=SDCLINIC("PROVIDER")
+8 QUIT
VALDIAG(ERRORS,SDCLINIC,FDATA,CLINICIEN) ;
+1 NEW DIAGCODE,DIAGIEN,DEFDIAGCNT,NEWDIAGIEN,DIAGSTAT
+2 SET DEFDIAGCNT=0
+3 SET DIAGCODE=""
FOR
SET DIAGCODE=$ORDER(SDCLINIC("DIAGNOSIS",DIAGCODE))
if DIAGCODE=""
QUIT
Begin DoDot:1
+4 SET DIAGIEN=$$CODEN^ICDEX(DIAGCODE,80)
+5 IF +DIAGIEN=-1
DO ERRLOG^SDES2JSON(.ERRORS,85,DIAGCODE)
QUIT
+6 IF $GET(CLINICIEN)
IF $DATA(^SC(CLINICIEN,"DX","B",+DIAGIEN))
IF $GET(SDCLINIC("DIAGNOSIS",DIAGCODE))="@"
QUIT
+7 SET DIAGSTAT=+$$STATCHK^ICDEX(DIAGCODE)
+8 IF 'DIAGSTAT
DO ERRLOG^SDES2JSON(.ERRORS,363,DIAGCODE)
QUIT
+9 IF $DATA(SDCLINIC("DIAGNOSIS",DIAGCODE,"DEFAULT"))
SET DEFDIAGCNT=DEFDIAGCNT+1
End DoDot:1
+10 IF DEFDIAGCNT>1
DO ERRLOG^SDES2JSON(.ERRORS,490)
QUIT
+11 MERGE FDATA("DIAGNOSIS")=SDCLINIC("DIAGNOSIS")
+12 QUIT
VALSPECINSTRUCT(ERRORS,SPECINST,FDATA,SDIEN) ;
+1 NEW INSTRUCT,INSDATA,INSIEN,INSTEXT
+2 SET INSTRUCT=0
FOR
SET INSTRUCT=$ORDER(SPECINST("SPECIAL INSTRUCTIONS",INSTRUCT))
if 'INSTRUCT
QUIT
Begin DoDot:1
+3 SET INSDATA=$GET(SPECINST("SPECIAL INSTRUCTIONS",INSTRUCT))
+4 SET INSIEN=$PIECE(INSDATA,"|")
+5 SET INSTEXT=$PIECE(INSDATA,"|",2,99)
+6 SET INSTEXT=$TRANSLATE(INSTEXT,"^"," ")
+7 IF INSIEN
IF '$DATA(^SC(SDIEN,"SI",INSIEN))
DO ERRLOG^SDES2JSON(.ERRORS,52,"Invalid Instruction ID: "_INSIEN)
QUIT
+8 IF INSTEXT="@"!(INSTEXT="")
QUIT
+9 IF $LENGTH(INSTEXT)<1!($LENGTH(INSTEXT)>80)
DO ERRLOG^SDES2JSON(.ERRORS,487)
End DoDot:1
+10 MERGE FDATA("SPECIAL INSTRUCTIONS")=SPECINST("SPECIAL INSTRUCTIONS")
+11 QUIT
VALPRIVUSERS(ERRORS,PRIVUSERS,FDATA,CLINICIEN) ;
+1 NEW PUSER
+2 SET PUSER=0
FOR
SET PUSER=$ORDER(PRIVUSERS("PRIVILEGED USER",PUSER))
if 'PUSER
QUIT
Begin DoDot:1
+3 IF $GET(CLINICIEN)
IF $DATA(^SC(CLINICIEN,"SDPRIV",PUSER))
IF $GET(PRIVUSERS("PRIVILEGED USER",PUSER))="@"
QUIT
+4 DO VALUSERDUZ^SDES2VAL200(.ERRORS,PUSER)
End DoDot:1
+5 MERGE FDATA("PRIVILEGED USER")=PRIVUSERS("PRIVILEGED USER")
+6 QUIT
VALCLINICHASH(ERRORS,CLINIEN,INPUTHASH) ;
+1 IF INPUTHASH=""
QUIT
+2 IF $$GET1^DIQ(44,CLINIEN,2900,"I")'=INPUTHASH
DO ERRLOG^SDES2JSON(.ERRORS,252)
+3 QUIT
VALVETSLFCAN(SDERRORS,SDCLINIC,FDATA) ; Check for "VETERAN SELF-CANCEL" value required
+1 NEW VRES,VETSCAN,SDVETSCAN,CLINICIEN
+2 SET CLINICIEN=$GET(SDCLINIC("CLINIC IEN"))
+3 SET VETSCAN=$GET(SDCLINIC("VETERAN SELF-CANCEL"))
+4 ; We are in create without a clinic ien
IF $GET(CLINICIEN)=""
Begin DoDot:1
+5 ; required not sent
IF VETSCAN=""
DO ERRLOG^SDES2JSON(.SDERRORS,571,"VETERAN SELF-CANCEL value must be supplied")
QUIT
+6 DO VALBOOLEAN^SDES2VALUTIL(.VRES,.SDERRORS,44,63,VETSCAN,1,,,571)
IF $DATA(SDERRORS)>1
QUIT
+7 SET FDATA("VETERAN SELF-CANCEL")=VRES(44,63,"I")
End DoDot:1
+8 ; In edit with a clininc
IF $GET(CLINICIEN)'=""
Begin DoDot:1
+9 SET SDVETSCAN=$$GET1^DIQ(44,$GET(CLINICIEN),63,"I")
+10 IF VETSCAN'=""
DO VALBOOLEAN^SDES2VALUTIL(.VRES,.ERRORS,44,63,$GET(VETSCAN),1,,,571)
IF $DATA(ERRORS)>1
MERGE SDERRORS=ERRORS
QUIT
+11 ; If no Vet Self Cancel value passed then use the one on the record
IF VETSCAN=""
IF $GET(SDVETSCAN)'=""
SET FDATA("VETERAN SELF-CANCEL")=SDVETSCAN
+12 ; If Vet Self Cancel value passed in then use it
IF VETSCAN'=""
SET FDATA("VETERAN SELF-CANCEL")=VRES(44,63,"I")
+13 IF VETSCAN=""
IF $GET(SDVETSCAN)=""
DO ERRLOG^SDES2JSON(.SDERRORS,571,"VETERAN SELF-CANCEL value missing on clinic and not supplied to edit clinic")
End DoDot:1
+14 QUIT
