;"=====================================================================
;"================================================================

ENV     ;Establish Routine Environment
        N DDH,DIR,X,Y,ZTENV,ZTKEY,ZTNAME,ZTSK,XUTMUCI
        D ENV^XUTMUTL Q:'$D(ZTENV)
        ;
        new DIC,X,Y
        set DIC=.401
        set DIC(0)="MAEQ"
        do ^DIC write !
        if +Y'>0 quit
        new templIEN set tempLIEN=+Y
        new IEN set IEN=""
        for  set IEN=$order(^DIBT(tempLIEN,1,IEN)) quit:IEN=""  do
        . do KILLTSK(IEN)

        quit


KILLTSK(ZTSK)
        ;"W !
        ;"S XUTMT(0)="AL"
        ;"D ^XUTMT
        I 'ZTSK K ^TMP($J,"XUTMT") Q
        ;"I ZTSK["-"!(ZTSK[",") D ^XUTMD1 Q:$D(DTOUT)  G SELECT
        S XUTMT=ZTSK,XUTMT(0)="R3"
        D ^XUTMT
        ;
STATUS  ;Report On Status Of Task And Whether User May Delete It
        I $D(ZTSK(.11))#2,ZTSK(.11)="UNDEFINED",$O(ZTSK(.3))="" W !!?5,"That task is not defined.",$C(7) G SELECT
        I $D(ZTSK(.11))#2,ZTSK(.11)="UNDEFINED",$O(ZTSK(.3))="TASK",$O(ZTSK("TASK"))="" W !!?5,"That task is running and has no record." G SELECT
        I $D(ZTSK(.11))#2,ZTSK(.11)="UNDEFINED" W !!?5,"That task is scheduled but has no record." G CONFIRM:ZTKEY G SELECT
        ;
S5      I $D(ZTSK(.11))#2,$O(ZTSK(.3))="" W !!?5,"That task's record is incomplete." G CONFIRM:ZTKEY G SELECT
        I $D(ZTSK(.11))#2,$O(ZTSK(.3))="TASK",$O(ZTSK("TASK"))="" W !!?5,"That task is running and has an incomplete record." G SELECT
        I $D(ZTSK(.11))#2 W !!?5,"That task is scheduled, but has an incomplete record." G CONFIRM:ZTKEY G SELECT
        ;
S9      I $O(ZTSK(.3))="TASK",$O(ZTSK("TASK"))="" W !!?5,"That task is running." G SELECT
        I 'ZTKEY,$S($P(ZTSK(0),U,11)_","_$P(ZTSK(0),U,12)=XUTMUCI:DUZ'=$P(ZTSK(0),U,3),1:ZTNAME'=$P(ZTSK(0),U,10)) W !!?5,"You may only delete your own tasks." G SELECT
        ;
