- 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 Apr 23, 2025@18:25:56 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
