SDES887P ;ALB/MGD,JAS - SD*5.3*887 Post Init Routine ; August 15, 2024
;;5.3;SCHEDULING;**887**;AUG 13, 1993;Build 7
;;Per VHA Directive 6402, this routine should not be modified
;
Q
;
EN ;
D ADDVETSLFCAN
D CLNSRVFIELD
Q
;
ADDVETSLFCAN ;
N CLINIEN,FDA,SRVPROX,VIABPROX,VSELFCHK
S SRVPROX=$O(^VA(200,"B","SDESOITEAS,SRV",0))
S VIABPROX=$O(^VA(200,"B","VIABAPPLICATIONPROXY,VIAB",0))
S:SRVPROX="" SRVPROX=0
S:VIABPROX="" VIABPROX=0
;
S CLINIEN=0
F S CLINIEN=$O(^SC(CLINIEN)) Q:'CLINIEN D
. S VSELFCHK=0
. I SRVPROX,$D(^SC(CLINIEN,"SDPRIV",SRVPROX)) S VSELFCHK=1
. I VIABPROX,$D(^SC(CLINIEN,"SDPRIV",VIABPROX)) S VSELFCHK=1
. ;
. S FDA(44,CLINIEN_",",63)=VSELFCHK
. D FILE^DIE(,"FDA") K FDA
Q
;
CLNSRVFIELD ; Remove values from field #1.1 of file #409.86
N CONTIEN,CONTDATA,FDA
S CONTIEN=0
F S CONTIEN=$O(^SDEC(409.86,CONTIEN)) Q:'CONTIEN D
. S CONTDATA=$G(^SDEC(409.86,CONTIEN,0))
. Q:$P(CONTDATA,"^",6)=""
. S FDA(409.86,CONTIEN_",",1.1)="@"
. D FILE^DIE(,"FDA") K FDA
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDES887P 1045 printed Oct 16, 2024@18:55:57 Page 2
SDES887P ;ALB/MGD,JAS - SD*5.3*887 Post Init Routine ; August 15, 2024
+1 ;;5.3;SCHEDULING;**887**;AUG 13, 1993;Build 7
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 QUIT
+5 ;
EN ;
+1 DO ADDVETSLFCAN
+2 DO CLNSRVFIELD
+3 QUIT
+4 ;
ADDVETSLFCAN ;
+1 NEW CLINIEN,FDA,SRVPROX,VIABPROX,VSELFCHK
+2 SET SRVPROX=$ORDER(^VA(200,"B","SDESOITEAS,SRV",0))
+3 SET VIABPROX=$ORDER(^VA(200,"B","VIABAPPLICATIONPROXY,VIAB",0))
+4 if SRVPROX=""
SET SRVPROX=0
+5 if VIABPROX=""
SET VIABPROX=0
+6 ;
+7 SET CLINIEN=0
+8 FOR
SET CLINIEN=$ORDER(^SC(CLINIEN))
if 'CLINIEN
QUIT
Begin DoDot:1
+9 SET VSELFCHK=0
+10 IF SRVPROX
IF $DATA(^SC(CLINIEN,"SDPRIV",SRVPROX))
SET VSELFCHK=1
+11 IF VIABPROX
IF $DATA(^SC(CLINIEN,"SDPRIV",VIABPROX))
SET VSELFCHK=1
+12 ;
+13 SET FDA(44,CLINIEN_",",63)=VSELFCHK
+14 DO FILE^DIE(,"FDA")
KILL FDA
End DoDot:1
+15 QUIT
+16 ;
CLNSRVFIELD ; Remove values from field #1.1 of file #409.86
+1 NEW CONTIEN,CONTDATA,FDA
+2 SET CONTIEN=0
+3 FOR
SET CONTIEN=$ORDER(^SDEC(409.86,CONTIEN))
if 'CONTIEN
QUIT
Begin DoDot:1
+4 SET CONTDATA=$GET(^SDEC(409.86,CONTIEN,0))
+5 if $PIECE(CONTDATA,"^",6)=""
QUIT
+6 SET FDA(409.86,CONTIEN_",",1.1)="@"
+7 DO FILE^DIE(,"FDA")
KILL FDA
End DoDot:1
+8 QUIT