CONFIRM ;Prompt User To Confirm Unscheduling
        I $S($D(ZTSK(.11))[0:1,1:ZTSK(.11)'="UNDEFINED") W ! D EN^XUTMTP(ZTSK)
        ;"W !
        ;"K DIR
        ;"S DIR(0)="Y"
        ;"S DIR("A")="Are you sure you want to delete this task"
        ;"S DIR("B")="NO"
        ;"S DIR("?")="     Answer YES to delete the task."
        ;"D ^DIR
        ;"I 'Y W !!?5,"Tasks NOT deleted!"
        ;"I $D(DTOUT) W $C(7) Q
        ;"K DIR,DIRUT,DTOUT,DUOUT
        ;"I 'Y G SELECT
        ;
DELETE  ;Delete Task
        I $D(ZTSK(0))#2,ZTSK(0)["ZTSK^XQ1",$P(ZTSK(0),U,11)_","_$P(ZTSK(0),U,12)=XUTMUCI,$P(ZTSK(0),U,8)]"" D
        . F DA=0:0 S DA=$O(^DIC(19.2,DA)) Q:DA'>0  I $G(^DIC(19.2,DA,1))=ZTSK D
        . . N DIE S DIE="^DIC(19.2,",DR="2///@;12///@" D ^DIE Q
        . Q
        S XUTMT=ZTSK,XUTMT(0)="D"
        D ^XUTMT
        W !!?5,"Deleted!"
        G SELECT
        ;

SELECT
        quit



FS1
        NEW X,Y,DIC
        SET DIC=1,DIC(0)="MAEQ"
        DO ^DIC WRITE !
        IF +Y'>0 QUIT
        NEW I SET I=""
        FOR  SET I=$ORDER(^TMG("TMGSIPH","NEEDED RECORDS",+Y,I)) QUIT:(I'>0)  DO
        . NEW NODE SET NODE=""
        . FOR  SET NODE=$ORDER(^TMG("TMGSIPH","NEEDED RECORDS",+Y,I,NODE)) QUIT:(NODE="")  DO
        . . KILL ^TMG("TMGSIPH","NEEDED RECORDS",+Y,I,NODE)
        . . SET ^TMG("TMGSIPH","NEEDED RECORDS",+Y,I,NODE,0)=""
        QUIT

KILLTMPL
        new X,Y,DIC
        set DIC=.401
        set DIC(0)="MAEQ"
        do ^DIC write !
        if +Y'>0 write "goodbye.",! quit
        NEW TMPL SET TMPL=+Y
        new file set file=$piece($get(^DIBT(TMPL,0)),"^",4)
        if file'=8925 do  quit
        . write "That file doesn't refer to file 8925.  That is all this function can work with!",!
        new % set %=2
        write "Delete all the records referred to in this sort template?" do YN^DICN write !
        if %'=1 write "goodbye.",! quit
        new MIN,MAX
        set MIN=$ORDER(^DIBT(TMPL,1,0))
        set MAX=$ORDER(^DIBT(TMPL,1,""),-1)
        new TMGCT set TMGCT=0
        new STIME set STIME=$H
        new TMGIEN set TMGIEN=0
        for  set TMGIEN=$ORDER(^DIBT(TMPL,1,TMGIEN)) quit:(+TMGIEN'>0)  do
        . ;"write TMGIEN,! quit
        . new TMGFDA set TMGFDA(8925,TMGIEN_",",.01)="@"
        . ;"new TMGFDA set TMGFDA(8925,TMGIEN_",",.05)="COMPLETED"
        . new TMGMSG
        . do FILE^DIE("E","TMGFDA","TMGMSG")
        . NEW RPTR SET RPTR=+$GET(^TMG("TMGSIPH","DOWNLOADED",8925,TMGIEN))
        . KILL ^TMG("TMGSIPH","DOWNLOADED",8925,TMGIEN)
        . KILL ^TMG("TMGSIPH","PT XLAT",8925,RPTR)
        . do ShowIfDIERR^TMGDEBUG(.TMGMSG)
        . set TMGCT=TMGCT+1
        . if TMGCT>50 do
        . . do ProgressBar^TMGUSRIF(TMGIEN,"Deleting records",MIN,MAX,70,STIME)
        . . set TMGCT=0
        write "goodbye.",!
        quit


FIXXREF ;
        NEW FILENUM SET FILENUM=0
        FOR  SET FILENUM=$ORDER(^TMG("TMGSIPH","PT XLAT",FILENUM)) QUIT:(+FILENUM'>0)  DO
        . NEW RPTR SET RPTR=0
        . FOR  SET RPTR=$ORDER(^TMG("TMGSIPH","PT XLAT",FILENUM,RPTR)) QUIT:(+RPTR'>0)  DO
        . . NEW LPTR SET LPTR=+$GET(^TMG("TMGSIPH","PT XLAT",FILENUM,RPTR))
        . . IF LPTR'>0 WRITE "FILE ",FILENUM,",  REMOTE IEN=",RPTR," --> ?? LOCAL PTR",! QUIT
        . . IF $DATA(^TMG("TMGSIPH","DOWNLOADED",FILENUM,LPTR))=0 DO  QUIT
        . . . WRITE "FILE ",FILENUM,",  LOCAL IEN=",LPTR," --> Not downloaded??",!
        . . SET ^TMG("TMGSIPH","DOWNLOADED",FILENUM,LPTR)=RPTR
        . . WRITE "Set ",$NAME(^TMG("TMGSIPH","DOWNLOADED",FILENUM,LPTR)),"=",RPTR,!
        quit


 ;"    ; Note: ENTRY=DataPiece^PointedToFile^PointedToReference^IENDepth^[V]
 ;"    ; ONEREF will have multiple IEN entries if IENDepth>1, e.g. '^SC(IEN,"S",IEN(2),1,IEN(3),"C")'
 ;"    ;        with order of IEN, IEN(2), IEN(3), ... etc.
FIXSUBFILES ;
        NEW FILENUM SET FILENUM=0
        NEW ABORT SET ABORT=0
        FOR  SET FILENUM=$ORDER(^TMG("TMGSIPH","DOWNLOADED",FILENUM)) QUIT:(+FILENUM'>0)!ABORT  DO
        . NEW TMP SET TMP=$$HASPTRSF^TMGFMUT2(FILENUM)
        . IF TMP DO
        . . WRITE "FILE ",FILENUM," has pointer subfiles.... probably needs fix.",!
        . . ;"IF $$DDOK^TMGSIPH1(JNUM,FILENUM)
        . . IF $$SETPTOUT^TMGSIPH1(FILENUM)
        . . NEW ONEREF SET ONEREF=""
        . . FOR  SET ONEREF=$ORDER(^TMG("TMGSIPH","DD",FILENUM,"PTR OUT",ONEREF)) QUIT:(ONEREF="")!ABORT  DO
        . . . ;"WRITE "ONEREF=",ONEREF,!
        . . . NEW ENTRY SET ENTRY=""
        . . . FOR  SET ENTRY=$ORDER(^TMG("TMGSIPH","DD",FILENUM,"PTR OUT",ONEREF,ENTRY)) QUIT:(ENTRY="")!ABORT  DO
        . . . . NEW IENDEPTH SET IENDEPTH=$PIECE(ENTRY,"^",4)
        . . . . IF IENDEPTH=1 QUIT
        . . . . NEW PCE SET PCE=+ENTRY
        . . . . ;"WRITE "  ENTRY=",ENTRY,!
        . . . . NEW IEN SET IEN=0
        . . . . NEW GREF SET GREF=^DIC(FILENUM,0,"GL") QUIT:(GREF="")
        . . . . NEW CGREF SET CGREF=$$CREF^DILF(GREF)
        . . . . FOR  SET IEN=$ORDER(@CGREF@(IEN)) QUIT:(+IEN'>0)!ABORT  DO
        . . . . . FOR  QUIT:($$IENCOMBO^TMGFMUT2(ONEREF,IENDEPTH,.IEN)'=1)!ABORT  DO
        . . . . . . SET ABORT=$$UserAborted^TMGUSRIF QUIT:ABORT
        . . . . . . NEW TMPREF SET TMPREF=$NAME(@ONEREF)  ;"Puts IEN's from IEN array into name.
        . . . . . . NEW IENS SET IENS=$$GETIENS^TMGFMUT2(.IEN)
        . . . . . . IF $GET(^TMG("TMGSIPH","FIX",FILENUM,TMPREF))'="" QUIT ;"Already fixed.
        . . . . . . NEW FROMFILE SET FROMFILE=$PIECE(ENTRY,"^",6)
        . . . . . . NEW PT SET PT=$PIECE($GET(@TMPREF),"^",PCE) ;"$$IENCOMBO sets up IEN(n).. needed for @REF
        . . . . . . NEW ISVIRT SET ISVIRT=($PIECE(ENTRY,"^",5)="V")
        . . . . . . NEW P2REF SET P2REF=$PIECE(ENTRY,"^",3)
        . . . . . . IF ISVIRT,$PIECE(PT,";",2)'=P2REF QUIT ;"Loop to handle PTR with different ENTRY (V-Ptrs stored as IEN;OREF)
        . . . . . . SET PT=+PT QUIT:(PT'>0)
        . . . . . . NEW P2FILE SET P2FILE=$PIECE(ENTRY,"^",2)
        . . . . . . NEW FROMFLD SET FROMFLD=$PIECE(ENTRY,"^",7)
        . . . . . . NEW LPTR SET LPTR=$GET(^TMG("TMGSIPH","PT XLAT",P2FILE,PT),"??")
        . . . . . . WRITE "FILENUM: ",FILENUM," IENS=",IENS," ",TMPREF," --> PTR=",PT," in file: ",P2FILE," LPTR=",LPTR,!
        . . . . . . IF LPTR'="??" DO
        . . . . . . . IF (PT'=LPTR) SET $PIECE(@TMPREF,"^",PCE)=LPTR
        . . . . . . . SET ^TMG("TMGSIPH","FIX",FILENUM,TMPREF)=PT   ;"Store old value just in case...
        . . . . . . ELSE  DO
        . . . . . . . SET ^TMG("TMGSIPH","NEEDED RECORDS","PTOUT",P2FILE,PT,TMPREF,ENTRY)=""
        . . . . . . . ;"IF $$NEEDPTIN^TMGSIPH3(FILENUM) DO
        . . . . . . . ;". SET ^TMG("TMGSIPH","NEEDED RECORDS","PTIN",FILENUM,)=""
        . . . . . NEW TMPIEN SET TMPIEN=IEN KILL IEN SET IEN=TMPIEN ;"delete subnodes in array.
        do PRESSTOCONT^TMGUSRIF
        quit


 ;"    ; Note: ENTRY=DataPiece^PointedToFile^PointedToReference^IENDepth^[V]
 ;"    ; ONEREF will have multiple IEN entries if IENDepth>1, e.g. '^SC(IEN,"S",IEN(2),1,IEN(3),"C")'
 ;"    ;        with order of IEN, IEN(2), IEN(3), ... etc.
FIXDDSUBFILES ;
        NEW FILENUM SET FILENUM=0
        NEW ABORT SET ABORT=0
        FOR  SET FILENUM=$ORDER(^TMG("TMGSIPH","DOWNLOADED",FILENUM)) QUIT:(+FILENUM'>0)!ABORT  DO
        . ;"NEW TMP SET TMP=$$HASPTRSF^TMGFMUT2(FILENUM)
        . ;"IF TMP DO
        . WRITE "FILE ",FILENUM," has had DD reset.",!
        . IF $$SETPTOUT^TMGSIPH1(FILENUM)
        do PRESSTOCONT^TMGUSRIF
        quit


FTIU
        new IEN set IEN=0
        for  set IEN=$O(^TIU(8925,IEN)) q:(+IEN'>0)  if $D(^TIU(8925,IEN,"TEMP")) do
        . write IEN
        . if $D(^TIU(8925,IEN,"TEXT"))=0 do  quit
        . . write "NO TEXT"
        . . merge ^TIU(8925,IEN,"TEXT")=^TIU(8925,IEN,"TEMP")
        . . kill ^TIU(8925,IEN,"TEMP")
        . . write " -- FIXED",!
        . new SAME set SAME=1
        . new j set j=0
        . for  set j=$o(^TIU(8925,IEN,"TEMP",j)) quit:(+j'>0)!(SAME=0)
        . . if $G(^TIU(8925,IEN,"TEMP",j,0))'=$G(^TIU(8925,IEN,"TEXT",j,0)) set SAME=0
        . write " --> SAME=",SAME
        . if SAME kill ^TIU(8925,IEN,"TEMP") write "  FIXED."
        . write !
        quit

CKREC
         ;"^TMG("TMGSIPH","PT XLAT",FILENUM,RemoteIEN)=LocalIEN
        NEW DIC,X,Y
        SET DIC(0)="MAEQ"
        SET DIC=1
        DO ^DIC WRITE !
        IF +Y'>0 QUIT
        NEW ARRAY
        NEW OVERLAP
        SET OVERLAP=$$CKREC1F(+Y,.ARRAY)
        IF OVERLAP DO
        . WRITE "FILE #",+Y," has ",OVERLAP," overlapping records.",!
        QUIT


CKALLREC
        NEW FILENUM SET FILENUM=0
        NEW ARRAY
        FOR  SET FILENUM=$ORDER(^TMG("TMGSIPH","DOWNLOADED",FILENUM)) QUIT:(+FILENUM'>0)  DO
        . NEW OVERLAP
        . write "Checking file #",FILENUM,"..."
        . SET OVERLAP=$$CKREC1F(FILENUM,.ARRAY)
        . WRITE "FILE #",FILENUM," has ",OVERLAP," overlapping records.",!
        MERGE ^TMG("TMGSIPH","OVERLAP")=ARRAY
        QUIT


CKREC1F(FILENUM,ARRAY)
        NEW CT SET CT=0
        NEW RPTR,LPTR
        SET RPTR=0
        FOR  SET RPTR=$ORDER(^TMG("TMGSIPH","PT XLAT",FILENUM,RPTR)) QUIT:(+RPTR'>0)  DO
        . SET LPTR=$GET(^TMG("TMGSIPH","PT XLAT",FILENUM,RPTR)) QUIT:LPTR=""
        . SET ARRAY(FILENUM,LPTR,RPTR)=""
        . SET CT=CT+1
        . IF CT#100=0 WRITE "." SET CT=0
        ;"Now delete all entries that are not doubled up.
        SET LPTR=0
        FOR  SET LPTR=$ORDER(ARRAY(FILENUM,LPTR)) QUIT:(LPTR="")  DO
        . NEW REF SET REF=$NAME(ARRAY(FILENUM,LPTR))
        . SET CT=$$ListCt^TMGMISC(REF)
        . IF CT=1 KILL @REF
        write !
        QUIT $$ListCt^TMGMISC($NAME(ARRAY(FILENUM)))


SUMM
        NEW FILENUM SET FILENUM=0
        FOR  SET FILENUM=$ORDER(^TMG("TMGSIPH","OVERLAP",FILENUM)) QUIT:FILENUM=""  DO
        . NEW FNAME SET FNAME=$PIECE($GET(^DIC(FILENUM,0)),"^",1)
        . NEW REF SET REF=$NAME(^TMG("TMGSIPH","OVERLAP",FILENUM))
        . WRITE "FILE [",FNAME,"] has ",$$ListCt^TMGMISC(REF)," overlapping records",!
        quit


COMPRPC
        NEW DIC,X,Y
        NEW OPTION1,OPTION2
        SET DIC=19,DIC(0)="MAEQ"
        WRITE "First pick the OLDER entry to compaire",!
        DO ^DIC WRITE !
        IF Y=-1 GOTO CPRDN
        SET OPTION1=+Y
        WRITE !,"Now, pick the NEWER entry to compare",!
        DO ^DIC WRITE !
        IF Y=-1 GOTO CPRDN
        SET OPTION2=+Y
        NEW ARRAY1,ARRAY2
        NEW IEN
        SET IEN=0
        FOR  SET IEN=$ORDER(^DIC(19,OPTION1,"RPC",IEN)) QUIT:(+IEN'>0)  DO
        . NEW PRPC
        . SET PRPC=+$GET(^DIC(19,OPTION1,"RPC",IEN,0))
        . NEW NAME SET NAME=$PIECE($GET(^XWB(8994,PRPC,0)),"^",1)
        . IF NAME="" WRITE IEN," --> ??",!
        . ELSE  SET ARRAY1(NAME,IEN)=""

        SET IEN=0
        FOR  SET IEN=$ORDER(^DIC(19,OPTION2,"RPC",IEN)) QUIT:(+IEN'>0)  DO
        . NEW PRPC
        . SET PRPC=+$GET(^DIC(19,OPTION2,"RPC",IEN,0))
        . NEW NAME SET NAME=$PIECE($GET(^XWB(8994,PRPC,0)),"^",1)
        . IF NAME="" WRITE IEN," --> ??",!
        . ELSE  SET ARRAY2(NAME,IEN)=""

        NEW NAME SET NAME=""
        FOR  SET NAME=$ORDER(ARRAY1(NAME)) QUIT:(NAME="")  DO
        . IF $DATA(ARRAY2(NAME)) DO
        . . WRITE "Both have: ",NAME,!
        . . KILL ARRAY1(NAME),ARRAY2(NAME)

        NEW TEMP
        WRITE "OK.  Here are the entries in the OLDER option, not present in the new one.",!
        IF $DATA(ARRAY1) ZWR ARRAY1
        else  write "(none)",!

        DO PRESSTOCONT^TMGUSRIF

        WRITE "OK.  Here are the entries in the NEWER option, not present in the old one.",!
        IF $DATA(ARRAY2) ZWR ARRAY2
        else  write "(none)",!

        DO PRESSTOCONT^TMGUSRIF

CPRDN   WRITE "GOODBYE",!
        QUIT

IHS
        new IEN set IEN=0
        for  set IEN=$order(^DPT(IEN)) quit:(+IEN'>0)  do
        . if $data(^AUPNPAT(IEN))'=0 write "." quit
        . write "Missing data for IEN=",IEN,!
        . set ^TMG("TMGSIPH","NEEDED RECORDS","PTIN",9000001,IEN)=""
        . kill ^TMG("TMGSIPH","PT XLAT",9000001,IEN)
        quit

IHS2
        new IEN set IEN=0
        new Ct set Ct=0
        new DIK set DIK="^AUPNPAT("
        new DA
        new matched set matched=0
        new ABORT set ABORT=0
        for  set IEN=$order(^AUPNPAT(IEN)) quit:(+IEN'>0)!ABORT  do
        . set ABORT=$$UserAborted^TMGUSRIF
        . new P2 set P2=$P($G(^AUPNPAT(IEN,0)),"^",1)
        . if $data(^DPT(IEN))=0 do  quit
        . . write "!"
        . . set Ct=Ct+1
        . . set DA=IEN
        . . do ^DIK
        . if IEN=P2 write "." set matched=matched+1 quit
        . write !,IEN,"  ",P2,!
        write !,Ct," extra records",!
        write matched," matched records",!
        quit

IHS3
        new IEN set IEN=0
        for  set IEN=$order(^TMG("TMGSIPH","PT XLAT",9000001,IEN)) QUIT:(IEN'>0)  DO
        . NEW PT SET PT=$GET(^TMG("TMGSIPH","PT XLAT",9000001,IEN))
        . if PT=0 kill ^TMG("TMGSIPH","PT XLAT",9000001,IEN) quit
        . if PT'=IEN write "MISMATCH IEN ",IEN,"=",PT,!
        write "goodbye",!
        quit