- SDES2VAL44A ;ALB/BWF/MGD,TJB,JAS - SDES2 Clinic validation utilities ;NOV 05, 2024
- ;;5.3;Scheduling;**853,857,869,878,893,895**;Aug 13, 1993;Build 11
- ;;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
- ;
- VALSUBSPEC(SDERRORS,SDCLINIC,FDATA) ; Validate Subspecialty input array
- N PARENTIEN,SSCOUNT,SSID,SSIDDA,SSNAME,SSNEWSUB,SSPARENT,SSTIER
- S SSCOUNT=0
- F S SSCOUNT=$O(SDCLINIC("SUBSPECIALTY",SSCOUNT)) Q:'SSCOUNT!($D(SDERRORS)) D
- . K SSNEWSUB
- . S SSID=$G(SDCLINIC("SUBSPECIALTY",SSCOUNT,"ID")),SSNAME=$G(SDCLINIC("SUBSPECIALTY",SSCOUNT,"NAME"))
- . S SSTIER=$G(SDCLINIC("SUBSPECIALTY",SSCOUNT,"TIER")),SSPARENT=$G(SDCLINIC("SUBSPECIALTY",SSCOUNT,"PARENT"))
- . I 'SSID!(SSID>99999) D ERRLOG^SDES2JSON(.SDERRORS,601) Q
- . I $L(SSNAME)<3!($L(SSNAME)>150) D ERRLOG^SDES2JSON(.SDERRORS,602) Q
- . I $L(SSTIER)&(SSTIER'="S"&(SSTIER'="T")) D ERRLOG^SDES2JSON(.SDERRORS,603) Q
- . I SSTIER="" S SSTIER=$S('$G(SSPARENT):"S",1:"T")
- . I SSPARENT D Q:$D(SDERRORS)
- . . I SSPARENT=SSID D ERRLOG^SDES2JSON(.SDERRORS,614) Q
- . . I '$D(^SDEC(409.94,"B",SSPARENT)) D ERRLOG^SDES2JSON(.SDERRORS,604) Q
- . . I SSTIER="S" D ERRLOG^SDES2JSON(.SDERRORS,612) Q
- . . S PARENTIEN=$O(^SDEC(409.94,"B",SSPARENT,0))
- . . I $$GET1^DIQ(409.94,PARENTIEN_",",2,"I")="T" D ERRLOG^SDES2JSON(.SDERRORS,613) Q
- . ; Validation passed so store/update SUBSPECIALTY record to file #409.94
- . S SSIDDA=$O(^SDEC(409.94,"B",SSID,0))
- . I SSIDDA D EDITSUBSPEC(SSIDDA,SSID,SSNAME,SSTIER,SSPARENT)
- . I 'SSIDDA D ADDSUBSPEC(.SSNEWSUB,SSID,SSNAME,SSTIER,SSPARENT) S SSIDDA=SSNEWSUB(1)
- . S FDATA("SUBSPECIALTY",SSCOUNT)=SSIDDA_"^"_SSTIER
- Q
- ;
- ADDSUBSPEC(SSNEWSUB,SSID,SSNAME,SSTIER,SSPARENT) ; Add new entry to the SDEC SUBSPECIALTY (#409.94) file
- N SSFDA,SSPARIEN
- S SSPARIEN=""
- I SSPARENT S SSPARIEN=$O(^SDEC(409.94,"B",SSPARENT,0))
- S SSFDA(409.94,"+1,",.01)=SSID
- S SSFDA(409.94,"+1,",1)=SSNAME
- S SSFDA(409.94,"+1,",2)=SSTIER
- S SSFDA(409.94,"+1,",3)=SSPARIEN
- D UPDATE^DIE(,"SSFDA","SSNEWSUB") K SSFDA
- Q
- ;
- EDITSUBSPEC(SSIDDA,SSID,SSNAME,SSTIER,SSPARENT) ; Edit an entry in the SDEC SUBSPECIALTY (#409.94) file
- N SSFDA,SSPARIEN
- S SSPARIEN=""
- I SSPARENT S SSPARIEN=$O(^SDEC(409.94,"B",SSPARENT,0))
- S SSFDA(409.94,SSIDDA_",",.01)=SSID
- S SSFDA(409.94,SSIDDA_",",1)=SSNAME
- S SSFDA(409.94,SSIDDA_",",2)=SSTIER
- S SSFDA(409.94,SSIDDA_",",3)=SSPARIEN
- D FILE^DIE(,"SSFDA") K SSFDA
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDES2VAL44A 5897 printed Feb 19, 2025@00:21:21 Page 2
- 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
- +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
- +15 ;
- VALSUBSPEC(SDERRORS,SDCLINIC,FDATA) ; Validate Subspecialty input array
- +1 NEW PARENTIEN,SSCOUNT,SSID,SSIDDA,SSNAME,SSNEWSUB,SSPARENT,SSTIER
- +2 SET SSCOUNT=0
- +3 FOR
- SET SSCOUNT=$ORDER(SDCLINIC("SUBSPECIALTY",SSCOUNT))
- if 'SSCOUNT!($DATA(SDERRORS))
- QUIT
- Begin DoDot:1
- +4 KILL SSNEWSUB
- +5 SET SSID=$GET(SDCLINIC("SUBSPECIALTY",SSCOUNT,"ID"))
- SET SSNAME=$GET(SDCLINIC("SUBSPECIALTY",SSCOUNT,"NAME"))
- +6 SET SSTIER=$GET(SDCLINIC("SUBSPECIALTY",SSCOUNT,"TIER"))
- SET SSPARENT=$GET(SDCLINIC("SUBSPECIALTY",SSCOUNT,"PARENT"))
- +7 IF 'SSID!(SSID>99999)
- DO ERRLOG^SDES2JSON(.SDERRORS,601)
- QUIT
- +8 IF $LENGTH(SSNAME)<3!($LENGTH(SSNAME)>150)
- DO ERRLOG^SDES2JSON(.SDERRORS,602)
- QUIT
- +9 IF $LENGTH(SSTIER)&(SSTIER'="S"&(SSTIER'="T"))
- DO ERRLOG^SDES2JSON(.SDERRORS,603)
- QUIT
- +10 IF SSTIER=""
- SET SSTIER=$SELECT('$GET(SSPARENT):"S",1:"T")
- +11 IF SSPARENT
- Begin DoDot:2
- +12 IF SSPARENT=SSID
- DO ERRLOG^SDES2JSON(.SDERRORS,614)
- QUIT
- +13 IF '$DATA(^SDEC(409.94,"B",SSPARENT))
- DO ERRLOG^SDES2JSON(.SDERRORS,604)
- QUIT
- +14 IF SSTIER="S"
- DO ERRLOG^SDES2JSON(.SDERRORS,612)
- QUIT
- +15 SET PARENTIEN=$ORDER(^SDEC(409.94,"B",SSPARENT,0))
- +16 IF $$GET1^DIQ(409.94,PARENTIEN_",",2,"I")="T"
- DO ERRLOG^SDES2JSON(.SDERRORS,613)
- QUIT
- End DoDot:2
- if $DATA(SDERRORS)
- QUIT
- +17 ; Validation passed so store/update SUBSPECIALTY record to file #409.94
- +18 SET SSIDDA=$ORDER(^SDEC(409.94,"B",SSID,0))
- +19 IF SSIDDA
- DO EDITSUBSPEC(SSIDDA,SSID,SSNAME,SSTIER,SSPARENT)
- +20 IF 'SSIDDA
- DO ADDSUBSPEC(.SSNEWSUB,SSID,SSNAME,SSTIER,SSPARENT)
- SET SSIDDA=SSNEWSUB(1)
- +21 SET FDATA("SUBSPECIALTY",SSCOUNT)=SSIDDA_"^"_SSTIER
- End DoDot:1
- +22 QUIT
- +23 ;
- ADDSUBSPEC(SSNEWSUB,SSID,SSNAME,SSTIER,SSPARENT) ; Add new entry to the SDEC SUBSPECIALTY (#409.94) file
- +1 NEW SSFDA,SSPARIEN
- +2 SET SSPARIEN=""
- +3 IF SSPARENT
- SET SSPARIEN=$ORDER(^SDEC(409.94,"B",SSPARENT,0))
- +4 SET SSFDA(409.94,"+1,",.01)=SSID
- +5 SET SSFDA(409.94,"+1,",1)=SSNAME
- +6 SET SSFDA(409.94,"+1,",2)=SSTIER
- +7 SET SSFDA(409.94,"+1,",3)=SSPARIEN
- +8 DO UPDATE^DIE(,"SSFDA","SSNEWSUB")
- KILL SSFDA
- +9 QUIT
- +10 ;
- EDITSUBSPEC(SSIDDA,SSID,SSNAME,SSTIER,SSPARENT) ; Edit an entry in the SDEC SUBSPECIALTY (#409.94) file
- +1 NEW SSFDA,SSPARIEN
- +2 SET SSPARIEN=""
- +3 IF SSPARENT
- SET SSPARIEN=$ORDER(^SDEC(409.94,"B",SSPARENT,0))
- +4 SET SSFDA(409.94,SSIDDA_",",.01)=SSID
- +5 SET SSFDA(409.94,SSIDDA_",",1)=SSNAME
- +6 SET SSFDA(409.94,SSIDDA_",",2)=SSTIER
- +7 SET SSFDA(409.94,SSIDDA_",",3)=SSPARIEN
- +8 DO FILE^DIE(,"SSFDA")
- KILL SSFDA
- +9 QUIT