- DGJTDEL ;ALB/MAF - DELETE OPTION FOR INCOMPLETE RECORDS TRACKING ; JAN 31,1989@900
- ;;1.0;Incomplete Records Tracking;;Jun 25, 2001
- EN D QUIT
- I $D(^DG(43,1,"GL")) S X=$P(^DG(43,1,"GL"),"^",2) I X=1 S DIR(0)="393,.06",DIR("A")="Select DIVISION " D ^DIR G QUIT:Y="^"!($D(DTOUT)) S DGJTDV=Y
- I '$D(DGJTDV) S X=$O(^DG(40.8,0)) S DGJTDV=X_"^"_$P(^DG(40.8,+X,0),"^")
- I '$D(^DG(40.8,+DGJTDV,"DT")) W !!?10,"PARAMETERS MUST BE SET UP IN THE MEDICAL CENTER DIVISION FILE ",!?30,"FOR DELINQUENCY TRACKING" G EN
- S DIC("S")="I $P(^VAS(393,+Y,0),""^"",6)=$P(DGJTDV,""^"",1)"
- PAT S DIC="^VAS(393,",DIC(0)="AQEMZ",DIC("A")="Select PATIENT INCOMPLETE RECORD to Delete: " D ^DIC G QUIT:Y'>0 S DGJTIFN=+Y
- S DGJTEDT1=1,DGJTEDT="^"_DGJTIFN D EN2^DGJTVW
- OKD N DGJVALM,DGJAT,VALMY
- S VALMBCK=""
- D SEL^VALM2 G ENQ:'$O(VALMY(0)) S DGJVALM=0
- D FULL^VALM1 S VALMBCK="R"
- F DGJVALM=0:0 S DGJVALM=$O(VALMY(DGJVALM)) Q:'DGJVALM S (DA,DGJIFNO)=$P($G(^TMP("DGJIDX",$J,DGJVALM)),"^",2) I DA]"" S DGJTEDT="1^"_DA S DGJDFNO=DA,DIC="^VAS(393,",DGJTYP=$P(^VAS(393,DA,0),"^",2) D EDIT^DGJTEE2,OKD1
- ENQ D REP^DGJTEE Q
- OKD1 D FULL^VALM1 S %=2 W !!,"Ok to delete PATIENT INCOMPLETE RECORD ENTRY " D YN^DICN I '% D YN G OKD1
- I %=1 S DIK="^VAS(393,",DA=DGJIFNO D ^DIK W !,"*DELETED*" K DIC Q
- I %=2 Q
- S DGJOUT=1 Q
- QUIT K %,DA,DIC,DIR,DGT,DGJTST,DGA1,DIK,DGJTDELE,DGJTIFN,DGJTEDT1,X,Y,%Y Q
- YN W !?10,"Choose:",!?25,"Y for YES",!?25,"N for NO",! Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGJTDEL 1435 printed Feb 18, 2025@23:27:11 Page 2
- DGJTDEL ;ALB/MAF - DELETE OPTION FOR INCOMPLETE RECORDS TRACKING ; JAN 31,1989@900
- +1 ;;1.0;Incomplete Records Tracking;;Jun 25, 2001
- EN DO QUIT
- +1 IF $DATA(^DG(43,1,"GL"))
- SET X=$PIECE(^DG(43,1,"GL"),"^",2)
- IF X=1
- SET DIR(0)="393,.06"
- SET DIR("A")="Select DIVISION "
- DO ^DIR
- if Y="^"!($DATA(DTOUT))
- GOTO QUIT
- SET DGJTDV=Y
- +2 IF '$DATA(DGJTDV)
- SET X=$ORDER(^DG(40.8,0))
- SET DGJTDV=X_"^"_$PIECE(^DG(40.8,+X,0),"^")
- +3 IF '$DATA(^DG(40.8,+DGJTDV,"DT"))
- WRITE !!?10,"PARAMETERS MUST BE SET UP IN THE MEDICAL CENTER DIVISION FILE ",!?30,"FOR DELINQUENCY TRACKING"
- GOTO EN
- +4 SET DIC("S")="I $P(^VAS(393,+Y,0),""^"",6)=$P(DGJTDV,""^"",1)"
- PAT SET DIC="^VAS(393,"
- SET DIC(0)="AQEMZ"
- SET DIC("A")="Select PATIENT INCOMPLETE RECORD to Delete: "
- DO ^DIC
- if Y'>0
- GOTO QUIT
- SET DGJTIFN=+Y
- +1 SET DGJTEDT1=1
- SET DGJTEDT="^"_DGJTIFN
- DO EN2^DGJTVW
- OKD NEW DGJVALM,DGJAT,VALMY
- +1 SET VALMBCK=""
- +2 DO SEL^VALM2
- if '$ORDER(VALMY(0))
- GOTO ENQ
- SET DGJVALM=0
- +3 DO FULL^VALM1
- SET VALMBCK="R"
- +4 FOR DGJVALM=0:0
- SET DGJVALM=$ORDER(VALMY(DGJVALM))
- if 'DGJVALM
- QUIT
- SET (DA,DGJIFNO)=$PIECE($GET(^TMP("DGJIDX",$JOB,DGJVALM)),"^",2)
- IF DA]""
- SET DGJTEDT="1^"_DA
- SET DGJDFNO=DA
- SET DIC="^VAS(393,"
- SET DGJTYP=$PIECE(^VAS(393,DA,0),"^",2)
- DO EDIT^DGJTEE2
- DO OKD1
- ENQ DO REP^DGJTEE
- QUIT
- OKD1 DO FULL^VALM1
- SET %=2
- WRITE !!,"Ok to delete PATIENT INCOMPLETE RECORD ENTRY "
- DO YN^DICN
- IF '%
- DO YN
- GOTO OKD1
- +1 IF %=1
- SET DIK="^VAS(393,"
- SET DA=DGJIFNO
- DO ^DIK
- WRITE !,"*DELETED*"
- KILL DIC
- QUIT
- +2 IF %=2
- QUIT
- +3 SET DGJOUT=1
- QUIT
- QUIT KILL %,DA,DIC,DIR,DGT,DGJTST,DGA1,DIK,DGJTDELE,DGJTIFN,DGJTEDT1,X,Y,%Y
- QUIT
- YN WRITE !?10,"Choose:",!?25,"Y for YES",!?25,"N for NO",!
- QUIT
