XUOAAUTL.m

XUOAAUTL ;SFISC/SO- UTILITIES FOR OAA ;09/08/2008

 ;;8.0;KERNEL;**344,398,401**;Jul 10, 1995;Build 14

 ;

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

XUOAAUTL  ;SFISC/SO- UTILITIES FOR OAA ;09/08/2008

 +1       ;;8.0;KERNEL;**344,398,401**;Jul 10, 1995;Build 14

 +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