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.
  1. SDES2VAL44A ;ALB/BWF/MGD,TJB,JAS - SDES2 Clinic validation utilities ;NOV 05, 2024
  1. ;;5.3;Scheduling;**853,857,869,878,893,895**;Aug 13, 1993;Build 11
  1. ;;Per VHA Directive 6402, this routine should not be modified
  1. ;
  1. ; Reference to $$CODEC^ICDEX in ICR-5747
  1. ; Reference to $$STATCHK^ICDEX in ICR-5747
  1. Q
  1. ;
  1. VALPROVIDERS(ERRORS,SDCLINIC,FDATA,CLINICIEN) ;
  1. N PROVIEN,PROVERRORS,DEFCNT
  1. S (PROVIEN,DEFCNT)=0 F S PROVIEN=$O(SDCLINIC("PROVIDER",PROVIEN)) Q:'PROVIEN D
  1. .I $G(CLINICIEN),$D(^SC(CLINICIEN,"PR","B",PROVIEN)),$G(SDCLINIC("PROVIDER",PROVIEN))="@" Q
  1. .D VALPROVIDER^SDES2VAL200(.ERRORS,PROVIEN)
  1. .I $D(SDCLINIC("PROVIDER",PROVIEN,"DEFAULT")) S DEFCNT=DEFCNT+1
  1. I DEFCNT>1 D ERRLOG^SDES2JSON(.ERRORS,488) Q
  1. M FDATA("PROVIDER")=SDCLINIC("PROVIDER")
  1. Q
  1. VALDIAG(ERRORS,SDCLINIC,FDATA,CLINICIEN) ;
  1. N DIAGCODE,DIAGIEN,DEFDIAGCNT,NEWDIAGIEN,DIAGSTAT
  1. S DEFDIAGCNT=0
  1. S DIAGCODE="" F S DIAGCODE=$O(SDCLINIC("DIAGNOSIS",DIAGCODE)) Q:DIAGCODE="" D
  1. .S DIAGIEN=$$CODEN^ICDEX(DIAGCODE,80)
  1. .I +DIAGIEN=-1 D ERRLOG^SDES2JSON(.ERRORS,85,DIAGCODE) Q
  1. .I $G(CLINICIEN),$D(^SC(CLINICIEN,"DX","B",+DIAGIEN)),$G(SDCLINIC("DIAGNOSIS",DIAGCODE))="@" Q
  1. .S DIAGSTAT=+$$STATCHK^ICDEX(DIAGCODE)
  1. .I 'DIAGSTAT D ERRLOG^SDES2JSON(.ERRORS,363,DIAGCODE) Q
  1. .I $D(SDCLINIC("DIAGNOSIS",DIAGCODE,"DEFAULT")) S DEFDIAGCNT=DEFDIAGCNT+1
  1. I DEFDIAGCNT>1 D ERRLOG^SDES2JSON(.ERRORS,490) Q
  1. M FDATA("DIAGNOSIS")=SDCLINIC("DIAGNOSIS")
  1. Q
  1. VALSPECINSTRUCT(ERRORS,SPECINST,FDATA,SDIEN) ;
  1. N INSTRUCT,INSDATA,INSIEN,INSTEXT
  1. S INSTRUCT=0 F S INSTRUCT=$O(SPECINST("SPECIAL INSTRUCTIONS",INSTRUCT)) Q:'INSTRUCT D
  1. .S INSDATA=$G(SPECINST("SPECIAL INSTRUCTIONS",INSTRUCT))
  1. .S INSIEN=$P(INSDATA,"|")
  1. .S INSTEXT=$P(INSDATA,"|",2,99)
  1. .S INSTEXT=$TR(INSTEXT,"^"," ")
  1. .I INSIEN,'$D(^SC(SDIEN,"SI",INSIEN)) D ERRLOG^SDES2JSON(.ERRORS,52,"Invalid Instruction ID: "_INSIEN) Q
  1. .I INSTEXT="@"!(INSTEXT="") Q
  1. .I $L(INSTEXT)<1!($L(INSTEXT)>80) D ERRLOG^SDES2JSON(.ERRORS,487)
  1. M FDATA("SPECIAL INSTRUCTIONS")=SPECINST("SPECIAL INSTRUCTIONS")
  1. Q
  1. VALPRIVUSERS(ERRORS,PRIVUSERS,FDATA,CLINICIEN) ;
  1. N PUSER
  1. S PUSER=0 F S PUSER=$O(PRIVUSERS("PRIVILEGED USER",PUSER)) Q:'PUSER D
  1. .I $G(CLINICIEN),$D(^SC(CLINICIEN,"SDPRIV",PUSER)),$G(PRIVUSERS("PRIVILEGED USER",PUSER))="@" Q
  1. .D VALUSERDUZ^SDES2VAL200(.ERRORS,PUSER)
  1. M FDATA("PRIVILEGED USER")=PRIVUSERS("PRIVILEGED USER")
  1. Q
  1. VALCLINICHASH(ERRORS,CLINIEN,INPUTHASH) ;
  1. I INPUTHASH="" Q
  1. I $$GET1^DIQ(44,CLINIEN,2900,"I")'=INPUTHASH D ERRLOG^SDES2JSON(.ERRORS,252)
  1. Q
  1. VALVETSLFCAN(SDERRORS,SDCLINIC,FDATA) ; Check for "VETERAN SELF-CANCEL" value required
  1. N VRES,VETSCAN,SDVETSCAN,CLINICIEN
  1. S CLINICIEN=$G(SDCLINIC("CLINIC IEN"))
  1. S VETSCAN=$G(SDCLINIC("VETERAN SELF-CANCEL"))
  1. I $G(CLINICIEN)="" D ; We are in create without a clinic ien
  1. . I VETSCAN="" D ERRLOG^SDES2JSON(.SDERRORS,571,"VETERAN SELF-CANCEL value must be supplied") Q ; required not sent
  1. . D VALBOOLEAN^SDES2VALUTIL(.VRES,.SDERRORS,44,63,VETSCAN,1,,,571) I $D(SDERRORS)>1 Q
  1. . S FDATA("VETERAN SELF-CANCEL")=VRES(44,63,"I")
  1. I $G(CLINICIEN)'="" D ; In edit with a clininc
  1. . S SDVETSCAN=$$GET1^DIQ(44,$G(CLINICIEN),63,"I")
  1. . I VETSCAN'="" D VALBOOLEAN^SDES2VALUTIL(.VRES,.ERRORS,44,63,$G(VETSCAN),1,,,571) I $D(ERRORS)>1 M SDERRORS=ERRORS Q
  1. . I VETSCAN="",$G(SDVETSCAN)'="" S FDATA("VETERAN SELF-CANCEL")=SDVETSCAN ; If no Vet Self Cancel value passed then use the one on the record
  1. . I VETSCAN'="" S FDATA("VETERAN SELF-CANCEL")=VRES(44,63,"I") ; If Vet Self Cancel value passed in then use it
  1. . I VETSCAN="",$G(SDVETSCAN)="" D ERRLOG^SDES2JSON(.SDERRORS,571,"VETERAN SELF-CANCEL value missing on clinic and not supplied to edit clinic")
  1. Q
  1. ;
  1. VALSUBSPEC(SDERRORS,SDCLINIC,FDATA) ; Validate Subspecialty input array
  1. N PARENTIEN,SSCOUNT,SSID,SSIDDA,SSNAME,SSNEWSUB,SSPARENT,SSTIER
  1. S SSCOUNT=0
  1. F S SSCOUNT=$O(SDCLINIC("SUBSPECIALTY",SSCOUNT)) Q:'SSCOUNT!($D(SDERRORS)) D
  1. . K SSNEWSUB
  1. . S SSID=$G(SDCLINIC("SUBSPECIALTY",SSCOUNT,"ID")),SSNAME=$G(SDCLINIC("SUBSPECIALTY",SSCOUNT,"NAME"))
  1. . S SSTIER=$G(SDCLINIC("SUBSPECIALTY",SSCOUNT,"TIER")),SSPARENT=$G(SDCLINIC("SUBSPECIALTY",SSCOUNT,"PARENT"))
  1. . I 'SSID!(SSID>99999) D ERRLOG^SDES2JSON(.SDERRORS,601) Q
  1. . I $L(SSNAME)<3!($L(SSNAME)>150) D ERRLOG^SDES2JSON(.SDERRORS,602) Q
  1. . I $L(SSTIER)&(SSTIER'="S"&(SSTIER'="T")) D ERRLOG^SDES2JSON(.SDERRORS,603) Q
  1. . I SSTIER="" S SSTIER=$S('$G(SSPARENT):"S",1:"T")
  1. . I SSPARENT D Q:$D(SDERRORS)
  1. . . I SSPARENT=SSID D ERRLOG^SDES2JSON(.SDERRORS,614) Q
  1. . . I '$D(^SDEC(409.94,"B",SSPARENT)) D ERRLOG^SDES2JSON(.SDERRORS,604) Q
  1. . . I SSTIER="S" D ERRLOG^SDES2JSON(.SDERRORS,612) Q
  1. . . S PARENTIEN=$O(^SDEC(409.94,"B",SSPARENT,0))
  1. . . I $$GET1^DIQ(409.94,PARENTIEN_",",2,"I")="T" D ERRLOG^SDES2JSON(.SDERRORS,613) Q
  1. . ; Validation passed so store/update SUBSPECIALTY record to file #409.94
  1. . S SSIDDA=$O(^SDEC(409.94,"B",SSID,0))
  1. . I SSIDDA D EDITSUBSPEC(SSIDDA,SSID,SSNAME,SSTIER,SSPARENT)
  1. . I 'SSIDDA D ADDSUBSPEC(.SSNEWSUB,SSID,SSNAME,SSTIER,SSPARENT) S SSIDDA=SSNEWSUB(1)
  1. . S FDATA("SUBSPECIALTY",SSCOUNT)=SSIDDA_"^"_SSTIER
  1. Q
  1. ;
  1. ADDSUBSPEC(SSNEWSUB,SSID,SSNAME,SSTIER,SSPARENT) ; Add new entry to the SDEC SUBSPECIALTY (#409.94) file
  1. N SSFDA,SSPARIEN
  1. S SSPARIEN=""
  1. I SSPARENT S SSPARIEN=$O(^SDEC(409.94,"B",SSPARENT,0))
  1. S SSFDA(409.94,"+1,",.01)=SSID
  1. S SSFDA(409.94,"+1,",1)=SSNAME
  1. S SSFDA(409.94,"+1,",2)=SSTIER
  1. S SSFDA(409.94,"+1,",3)=SSPARIEN
  1. D UPDATE^DIE(,"SSFDA","SSNEWSUB") K SSFDA
  1. Q
  1. ;
  1. EDITSUBSPEC(SSIDDA,SSID,SSNAME,SSTIER,SSPARENT) ; Edit an entry in the SDEC SUBSPECIALTY (#409.94) file
  1. N SSFDA,SSPARIEN
  1. S SSPARIEN=""
  1. I SSPARENT S SSPARIEN=$O(^SDEC(409.94,"B",SSPARENT,0))
  1. S SSFDA(409.94,SSIDDA_",",.01)=SSID
  1. S SSFDA(409.94,SSIDDA_",",1)=SSNAME
  1. S SSFDA(409.94,SSIDDA_",",2)=SSTIER
  1. S SSFDA(409.94,SSIDDA_",",3)=SSPARIEN
  1. D FILE^DIE(,"SSFDA") K SSFDA
  1. Q