XUMF5I ;ISS/PAVEL - XUMF5 MD5 Hash Entry point ;5/19/06  06:15
 ;;8.0;KERNEL;**383,407**;July 10, 1995;Build 8
 ;
 ;MD5 based on info from 4.005 SORT BY VUID
 ;
 Q
EN(X0,MODE,IENCOUNT)  ;entry point to get MD5 algorithm
 ; Lookup uses AMASTERVUID for files and B x-ref for subfiles....
 ;
 ; X0 = IEN or name of entry from 4.005 file
 ; MODE = 0 regular mode.. last HASH value returned in Apl. ACK.
 ;        1 debugging mode.. all values + hash codess returned in Apl ACK
 ;        1.1 debugging mode.. all values (no hash codes) returned in Apl ACK
 ;        2 debugging mode.. all fields values, all hash values, all hash codes returned in Apl. ACK.
 ; IENCOUNT  = maximum entries for MD5 hash.. if NULL.. all entries counted...        
 ;
 ; TMP(sequence, def entry IEN, file/subfile #, field #)=""
 ; TMP1(,"1,120.82,2,",2)="INTERNAL"
 ; TMP2(FILE #,FIELD #)=""  if internal value requested...
 N X,Y,X1,X2,X3,X20,X201,X1NEW,X2NEW,X2OLD,X0NAME,XP,H,CNT,CNTT,CNHT,XMD5,XDATE,XXP
 N DIC,ERR,ROOT,ROOTX,ROOTB,ROOTB0,POINTER,JUMP,START,TMP,TMP1,TMP2,TMP3,TMP4,TMP5,TMP6,TMP7,FDA,VERSION
 N SLEV,LEV,IENS,VAL,VALUE,SORT,SORT1,EXITMD5
 N A,B,C,D,ABCD
 D INIT^XUMF5II S X1=0
2 F  S X1=$O(TMP(X1)) Q:'$$NEXTB1(LEV)!EXITMD5  S:'X1 X1=SLEV(LEV),X2OLD=0  S X2=$O(TMP(X1,X0,0)) Q:'X2  D
 .S (XP,JUMP)=0,XXP=$O(TMP(X1,X0,X2,0))
 .;************ File/subfile has changed ************
 .D:X2'=X2OLD
 ..;K ^TMP("UNIQUE",$J)
 ..;
 ..;************ File Level & Start ************
 ..I $D(^DIC(X2)),START D  Q
 ...S START=0,SLEV(1)=X1,X2OLD(1)=X2
 ...K ROOT,ROOTB,ROOTB0,X02,X021,TMP1
 ...S LEV=1,IENS=""
 ...D GETONE(LEV,X2)
 ..;
 ..;************ Going Up ************
 ..I $G(^DD(X2OLD,0,"UP"))=X2 D  Q
 ...K ^TMP("UNIQUE",$J,X2OLD)
 ...I $$NEXTB(LEV,X2OLD) S JUMP=2 Q
 ...K ROOT(LEV),ROOTB(LEV),ROOTB0(LEV),X20(LEV),X201(LEV),TMP1(LEV),X2OLD(LEV)
 ...S LEV=LEV-1,IENS=$P(IENS,",",$L(IENS,",")-LEV,9999),X2=X2OLD(LEV)
 ..Q:JUMP
 ..;
 ..;************ Going DOWN ************
 ..I $G(^DD(X2,0,"UP"))=X2OLD D  Q
 ...S LEV=LEV+1,SLEV(LEV)=X1,X2OLD(LEV)=X2
 ...D GETONE(LEV,X2)
 ..;
 ..;************ Same Level other multiple... ************
 ..I $G(^DD(X2,0,"UP"))=$G(^DD(X2OLD,0,"UP")),+$G(^DD(X2OLD,0,"UP")),+$G(^DD(X2,0,"UP")) D  Q
 ...I $$NEXTB(LEV,X2OLD) S JUMP=2 Q
 ...K ROOT(LEV),ROOTB(LEV),ROOTB0(LEV),X20(LEV),X201(LEV),TMP1(LEV),X2OLD(LEV)
 ...S IENS=$P(IENS,",",$L(IENS,",")-LEV+1,9999) ;B:'$L(IENS)
 ...S SLEV(LEV)=X1
 ...S X2OLD(LEV)=X2
 ...;S X2=X2OLD
 ...D GETONE(LEV,X2)
 ..Q:JUMP
 ..;
 ..;************ New File not start... ************
 ..I $D(^DIC(X2)) D  Q
 ...S:'$D(X2NEW) X2NEW=X2,X1NEW=X1
 ...I $$NEXTB(LEV,X2OLD(LEV)) S JUMP=2 Q
 ...K ROOT(LEV),ROOTB(LEV),ROOTB0(LEV),X20(LEV),X201(LEV),TMP1(LEV),SLEV(LEV),X2OLD(LEV)
 ...S IENS=$P(IENS,",",$L(IENS,",")-LEV+1,9999) ;B:'$L(IENS)
 ...I LEV=1 S (X1,SLEV(1))=X1NEW,(X2,X2OLD(1))=X2NEW K X1NEW,X2NEW D GETONE(LEV,X2) Q  ;;;;;;;;GET TO THE BOTTOM LEVEL = 1 NOT ANY OTHRER'S B X-REF
 ...S LEV=LEV-1,X1=SLEV(LEV)-1,X2=+$G(X2OLD(LEV-1)),XP=1
 ..;
 ..;************ Last sequence number ************
 ..I X2OLD=0 D  Q
21 ...I $$NEXTB(LEV,X2) S JUMP=2 Q
 ...K ROOT(LEV),ROOTB(LEV),ROOTB0(LEV),X20(LEV),X201(LEV),TMP1(LEV),X2OLD(LEV)
 ...Q:LEV=1
 ...S LEV=LEV-1,IENS=$P(IENS,",",$L(IENS,",")-LEV,9999),X2=X2OLD(LEV) ;,X1=SLEV(LEV)-1,XP=1
 ...G 21
 ..Q
 ..;
 .S X2OLD=X2
 .Q:JUMP
 .;************ Get value & MD5 ************
 .S X3=$O(TMP(X1+XP,X0,X2,0)) Q:'X3
 .S VAL=$S($L(IENS):$G(TMP1(LEV,X2,IENS,X3)),1:"")
 .Q:'$L(VAL)
 .D:$O(TMP1(LEV,X2,IENS,X3,0))
 ..N X4 S X4=0,VAL="" F  S X4=$O(TMP1(LEV,X2,IENS,X3,X4)) Q:'X4  S VAL=VAL_$G(TMP1(LEV,X2,IENS,X3,X4))
 .;If value set as uniqueue and already exist dont take it into MD5
 .Q:'$L(VAL)
 .I $G(TMP5(X2,X3)) Q:$D(^TMP("UNIQUE",$J,X2,X3,VAL))  S ^TMP("UNIQUE",$J,X2,X3,VAL)=""
 .D
 ..N X,TMP,I
 ..I X3=99.99,$D(^DIC(X2)) S CNTT=CNTT+1 I $G(IENCOUNT),CNTT>IENCOUNT S EXITMD5=1,CNTT=CNTT-1 Q
 ..D:MODE>1.99 SETACK("File #: "_X2_" Field #: "_X3_" Value: "_VAL_" IENS: "_IENS)
 ..S CNT=$G(CNT)+1
 ..S VALUE=VALUE_VAL
211 ..Q:$L(VALUE)<65
 ..S X=$E(VALUE,65,$L(VALUE)),VALUE=$E(VALUE,1,64)
 ..D:MODE
 ...D SETACK($S(MODE=1.1:"",1:"Value: ")_VALUE)
 ...D:MODE'=1.1 SETACK("HASH:  "_$$MAIN^XUMF5BYT($$HEX^XUMF5AU($$MD5E^XUMF5AU(ABCD,VALUE,0,CNHT+1*64))))
 ..S ABCD=$$MD5E^XUMF5AU(ABCD,VALUE,1)
 ..S VALUE=X,CNHT=CNHT+1
 ..G 211
 .Q
 G END^XUMF5II
 Q
GETONE(LEV,X2)     ;GET DATA
 S ROOT(LEV)=$$ROOT^DILFD(X2,"1,"_IENS,,"ERR")
 Q:'$L(ROOT(LEV))
 I $D(ERR) D  Q
 .S ERROR="1^MD5 ROOT retrieval error, File/Subfile #: "_X2_" IENS: 1,"_IENS,EXITMD5=1,JUMP=2
 .D EM^XUMFX("file DIE call error message in RDT",.ERR)
 .K ERR
 S ROOTX(LEV)=ROOT(LEV)_"X201(LEV))" ;FOR LOOKUP OF ENTRIES
 S SORT1="",SORT="B" S:$D(^DIC(X2)) SORT="AMASTERVUID",SORT1="1,"
 S ROOTB(LEV)=ROOT(LEV)_""""_SORT_""",X20(LEV))"
 S X20(LEV)="",ROOTB0(LEV)=ROOT(LEV)_""""_SORT_""",X20(LEV),"_SORT1_"X201(LEV))"
 S:SORT="B" POINTER=$G(TMP7(X2,XXP)) ;Pointer = pointer to file #
 I SORT="B",+POINTER D  ;Handle poiter type of subfile...
 .N BB S POINTER=$E(POINTER,2,$L(POINTER))
 .; ^TMP("PROOT",$J,Subfile #,IEN from up level,"Name sorted",IEN level)=""
 .; ^TMP("PROOT",$J,Subfile #,IEN from up level,X20(LEV),X201(LEV))=""
 .K ^TMP("PROOT",$J,X2)
 .;XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
 .S X201(LEV)=0 F  S X201(LEV)=$O(@(ROOTX(LEV)))  Q:'X201(LEV)  D
 ..I $G(TMP4(X2,XXP)) D  ; If  sort By VUID
 ...S BB=$$GET1^DIQ(X2,X201(LEV)_","_IENS,XXP,"I")     ;BB=IEN of poited to field
 ...S:BB BB=$$GET1^DIQ(TMP4(X2,XXP),BB_",",99.99,"E")  ;BB=VUID
 ..E  S BB=$$GET1^DIQ(X2,X201(LEV)_","_IENS,XXP,"E")   ; Else sort by .01    BB= .01
 ..S:$L(BB) ^TMP("PROOT",$J,X2,BB,X201(LEV))=""
 .;XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
 .S ROOTB(LEV)="^TMP(""PROOT"",$J,"_X2_",X20(LEV))"
 .S ROOTB0(LEV)="^TMP(""PROOT"",$J,"_X2_",X20(LEV),X201(LEV))"
 I SORT="B",LEV=2,X2=+$P(^DD(X2OLD(1),99.991,0),U,2) D  ;Handle Effective Date/Status multiple... only last date taken to HASH... TERMSTATUS
 .K ^TMP("PROOT",$J,X2)
 .S X20(LEV)=$O(@(ROOTB(LEV)),-1) ;Get last date..
 .Q:'$L(X20(LEV))  ;No Data in Effective Date Multiple.
 .S X201(LEV)=0,X201(LEV)=+$O(@ROOTB0(LEV))
 .Q:'X201(LEV)
 .S ROOTB(LEV)="^TMP(""PROOT"",$J,"_X2_",X20(LEV))"
 .S ROOTB0(LEV)="^TMP(""PROOT"",$J,"_X2_",X20(LEV),X201(LEV))"
 .S ^TMP("PROOT",$J,X2,X20(LEV),X201(LEV))=""
 S X20(LEV)=""
GET1 S X20(LEV)=$O(@(ROOTB(LEV))) Q:'$L(X20(LEV))  S X201(LEV)=0,X201(LEV)=$O(@(ROOTB0(LEV)))
 I $D(^DIC(X2)),'$$ACTIVE(X2,X201(LEV)_","_IENS) G GET1 ;If not active entry.. skip it..
 S IENS=X201(LEV)_","_IENS
 Q:'X201(LEV)
 D GETSIE(X2,IENS,LEV)
 Q
NEXTB(LEV,X2X)      ;Get next IEN from xref on current level.. if exist
 ;Is there other entry at current level to be proceeded..  ?? get next "B" x-ref set old X2 = NEW X2 and go to loop
 Q:'$D(X20(LEV)) 0
N1 Q:'$L(X20(LEV)) 0
 Q:'($O(@(ROOTB0(LEV)))!$L($O(@(ROOTB(LEV))))) 0
 S:X201(LEV) X201(LEV)=$O(@(ROOTB0(LEV))) ;Try get new IEN fron B-xref
 I 'X201(LEV) S X20(LEV)=$O(@(ROOTB(LEV))),X201(LEV)=0 S:$L(X20(LEV)) X201(LEV)=$O(@(ROOTB0(LEV)))
 Q:'X201(LEV) 0
 I $D(^DIC(X2X)),'$$ACTIVE(X2X,X201(LEV)_","_$P(IENS,",",2,99)) G N1 ;If not active entry.. skip it..
 S $P(IENS,",",1)=X201(LEV)
 S X2=X2X
 D GETSIE(X2,IENS,LEV)
 S X1=SLEV(LEV)-1,XP=1
 Q 1
NEXTB1(LEV)     ;See if some other entries in x-ref at any level exist...  no variable is set.
 ;
 Q:X1 1
3 Q:LEV=0 0
 I LEV>1,'$L($G(X20(LEV))) G 4
 I LEV=1,'$L($G(X20(LEV))) Q 0
 I LEV=1,'($O(@(ROOTB0(LEV)))!$L($O(@(ROOTB(LEV))))) Q 0
 I LEV=1,'$$ACTALL() Q 0
 I X201(LEV),$O(@(ROOTB0(LEV))) Q 1
 Q:$L($O(@(ROOTB(LEV)))) 1 ;
 Q:LEV=1 0
4 S LEV=LEV-1 G 3
 Q
SETACK(X,MODE)      ;SET APPL. Acknowledgment + WRIGHT ?? 
 W X,!
 S:$G(MODE) ^TMP("XUMF ERROR",$J,XMD5,$O(^TMP("XUMF ERROR",$J,XMD5,9999999999999),-1)+1)=X
 Q
UP(X) ;Upercase conversion    
 Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
ACTIVE(FILE,IEN)        ;GET 1 = Active 0 = Inactive
 N TMP,BB,X,X1,X2,XT,XX
 D GETS^DIQ(FILE,IEN,"99.991*","I","TMP","ERR")
 S (XT,XX)=0,X="TMP"
 F  S X=$Q(@(X)) Q:'$L(X)  S X1=$G(@(X)),X=$Q(@(X)),X2=$G(@(X)) S:X1>XT XT=X1,XX=+X2
 Q XX
GETSIE(X2,IENS,LEV)     ;GET Internal/External values + replace pointed field .01 with VUID
 K TMP1(LEV) D GETS^DIQ(X2,IENS,"*","","TMP1(LEV)")
 D:$D(TMP2(X2))!$D(TMP4(X2))
 .N TMP3,I
 .D GETS^DIQ(X2,IENS,"*","I","TMP3")
 .S I="" F  S I=$O(TMP2(X2,I)) Q:'I  S:$D(TMP1(LEV,X2,IENS,I)) TMP1(LEV,X2,IENS,I)=TMP3(X2,IENS,I,"I")
 .;+++++++++++++++ Replace pointed .01 field with VUID if indicate so in 4.005
 .S I="" F  S I=$O(TMP4(X2,I)) Q:'I  S:$D(TMP1(LEV,X2,IENS,I)) TMP1(LEV,X2,IENS,I)=$$GET1^DIQ(TMP4(X2,I),TMP3(X2,IENS,I,"I")_",",99.99)
 Q
ACTALL() ;See if there is some active entry on the file....
 N X1,X2,ACT
 S ACT=0,X1=X20(1),X2=X201(1)
 S:X20(1) X20(1)=X20(1)-.01
 F  S X20(1)=$O(@(ROOTB(1))) Q:'X20(1)!ACT  F  S X201(1)=$O(@(ROOTB0(1))) Q:'X201(1)  I $$ACTIVE(X2OLD(1),X201(1)) S ACT=1 Q
 S X20(1)=X1,X201(1)=X2
 Q ACT
 Q