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 ---[H[J[2J[HDGJTADD 888 printed Nov 22, 2024@17:10:56 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
