YS148IDX ;SLC/KCM - Re-index "AC" in MH RESULTS and MH ANSWERS ; 03/28/2019
;;5.01;MENTAL HEALTH;**148**;Dec 30, 1994;Build 8
;
REIDX ; Re-indexing Task
N YS148CNT,YS148MSG
S YS148CNT=0
K ^XTMP("YTS-RE-INDEX")
S ^XTMP("YTS-RE-INDEX",0)=$$FMADD^XLFDT(DT,7)_U_DT_U_"MH Re-Index Results"
D UPD("Removing bad nodes from MH RESULTS AC index"),FIX92
D UPD("Removing bad nodes from MH ANSWERS AC index"),FIX85AC
D UPD("Removing bad nodes from MH ANSWERS AD index"),FIX85AD
D UPD("Adding missing nodes to MH RESULTS AC index"),RESET92
D UPD("Adding missing nodes to MH ANSWERS AC index"),RESET85C
D UPD("Adding missing nodes to MH ANSWERS AD index"),RESET85D
S YS148MSG=$$FMTE^XLFDT($$NOW^XLFDT)
S YS148MSG=YS148CNT_" index errors found & resolved on: "_YS148MSG
D UPD(YS148MSG)
D NOTIFY(YS148MSG)
I $D(ZTQUEUED) S ZTREQ="@"
Q
;
; -- these tags remove any index nodes that are incorrect
;
FIX85AC ; Remove bad "AC" indexes from MH ANSWERS
N ADMIN,QSTN,IEN,X0
S ADMIN=0 F S ADMIN=$O(^YTT(601.85,"AC",ADMIN)) Q:'ADMIN D
. S QSTN=0 F S QSTN=$O(^YTT(601.85,"AC",ADMIN,QSTN)) Q:'QSTN D
. . S IEN=0 F S IEN=$O(^YTT(601.85,"AC",ADMIN,QSTN,IEN)) Q:'IEN D
. . . ; if IEN doesn't exist, remove index
. . . I '$D(^YTT(601.85,IEN,0)) D RM85AC(ADMIN,QSTN,IEN) QUIT
. . . S X0=$G(^YTT(601.85,IEN,0))
. . . ; if ADMIN doesn't match, remove index
. . . I $P(X0,U,2)'=ADMIN D RM85AC(ADMIN,QSTN,IEN) QUIT
. . . ; if QSTN doesn't match, remove index
. . . I $P(X0,U,3)'=QSTN D RM85AC(ADMIN,QSTN,IEN) QUIT
Q
RM85AC(ADMIN,QSTN,IEN) ; remove bad index
K ^YTT(601.85,"AC",ADMIN,QSTN,IEN)
D LOG("85AC",ADMIN,QSTN,IEN)
Q
FIX85AD ; Remove bad "AD" indexes from MH ANSWERS
N ADMIN,IEN,X0
S ADMIN=0 F S ADMIN=$O(^YTT(601.85,"AD",ADMIN)) Q:'ADMIN D
. S IEN=0 F S IEN=$O(^YTT(601.85,"AD",ADMIN,IEN)) Q:'IEN D
. . ; if IEN doesn't exist, remove index
. . I '$D(^YTT(601.85,IEN,0)) D RM85AD(ADMIN,IEN) QUIT
. . S X0=$G(^YTT(601.85,IEN,0))
. . ; if ADMIN doesn't match, remove index
. . I $P(X0,U,2)'=ADMIN D RM85AD(ADMIN,IEN) QUIT
Q
RM85AD(ADMIN,IEN) ; remove bad index
K ^YTT(601.85,"AD",ADMIN,IEN)
D LOG("85AD",ADMIN,"",IEN)
Q
FIX92 ; Remove bad indexes from MH RESULTS
N ADMIN,IEN
S ADMIN=0 F S ADMIN=$O(^YTT(601.92,"AC",ADMIN)) Q:'ADMIN D
. S IEN=0 F S IEN=$O(^YTT(601.92,"AC",ADMIN,IEN)) Q:'IEN D
. . ; if IEN doesn't exist, remove index
. . I '$D(^YTT(601.92,IEN,0)) D RM92AC(ADMIN,IEN) QUIT
. . ; if ADMIN doesn't match, remove index
. . I $P($G(^YTT(601.92,IEN,0)),U,2)'=ADMIN D RM92AC(ADMIN,IEN)
Q
RM92AC(ADMIN,IEN) ; remove bad index
K ^YTT(601.92,"AC",ADMIN,IEN)
D LOG("92AC",ADMIN,"",IEN)
Q
;
; -- these tags set any index nodes that are missing
;
RESET85C ; Rebuild the "AC" index for MH ANSWERS (601.85)
N ADMIN,QSTN,IEN,X0
S IEN=0 F S IEN=$O(^YTT(601.85,IEN)) Q:'IEN D
. S X0=$G(^YTT(601.85,IEN,0)),ADMIN=$P(X0,U,2),QSTN=$P(X0,U,3)
. I 'ADMIN!('QSTN) QUIT ; no index if missing data
. I $D(^YTT(601.85,"AC",ADMIN,QSTN,IEN)) QUIT ; index is correct
. N DIK,DA ; set new "AC" index
. S DIK="^YTT(601.85,",DIK(1)="1^AC",DA=IEN
. D EN^DIK
. D LOG("85ACI",ADMIN,QSTN,IEN)
Q
RESET85D ; Rebuild the "AD" index for MH ANSWERS (601.85)
N ADMIN,IEN,X0
S IEN=0 F S IEN=$O(^YTT(601.85,IEN)) Q:'IEN D
. S X0=$G(^YTT(601.85,IEN,0)),ADMIN=$P(X0,U,2)
. I 'ADMIN QUIT ; no index if missing data
. I $D(^YTT(601.85,"AD",ADMIN,IEN)) QUIT ; index is correct
. N DIK,DA ; set new "AD" index
. S DIK="^YTT(601.85,",DIK(1)="1^AD",DA=IEN
. D EN^DIK
. D LOG("85ADI",ADMIN,"",IEN)
Q
RESET92 ; Rebuild the "AC" index for MH RESULTS (601.92)
N ADMIN,IEN
S IEN=0 F S IEN=$O(^YTT(601.92,IEN)) Q:'IEN D
. S ADMIN=+$P($G(^YTT(601.92,IEN,0)),U,2)
. I 'ADMIN QUIT ; no index if admin missing
. I $D(^YTT(601.92,"AC",ADMIN,IEN)) QUIT ; index is correct
. N DIK,DA ; set new "AC" index
. S DIK="^YTT(601.92,",DIK(1)="1^AC",DA=IEN
. D EN^DIK
. D LOG("92ACI",ADMIN,"",IEN)
Q
;
; -- status notifications
;
LOG(FIX,ADMIN,QSTN,IEN) ; Log fixes
S YS148CNT=YS148CNT+1
I '$D(ZTQUEUED) S ^XTMP("YTS-RE-INDEX",YS148CNT)=FIX_U_ADMIN_U_$G(QSTN)_U_IEN
S ^XTMP("YTS-RE-INDEX","ERRS")=YS148CNT
Q
UPD(MSG) ; set parameter to current status
D EN^XPAR("SYS","YS123 RE-INDEX STATUS",1,MSG)
I '$D(ZTQUEUED) W !,MSG
Q
NOTIFY(MSG) ; send message to installer
N XMDUZ,XMSUB,XMTEXT,XMY,XMZ,XMMG,DIFROM,YSTEXT
S YSTEXT(1)="Re-indexing of the MH RESULTS and MH ANSWERS files has completed"
S YSTEXT(2)="with the following status:"
S YSTEXT(3)=" "
S YSTEXT(4)=MSG
S XMDUZ="YS*5.01*148 POST INSTALL"
S XMSUB="Re-Index of Mental Health Results Completed"
S:$G(DUZ) XMY(DUZ)="" S:$G(YS148IN) XMY(YS148IN)=""
S XMTEXT="YSTEXT("
D ^XMD
Q
;
; YS123 RE-INDEX MONITOR option
;
MONITOR ; Check status of re-index, allows re-queuing
W !,"MH RESULTS and MH ANSWERS Re-Index Monitor"
D STATUS
N X,Y,DIR,DTOUT,DUOUT,DIRUT,DIROUT
S DIR(0)="YA^^"
S DIR("A")="Do you want to queue re-indexing of MH RESULTS and MH ANSWERS? "
S DIR("B")="NO"
S DIR("?")="Answer YES to re-index (only needed if errors are occurring)."
D ^DIR
Q:$D(DIRUT) Q:$D(DIROUT) Q:'Y
S DIR(0)="DA^::FR"
S DIR("A")="Queue Re-Indexing to Run: "
S DIR("B")="NOW"
S DIR("?")="Enter the date/time when the re-indexing task should begin"
D ^DIR
Q:$D(DIRUT) Q:$D(DIROUT) Q:'Y
D QTASK^YS148PST(Y)
Q
STATUS ; Loop showing status until done
N X,Y,DIR,DTOUT,DUOUT,DIRUT,DIROUT
F D Q:'Y
. W !!," Status: ",$$GET^XPAR("SYS","YS123 RE-INDEX STATUS",1,"Q")
. W !," Errors Repaired: ",+$G(^XTMP("YTS-RE-INDEX","ERRS")),!
. S DIR(0)="YA^^"
. S DIR("A")="Refresh? "
. S DIR("B")="Yes"
. D ^DIR
. I $D(DIRUT)!$D(DIROUT) S Y=0
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYS148IDX 6010 printed Nov 22, 2024@17:22:27 Page 2
YS148IDX ;SLC/KCM - Re-index "AC" in MH RESULTS and MH ANSWERS ; 03/28/2019
+1 ;;5.01;MENTAL HEALTH;**148**;Dec 30, 1994;Build 8
+2 ;
REIDX ; Re-indexing Task
+1 NEW YS148CNT,YS148MSG
+2 SET YS148CNT=0
+3 KILL ^XTMP("YTS-RE-INDEX")
+4 SET ^XTMP("YTS-RE-INDEX",0)=$$FMADD^XLFDT(DT,7)_U_DT_U_"MH Re-Index Results"
+5 DO UPD("Removing bad nodes from MH RESULTS AC index")
DO FIX92
+6 DO UPD("Removing bad nodes from MH ANSWERS AC index")
DO FIX85AC
+7 DO UPD("Removing bad nodes from MH ANSWERS AD index")
DO FIX85AD
+8 DO UPD("Adding missing nodes to MH RESULTS AC index")
DO RESET92
+9 DO UPD("Adding missing nodes to MH ANSWERS AC index")
DO RESET85C
+10 DO UPD("Adding missing nodes to MH ANSWERS AD index")
DO RESET85D
+11 SET YS148MSG=$$FMTE^XLFDT($$NOW^XLFDT)
+12 SET YS148MSG=YS148CNT_" index errors found & resolved on: "_YS148MSG
+13 DO UPD(YS148MSG)
+14 DO NOTIFY(YS148MSG)
+15 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+16 QUIT
+17 ;
+18 ; -- these tags remove any index nodes that are incorrect
+19 ;
FIX85AC ; Remove bad "AC" indexes from MH ANSWERS
+1 NEW ADMIN,QSTN,IEN,X0
+2 SET ADMIN=0
FOR
SET ADMIN=$ORDER(^YTT(601.85,"AC",ADMIN))
if 'ADMIN
QUIT
Begin DoDot:1
+3 SET QSTN=0
FOR
SET QSTN=$ORDER(^YTT(601.85,"AC",ADMIN,QSTN))
if 'QSTN
QUIT
Begin DoDot:2
+4 SET IEN=0
FOR
SET IEN=$ORDER(^YTT(601.85,"AC",ADMIN,QSTN,IEN))
if 'IEN
QUIT
Begin DoDot:3
+5 ; if IEN doesn't exist, remove index
+6 IF '$DATA(^YTT(601.85,IEN,0))
DO RM85AC(ADMIN,QSTN,IEN)
QUIT
+7 SET X0=$GET(^YTT(601.85,IEN,0))
+8 ; if ADMIN doesn't match, remove index
+9 IF $PIECE(X0,U,2)'=ADMIN
DO RM85AC(ADMIN,QSTN,IEN)
QUIT
+10 ; if QSTN doesn't match, remove index
+11 IF $PIECE(X0,U,3)'=QSTN
DO RM85AC(ADMIN,QSTN,IEN)
QUIT
End DoDot:3
End DoDot:2
End DoDot:1
+12 QUIT
RM85AC(ADMIN,QSTN,IEN) ; remove bad index
+1 KILL ^YTT(601.85,"AC",ADMIN,QSTN,IEN)
+2 DO LOG("85AC",ADMIN,QSTN,IEN)
+3 QUIT
FIX85AD ; Remove bad "AD" indexes from MH ANSWERS
+1 NEW ADMIN,IEN,X0
+2 SET ADMIN=0
FOR
SET ADMIN=$ORDER(^YTT(601.85,"AD",ADMIN))
if 'ADMIN
QUIT
Begin DoDot:1
+3 SET IEN=0
FOR
SET IEN=$ORDER(^YTT(601.85,"AD",ADMIN,IEN))
if 'IEN
QUIT
Begin DoDot:2
+4 ; if IEN doesn't exist, remove index
+5 IF '$DATA(^YTT(601.85,IEN,0))
DO RM85AD(ADMIN,IEN)
QUIT
+6 SET X0=$GET(^YTT(601.85,IEN,0))
+7 ; if ADMIN doesn't match, remove index
+8 IF $PIECE(X0,U,2)'=ADMIN
DO RM85AD(ADMIN,IEN)
QUIT
End DoDot:2
End DoDot:1
+9 QUIT
RM85AD(ADMIN,IEN) ; remove bad index
+1 KILL ^YTT(601.85,"AD",ADMIN,IEN)
+2 DO LOG("85AD",ADMIN,"",IEN)
+3 QUIT
FIX92 ; Remove bad indexes from MH RESULTS
+1 NEW ADMIN,IEN
+2 SET ADMIN=0
FOR
SET ADMIN=$ORDER(^YTT(601.92,"AC",ADMIN))
if 'ADMIN
QUIT
Begin DoDot:1
+3 SET IEN=0
FOR
SET IEN=$ORDER(^YTT(601.92,"AC",ADMIN,IEN))
if 'IEN
QUIT
Begin DoDot:2
+4 ; if IEN doesn't exist, remove index
+5 IF '$DATA(^YTT(601.92,IEN,0))
DO RM92AC(ADMIN,IEN)
QUIT
+6 ; if ADMIN doesn't match, remove index
+7 IF $PIECE($GET(^YTT(601.92,IEN,0)),U,2)'=ADMIN
DO RM92AC(ADMIN,IEN)
End DoDot:2
End DoDot:1
+8 QUIT
RM92AC(ADMIN,IEN) ; remove bad index
+1 KILL ^YTT(601.92,"AC",ADMIN,IEN)
+2 DO LOG("92AC",ADMIN,"",IEN)
+3 QUIT
+4 ;
+5 ; -- these tags set any index nodes that are missing
+6 ;
RESET85C ; Rebuild the "AC" index for MH ANSWERS (601.85)
+1 NEW ADMIN,QSTN,IEN,X0
+2 SET IEN=0
FOR
SET IEN=$ORDER(^YTT(601.85,IEN))
if 'IEN
QUIT
Begin DoDot:1
+3 SET X0=$GET(^YTT(601.85,IEN,0))
SET ADMIN=$PIECE(X0,U,2)
SET QSTN=$PIECE(X0,U,3)
+4 ; no index if missing data
IF 'ADMIN!('QSTN)
QUIT
+5 ; index is correct
IF $DATA(^YTT(601.85,"AC",ADMIN,QSTN,IEN))
QUIT
+6 ; set new "AC" index
NEW DIK,DA
+7 SET DIK="^YTT(601.85,"
SET DIK(1)="1^AC"
SET DA=IEN
+8 DO EN^DIK
+9 DO LOG("85ACI",ADMIN,QSTN,IEN)
End DoDot:1
+10 QUIT
RESET85D ; Rebuild the "AD" index for MH ANSWERS (601.85)
+1 NEW ADMIN,IEN,X0
+2 SET IEN=0
FOR
SET IEN=$ORDER(^YTT(601.85,IEN))
if 'IEN
QUIT
Begin DoDot:1
+3 SET X0=$GET(^YTT(601.85,IEN,0))
SET ADMIN=$PIECE(X0,U,2)
+4 ; no index if missing data
IF 'ADMIN
QUIT
+5 ; index is correct
IF $DATA(^YTT(601.85,"AD",ADMIN,IEN))
QUIT
+6 ; set new "AD" index
NEW DIK,DA
+7 SET DIK="^YTT(601.85,"
SET DIK(1)="1^AD"
SET DA=IEN
+8 DO EN^DIK
+9 DO LOG("85ADI",ADMIN,"",IEN)
End DoDot:1
+10 QUIT
RESET92 ; Rebuild the "AC" index for MH RESULTS (601.92)
+1 NEW ADMIN,IEN
+2 SET IEN=0
FOR
SET IEN=$ORDER(^YTT(601.92,IEN))
if 'IEN
QUIT
Begin DoDot:1
+3 SET ADMIN=+$PIECE($GET(^YTT(601.92,IEN,0)),U,2)
+4 ; no index if admin missing
IF 'ADMIN
QUIT
+5 ; index is correct
IF $DATA(^YTT(601.92,"AC",ADMIN,IEN))
QUIT
+6 ; set new "AC" index
NEW DIK,DA
+7 SET DIK="^YTT(601.92,"
SET DIK(1)="1^AC"
SET DA=IEN
+8 DO EN^DIK
+9 DO LOG("92ACI",ADMIN,"",IEN)
End DoDot:1
+10 QUIT
+11 ;
+12 ; -- status notifications
+13 ;
LOG(FIX,ADMIN,QSTN,IEN) ; Log fixes
+1 SET YS148CNT=YS148CNT+1
+2 IF '$DATA(ZTQUEUED)
SET ^XTMP("YTS-RE-INDEX",YS148CNT)=FIX_U_ADMIN_U_$GET(QSTN)_U_IEN
+3 SET ^XTMP("YTS-RE-INDEX","ERRS")=YS148CNT
+4 QUIT
UPD(MSG) ; set parameter to current status
+1 DO EN^XPAR("SYS","YS123 RE-INDEX STATUS",1,MSG)
+2 IF '$DATA(ZTQUEUED)
WRITE !,MSG
+3 QUIT
NOTIFY(MSG) ; send message to installer
+1 NEW XMDUZ,XMSUB,XMTEXT,XMY,XMZ,XMMG,DIFROM,YSTEXT
+2 SET YSTEXT(1)="Re-indexing of the MH RESULTS and MH ANSWERS files has completed"
+3 SET YSTEXT(2)="with the following status:"
+4 SET YSTEXT(3)=" "
+5 SET YSTEXT(4)=MSG
+6 SET XMDUZ="YS*5.01*148 POST INSTALL"
+7 SET XMSUB="Re-Index of Mental Health Results Completed"
+8 if $GET(DUZ)
SET XMY(DUZ)=""
if $GET(YS148IN)
SET XMY(YS148IN)=""
+9 SET XMTEXT="YSTEXT("
+10 DO ^XMD
+11 QUIT
+12 ;
+13 ; YS123 RE-INDEX MONITOR option
+14 ;
MONITOR ; Check status of re-index, allows re-queuing
+1 WRITE !,"MH RESULTS and MH ANSWERS Re-Index Monitor"
+2 DO STATUS
+3 NEW X,Y,DIR,DTOUT,DUOUT,DIRUT,DIROUT
+4 SET DIR(0)="YA^^"
+5 SET DIR("A")="Do you want to queue re-indexing of MH RESULTS and MH ANSWERS? "
+6 SET DIR("B")="NO"
+7 SET DIR("?")="Answer YES to re-index (only needed if errors are occurring)."
+8 DO ^DIR
+9 if $DATA(DIRUT)
QUIT
if $DATA(DIROUT)
QUIT
if 'Y
QUIT
+10 SET DIR(0)="DA^::FR"
+11 SET DIR("A")="Queue Re-Indexing to Run: "
+12 SET DIR("B")="NOW"
+13 SET DIR("?")="Enter the date/time when the re-indexing task should begin"
+14 DO ^DIR
+15 if $DATA(DIRUT)
QUIT
if $DATA(DIROUT)
QUIT
if 'Y
QUIT
+16 DO QTASK^YS148PST(Y)
+17 QUIT
STATUS ; Loop showing status until done
+1 NEW X,Y,DIR,DTOUT,DUOUT,DIRUT,DIROUT
+2 FOR
Begin DoDot:1
+3 WRITE !!," Status: ",$$GET^XPAR("SYS","YS123 RE-INDEX STATUS",1,"Q")
+4 WRITE !," Errors Repaired: ",+$GET(^XTMP("YTS-RE-INDEX","ERRS")),!
+5 SET DIR(0)="YA^^"
+6 SET DIR("A")="Refresh? "
+7 SET DIR("B")="Yes"
+8 DO ^DIR
+9 IF $DATA(DIRUT)!$DATA(DIROUT)
SET Y=0
End DoDot:1
if 'Y
QUIT
+10 QUIT
