Annotation of freem_fileman/DIK.m, revision 1.1
1.1 ! snw 1: DIK ;SFISC/GFT,YJK,XAK-GATHER A FILE'S XREFS TO EXECUTE ;10/3/94 16:21
! 2: ;;21.0;VA FileMan;;Dec 28, 1994
! 3: ;Per VHA Directive 10-93-142, this routine should not be modified.
! 4: Q:'$D(@(DIK_"DA)")) Q:$P($G(^DD($$GLO^DILIBF(DIK),0,"DI")),U,2)["Y"&'$D(DIOVRD)&'$G(DIFROM) Q:DA'>0
! 5: N DIKJ,DIKS,DIKZ1,DIN,DH,DU,DV,DW,DIKDA
! 6: D CHKS I $D(DIKZ1) N DIKIL S DIKIL=1 G @DIKGP
! 7: S X=2 D DD G ^DIK1
! 8: ;
! 9: DD1 D D,A Q
! 10: ;
! 11: DD D DIKJ S DV=0 D D,A
! 12: E S DV=$O(^DD(DH,"SB",DV))
! 13: I DV>0 S DU=$O(^(DV,0)) G E:'$D(^DD(DV,.01,0)),E:$P(^(0),U,2)["W" S DW=$P($P(^DD(DH,DU,0),U,4),";") S:+DW'=DW DW=""""_DW_"""" S DV(DH,DU)=DW,DV(DH,DU,0)=DV,DU(DV)="" D:$D(DIK0) CRT^DIKZ2 G E
! 14: Q:$D(DIK0)
! 15: DH S DH=$O(DU(DH)) G:DH>0 DH:$D(DV(DH)),E
! 16: F DH=DH(1):0 S DH=$O(DU(DH)) Q:DH'>0 D D,A
! 17: S DH=DH(1),DU=1
! 18: DV I $O(^UTILITY("DIK",DIKJ,DH))>DH S DH=$O(DV(DH)) G DV:DH>0 Q
! 19: K K DV(DH) S DH=$O(DV(DH)) G K:DH>0 Q
! 20: ;
! 21: DW I $O(^UTILITY("DIK",DIKJ,DH,DV,0))="" K ^UTILITY("DIK",DIKJ,DH,DV)
! 22: D S DV=$O(^DD(DH,"IX",DV)) Q:DV'>0 I '$D(^DD(DH,DV,0)) K ^DD(DH,"IX",DV) G D
! 23: D 0
! 24: I F DW=0:0 S DW=$O(^DD(DH,DV,1,DW)) Q:DW'>0 I $D(^(DW,X)),"Q"'[^(X),$D(^(0)) S %=^(0) D INX
! 25: G DW
! 26: INX I %["TRIGGER" S %=^(X),^UTILITY("DIK",DIKJ,DH,DV,DW)="D RCR",^(DW,0)=% Q
! 27: I %["BULLETIN MESSAGE",$D(DIK(0)),DIK(0)["B" S %=$P("CREA^DELE",U,X)_"TE VALUE" W:$D(^(%)) !,"...('"_^(%)_"' BULLETIN WILL NOT BE TRIGGERED)..." Q
! 28: S ^UTILITY("DIK",DIKJ,DH,DV,DW)=^(X) Q
! 29: A F DV=0:0 S DV=$O(^DD(DH,"AUDIT",DV)) Q:DV'>0 D A1
! 30: Q
! 31: A1 D 0 S ^UTILITY("DIK",DIKJ,DH,DV,99)="S DIIX="_(4-X)_" D:$G(DIK(0))'[""A"" AUDIT" Q
! 32: 0 ;
! 33: S DW=$P(^DD(DH,DV,0),U,4),^UTILITY("DIK",DIKJ,DH,DV)=$P(DW,";",1),DW=$P(DW,";",2)
! 34: S ^UTILITY("DIK",DIKJ,DH,DV,0)=$S(DW:"S X=$P(^(X),U,"_DW_")",1:"S X=$E(^(X),"_+$E(DW,2,9)_","_$P(DW,",",2)_")"),DW=0 Q
! 35: ;
! 36: IX ;
! 37: N DIKJ,DIKS,DIKZ1,DIN,DH,DU,DV,DW,DIKDA
! 38: D CHKS I $D(DIKZ1) N DIKKS S DIKKS=1 G @DIKGP
! 39: S X=2,DIKNM=1 D DD,1^DIK1
! 40: IX1 ;
! 41: N DIKJ,DIKS,DIKZ1,DIN,DH,DU,DV,DW,DIKDA
! 42: I '$D(DIKNM) D CHKS I $D(DIKZ1) N DIKST S DIKST=1 G @DIKGP
! 43: S X=1 D DD,1^DIK1 G Q
! 44: ;
! 45: IXALL ;
! 46: N DIKJ,DIKS,DIKZ1,DIN,DH,DU,DV,DW,DIKDA
! 47: D CHKS I $D(DIKZ1) N DIKSAT S DIKSAT=1,DA=0 G @DIKGP
! 48: S (DA,DCNT)=0,X=1 D DD,CNT^DIK1 G Q
! 49: ;
! 50: EN ;
! 51: N DIKJ,DIKS,DIKZ1,DIN,DH,DU,DV,DW,DIKDA
! 52: D N G:'$D(DH)!'$D(DA) Q
! 53: S DIKNM=1,X=2 D PR,1^DIK1
! 54: ;
! 55: EN1 ;
! 56: N DIKJ,DIKS,DIKZ1,DIN,DH,DU,DV,DW,DIKDA
! 57: D @$S('$D(DIKNM):"N",1:"DIKJ") G:'$D(DH)!'$D(DA) Q
! 58: S X=1 D PR,1^DIK1 G Q
! 59: ;
! 60: ENALL ;
! 61: N DIKJ,DIKS,DIKZ1,DIN,DH,DU,DV,DW,DIKDA
! 62: D N G:'$D(DH) Q
! 63: S (DA,DCNT)=0,X=1 D PR,CNT^DIK1 G Q
! 64: ;
! 65: N Q:'$D(DIK)!'$D(DIK(1))!'$D(@(DIK_"0)")) D DIKJ S DIKND=$P(DIK(1),U)
! 66: I '$D(^DD(DH,"IX",DIKND)) K DH Q
! 67: I $P(DIK(1),U,2)="" S A1=1 F %=0:0 S %=$O(^DD(DH,DIKND,1,%)) Q:+%'>0 S DIKNX(A1)=%,A1=A1+1
! 68: E F A1=1:1 S DIKNX(A1)=$P(DIK(1),U,A1+1) I DIKNX(A1)="" K DIKNX(A1) Q
! 69: K A1,% Q
! 70: ;
! 71: PR S DV=DIKND I '$D(^DD(DH,"IX",DV)),'$D(^DD(DH,"AUDIT",DV)) Q
! 72: D 0 S DIKZ1=1 D CK K DIKZ1
! 73: D:$D(^DD(DH,"AUDIT",DV)) A1 S DU=1 Q
! 74: ;
! 75: CK Q:'$D(DIKNX(DIKZ1))
! 76: F DW=0:0 S DW=$O(^DD(DH,DV,1,DW)) Q:DW'>0 I $D(^(DW,0)),(DW=DIKNX(DIKZ1))!($P(^(0),U,2)=DIKNX(DIKZ1)),$D(^(X)),"Q"'[^(X) S %=^(0) D INX
! 77: S DIKZ1=DIKZ1+1 G CK
! 78: ;
! 79: FREE(X) N V S V=$G(^UTILITY("DIK",X)) I 'V Q 1
! 80: Q $H-1>V
! 81: ;
! 82: DIKJ F DIKJ=$J:.01 I $$FREE(DIKJ) K ^UTILITY("DIK",DIKJ) S ^UTILITY("DIK",DIKJ)=$H Q
! 83: INT K DIKS,DIN,DH,DU,DV,DW S U="^",DH=+$P(@(DIK_"0)"),U,2),DH(1)=DH Q
! 84: CHKS ;
! 85: I '$D(@(DIK_"0)"))#2 S DIKZ1=1,DIKGP="Q^DIK1" Q
! 86: S DIKZ1=+$P(^(0),"^",2) I DIKZ1,$D(^DD(DIKZ1,0,"DIK")),$$ROUEXIST^DILIBF(^("DIK")) S DIKGP="^"_^DD(DIKZ1,0,"DIK") Q
! 87: K DIKZ1 Q
! 88: ;
! 89: Q K DIKND,DIKNX,DIKZ1,DIKNM,DIAU,DIG,DIH,DIV,DIW,%,DH Q
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to DIK.m CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Coherent Logic Development] / freem_fileman