XUOAAUTL ;SFISC/SO- UTILITIES FOR OAA ;09/08/2008
;;8.0;KERNEL;**344,398,401**;Jul 10, 1995;Build 3
;
SCRN4(IEN) ; Screen for INSITUTION(#4) file
N DIERR,IENS,FIELDS,Z,ZERR
S IENS=+IEN_","
S FIELDS="11;13;101"
D GETS^DIQ(4,IENS,FIELDS,"IE","Z","ZERR")
I $D(DIERR) Q 0
;
;Check to see if National
I Z(4,IENS,11,"I")'="N" Q 0
;
;Check to see if Inactive
I Z(4,IENS,101,"I") Q 0
;
;Check to see if VAMC ;8*398,8*401
; or M&ROC
; or RO-OC
; or OC
I "^VAMC^M&ROC^RO-OC^OC^"[(U_Z(4,IENS,13,"E")_U) Q 1
;
;Default
Q 0
;
HLP1 ; VHA TRAINING FACILITY HELP
W !,"Please choose the AFFILIATED VA facility responsible for administering"
W !,"this Registered trainee's clinical training program, even though the trainee's"
W !,"rotation may physically occur at a secondary VA site (i.e., OPC, CBOC, etc.)."
Q
;
A127 ; Automatically set Date No Longer Trainee, field #12.7
N IEN S IEN=0
F S IEN=$O(^VA(200,IEN)) Q:'IEN I $D(^VA(200,IEN,12)),$P(^(12),U,2)'="" D
. I '$D(^VA(200,IEN,0)) Q ; Bogus entry
. N TD ; Termination Date
. S TD=$P(^VA(200,IEN,0),U,11) ; Get Termination Date (TD)
. N DNLT ; Date No Longer Trainee
. S DNLT=$P(^VA(200,IEN,12),U,7) ; Get Date No Longer Trainee (DNLT)
. I TD="" Q ; User not Terminated
. I TD>DT Q ; Future Termination Date
. I DNLT="" D EDIT Q
. I DNLT>TD D EDIT Q
. Q
Q
EDIT ;
N DIERR,FDA
S FDA(200,IEN_",",12.6)="N" ; Set Clinical Core Trainee to No
S FDA(200,IEN_",",12.7)=TD ; Set Date No Longer Trainee
D FILE^DIE("","FDA")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUOAAUTL 1556 printed Dec 13, 2024@02:11:23 Page 2
XUOAAUTL ;SFISC/SO- UTILITIES FOR OAA ;09/08/2008
+1 ;;8.0;KERNEL;**344,398,401**;Jul 10, 1995;Build 3
+2 ;
SCRN4(IEN) ; Screen for INSITUTION(#4) file
+1 NEW DIERR,IENS,FIELDS,Z,ZERR
+2 SET IENS=+IEN_","
+3 SET FIELDS="11;13;101"
+4 DO GETS^DIQ(4,IENS,FIELDS,"IE","Z","ZERR")
+5 IF $DATA(DIERR)
QUIT 0
+6 ;
+7 ;Check to see if National
+8 IF Z(4,IENS,11,"I")'="N"
QUIT 0
+9 ;
+10 ;Check to see if Inactive
+11 IF Z(4,IENS,101,"I")
QUIT 0
+12 ;
+13 ;Check to see if VAMC ;8*398,8*401
+14 ; or M&ROC
+15 ; or RO-OC
+16 ; or OC
+17 IF "^VAMC^M&ROC^RO-OC^OC^"[(U_Z(4,IENS,13,"E")_U)
QUIT 1
+18 ;
+19 ;Default
+20 QUIT 0
+21 ;
HLP1 ; VHA TRAINING FACILITY HELP
+1 WRITE !,"Please choose the AFFILIATED VA facility responsible for administering"
+2 WRITE !,"this Registered trainee's clinical training program, even though the trainee's"
+3 WRITE !,"rotation may physically occur at a secondary VA site (i.e., OPC, CBOC, etc.)."
+4 QUIT
+5 ;
A127 ; Automatically set Date No Longer Trainee, field #12.7
+1 NEW IEN
SET IEN=0
+2 FOR
SET IEN=$ORDER(^VA(200,IEN))
if 'IEN
QUIT
IF $DATA(^VA(200,IEN,12))
IF $PIECE(^(12),U,2)'=""
Begin DoDot:1
+3 ; Bogus entry
IF '$DATA(^VA(200,IEN,0))
QUIT
+4 ; Termination Date
NEW TD
+5 ; Get Termination Date (TD)
SET TD=$PIECE(^VA(200,IEN,0),U,11)
+6 ; Date No Longer Trainee
NEW DNLT
+7 ; Get Date No Longer Trainee (DNLT)
SET DNLT=$PIECE(^VA(200,IEN,12),U,7)
+8 ; User not Terminated
IF TD=""
QUIT
+9 ; Future Termination Date
IF TD>DT
QUIT
+10 IF DNLT=""
DO EDIT
QUIT
+11 IF DNLT>TD
DO EDIT
QUIT
+12 QUIT
End DoDot:1
+13 QUIT
EDIT ;
+1 NEW DIERR,FDA
+2 ; Set Clinical Core Trainee to No
SET FDA(200,IEN_",",12.6)="N"
+3 ; Set Date No Longer Trainee
SET FDA(200,IEN_",",12.7)=TD
+4 DO FILE^DIE("","FDA")
+5 QUIT
