DGJTADD.m

DGJTADD ;MAC/ALB - ENTER/EDIT DEFICIENCIES FOR IRT ; MAY 13,1992@11:00

 ;;1.0;Incomplete Records Tracking;;Jun 25, 2001

EN N DA,DIC,DIE,DIR,DLAYGO,DGJTABR,DGJTCTG,DGJTTRK,DGJTSTD D FULL^VALM1

 R !!,"Enter New Deficiency: ",X:DTIME G Q1:X="^"!('$T) S DGJTX=X I DGJTX["?"!($L(DGJTX)>30)!($L(DGJTX)<3)!'(DGJTX'?1P.E) W !!,"Enter a new Deficiency Name ... 3-30 characters OR '^' to EXIT" G EN

 S DIR(0)="393.3,.02" D ^DIR G Q1:X["^"!$D(DTOUT) S DGJTABR=$P(Y,"^",1)

 S DIR(0)="393.3,.06" D ^DIR G Q1:X["^"!$D(DTOUT) S DGJTCTG=+Y

 S DIR(0)="393.3,.07" D ^DIR G Q1:X["^"!$D(DTOUT) S DGJTTRK=+Y

 S DIR(0)="393.3,.08" D ^DIR G Q1:X["^"!$D(DTOUT) S DGJTSTD=+Y

 S X=DGJTX,DIC="^VAS(393.3,",DIC(0)="L",DLAYGO=393.3 D ^DIC G:Y'>0 Q1

 S DIE=DIC,DA=+Y,DR=".02////"_DGJTABR_";.06////"_DGJTCTG_";.07////"_DGJTTRK_";.08////"_DGJTSTD D ^DIE

 G EN

Q1 K DR D EVDT^DGJPAR1 S VALMBG=1,VALMBCK="R" Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DGJTADD   888     printed  Apr 09, 2024@21:02:25                                                                                                                                                                                                      Page 2

DGJTADD   ;MAC/ALB - ENTER/EDIT DEFICIENCIES FOR IRT ; MAY 13,1992@11:00

 +1       ;;1.0;Incomplete Records Tracking;;Jun 25, 2001

EN         NEW DA,DIC,DIE,DIR,DLAYGO,DGJTABR,DGJTCTG,DGJTTRK,DGJTSTD

           DO FULL^VALM1

 +1        READ !!,"Enter New Deficiency: ",X:DTIME

           if X="^"!('$TEST)

               GOTO Q1

           SET DGJTX=X

           IF DGJTX["?"!($LENGTH(DGJTX)>30)!($LENGTH(DGJTX)<3)!'(DGJTX'?1P.E)

               WRITE !!,"Enter a new Deficiency Name ... 3-30 characters OR '^' to EXIT"

               GOTO EN

 +2        SET DIR(0)="393.3,.02"

           DO ^DIR

           if X["^"!$DATA(DTOUT)

               GOTO Q1

           SET DGJTABR=$PIECE(Y,"^",1)

 +3        SET DIR(0)="393.3,.06"

           DO ^DIR

           if X["^"!$DATA(DTOUT)

               GOTO Q1

           SET DGJTCTG=+Y

 +4        SET DIR(0)="393.3,.07"

           DO ^DIR

           if X["^"!$DATA(DTOUT)

               GOTO Q1

           SET DGJTTRK=+Y

 +5        SET DIR(0)="393.3,.08"

           DO ^DIR

           if X["^"!$DATA(DTOUT)

               GOTO Q1

           SET DGJTSTD=+Y

 +6        SET X=DGJTX

           SET DIC="^VAS(393.3,"

           SET DIC(0)="L"

           SET DLAYGO=393.3

           DO ^DIC

           if Y'>0

               GOTO Q1

 +7        SET DIE=DIC

           SET DA=+Y

           SET DR=".02////"_DGJTABR_";.06////"_DGJTCTG_";.07////"_DGJTTRK_";.08////"_DGJTSTD

           DO ^DIE

 +8        GOTO EN

Q1         KILL DR

           DO EVDT^DGJPAR1

           SET VALMBG=1

           SET VALMBCK="R"

           QUIT