SDES2CRTPRVRES ;ALB/LAB - VISTA SCHEDULING SDES2 CREATE PROVIDER RESOURCE ;JAN 30,2024
;;5.3;Scheduling;**869,871**;Aug 13, 1993;Build 13
;;Per VHA Directive 6402, this routine should not be modified
Q
;
CREATEPRVRES(RESULT,SDCONTEXT,SDPARAM) ; create provider resource record 409.831
N ERRORS,RETURN,RESOURCE,SDDUZ
;validate context array for accuracy
D VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
I $D(ERRORS) S ERRORS("ResourceIEN",1)="" D BUILDJSON^SDES2JSON(.RESULT,.ERRORS) Q
D VALIDATE(.ERRORS,.SDPARAM)
I $D(ERRORS) S ERRORS("ResourceIEN",1)="" D BUILDJSON^SDES2JSON(.RESULT,.ERRORS) Q
D ASSIGNVARS(SDCONTEXT("USER DUZ"),SDPARAM("ProviderIEN"),.RESOURCE,.SDDUZ)
D CREATERESOURCE(.RETURN,.ERRORS,.SDCONTEXT,.SDPARAM,RESOURCE,SDDUZ)
I $D(ERRORS) S ERRORS("ResourceIEN",1)="" D BUILDJSON^SDES2JSON(.RESULT,.ERRORS) Q
D BUILDJSON^SDES2JSON(.RESULT,.RETURN)
Q
;
VALIDATE(ERRORS,SDPARAM) ; validate input array variables
S SDPARAM("ClinicIEN")=$G(SDPARAM("ClinicIEN"))
D VALFILEIEN^SDES2VALUTIL(,.ERRORS,44,SDPARAM("ClinicIEN"),0,"","",19)
D VALFILEIEN^SDES2VALUTIL(,.ERRORS,200,$G(SDPARAM("ProviderIEN")),1,"",53,54)
Q:$D(ERRORS)
;validate if resource already exists for provider
D:$O(^SDEC(409.831,"AC","P",SDPARAM("ProviderIEN"),""))'="" ERRLOG^SDES2JSON(.ERRORS,52,"Provider Resource already exists")
Q
;
ASSIGNVARS(USERID,PROVIDERIEN,RESOURCE,SDDUZ) ;assign variables to use
S RESOURCE=$$GET1^DIQ(200,PROVIDERIEN,.01,"E")
S SDDUZ=$S(USERID:USERID,1:DUZ)
Q
;
CREATERESOURCE(RETURN,ERRORS,SDCONTEXT,SDPARAM,RESOURCE,SDSDUZ) ;create the provider resource
N FILEDATA,NEWIEN
S FILEDATA(409.831,"+1,",.01)=RESOURCE
S FILEDATA(409.831,"+1,",.012)=SDPARAM("ProviderIEN")_";VA(200,"
S FILEDATA(409.831,"+1,",.015)=$$NOW^XLFDT
S FILEDATA(409.831,"+1,",.016)=SDDUZ
S FILEDATA(409.831,"+1,",.04)=SDPARAM("ClinicIEN")
D UPDATE^DIE("","FILEDATA","NEWIEN","ERRORS") K FILEDATA
S RETURN("ResourceIEN")=$G(NEWIEN(1))
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDES2CRTPRVRES 1991 printed Dec 13, 2024@02:53:39 Page 2
SDES2CRTPRVRES ;ALB/LAB - VISTA SCHEDULING SDES2 CREATE PROVIDER RESOURCE ;JAN 30,2024
+1 ;;5.3;Scheduling;**869,871**;Aug 13, 1993;Build 13
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 QUIT
+4 ;
CREATEPRVRES(RESULT,SDCONTEXT,SDPARAM) ; create provider resource record 409.831
+1 NEW ERRORS,RETURN,RESOURCE,SDDUZ
+2 ;validate context array for accuracy
+3 DO VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
+4 IF $DATA(ERRORS)
SET ERRORS("ResourceIEN",1)=""
DO BUILDJSON^SDES2JSON(.RESULT,.ERRORS)
QUIT
+5 DO VALIDATE(.ERRORS,.SDPARAM)
+6 IF $DATA(ERRORS)
SET ERRORS("ResourceIEN",1)=""
DO BUILDJSON^SDES2JSON(.RESULT,.ERRORS)
QUIT
+7 DO ASSIGNVARS(SDCONTEXT("USER DUZ"),SDPARAM("ProviderIEN"),.RESOURCE,.SDDUZ)
+8 DO CREATERESOURCE(.RETURN,.ERRORS,.SDCONTEXT,.SDPARAM,RESOURCE,SDDUZ)
+9 IF $DATA(ERRORS)
SET ERRORS("ResourceIEN",1)=""
DO BUILDJSON^SDES2JSON(.RESULT,.ERRORS)
QUIT
+10 DO BUILDJSON^SDES2JSON(.RESULT,.RETURN)
+11 QUIT
+12 ;
VALIDATE(ERRORS,SDPARAM) ; validate input array variables
+1 SET SDPARAM("ClinicIEN")=$GET(SDPARAM("ClinicIEN"))
+2 DO VALFILEIEN^SDES2VALUTIL(,.ERRORS,44,SDPARAM("ClinicIEN"),0,"","",19)
+3 DO VALFILEIEN^SDES2VALUTIL(,.ERRORS,200,$GET(SDPARAM("ProviderIEN")),1,"",53,54)
+4 if $DATA(ERRORS)
QUIT
+5 ;validate if resource already exists for provider
+6 if $ORDER(^SDEC(409.831,"AC","P",SDPARAM("ProviderIEN"),""))'=""
DO ERRLOG^SDES2JSON(.ERRORS,52,"Provider Resource already exists")
+7 QUIT
+8 ;
ASSIGNVARS(USERID,PROVIDERIEN,RESOURCE,SDDUZ) ;assign variables to use
+1 SET RESOURCE=$$GET1^DIQ(200,PROVIDERIEN,.01,"E")
+2 SET SDDUZ=$SELECT(USERID:USERID,1:DUZ)
+3 QUIT
+4 ;
CREATERESOURCE(RETURN,ERRORS,SDCONTEXT,SDPARAM,RESOURCE,SDSDUZ) ;create the provider resource
+1 NEW FILEDATA,NEWIEN
+2 SET FILEDATA(409.831,"+1,",.01)=RESOURCE
+3 SET FILEDATA(409.831,"+1,",.012)=SDPARAM("ProviderIEN")_";VA(200,"
+4 SET FILEDATA(409.831,"+1,",.015)=$$NOW^XLFDT
+5 SET FILEDATA(409.831,"+1,",.016)=SDDUZ
+6 SET FILEDATA(409.831,"+1,",.04)=SDPARAM("ClinicIEN")
+7 DO UPDATE^DIE("","FILEDATA","NEWIEN","ERRORS")
KILL FILEDATA
+8 SET RETURN("ResourceIEN")=$GET(NEWIEN(1))
+9 ;
