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

SDES2VAL44A.m

Go to the documentation of this file.
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