- DGRPTX35 ; ;10/30/24
- S X=DE(40),DIC=DIE
- ;
- S X=DE(40),DIC=DIE
- K DIV S DIV=X,D0=DA,DIV(0)=D0 X ^DD(2,.361,1,2,2.2) I DIV(1)>0 S DIK(0)=DA,DIK="^DPT(DIV(0),""E"",",DA(1)=DIV(0),DA=DIV(1) D ^DIK S DA=DIK(0) K DIK
- S X=DE(40),DIC=DIE
- X "I $S('$D(^DIC(8,+X,0)):0,$P(^(0),""^"",1)[""DOM"":0,'$D(^DPT(DA,.36)):1,'$D(^DIC(8,+^(.36),0)):1,$P(^(0),""^"",1)'[""DOM"":1,1:0) S DGXRF=.361 D ^DGDDC Q"
- S X=DE(40),DIC=DIE
- K ^DPT("AEL",DA,+X) I X=$$FIND1^DIC(8,"","B","COLLATERAL OF VET") D ARCHALL^DGRP1152U(DA)
- S X=DE(40),DIC=DIE
- D AUTOUPD^DGENA2(DA)
- S X=DE(40),DIIX=2_U_DIFLD D AUDIT^DIET
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGRPTX35 597 printed Apr 23, 2025@19:11:01 Page 2
- DGRPTX35 ; ;10/30/24
- +1 SET X=DE(40)
- SET DIC=DIE
- +2 ;
- +3 SET X=DE(40)
- SET DIC=DIE
- +4 KILL DIV
- SET DIV=X
- SET D0=DA
- SET DIV(0)=D0
- XECUTE ^DD(2,.361,1,2,2.2)
- IF DIV(1)>0
- SET DIK(0)=DA
- SET DIK="^DPT(DIV(0),""E"","
- SET DA(1)=DIV(0)
- SET DA=DIV(1)
- DO ^DIK
- SET DA=DIK(0)
- KILL DIK
- +5 SET X=DE(40)
- SET DIC=DIE
- +6 XECUTE "I $S('$D(^DIC(8,+X,0)):0,$P(^(0),""^"",1)[""DOM"":0,'$D(^DPT(DA,.36)):1,'$D(^DIC(8,+^(.36),0)):1,$P(^(0),""^"",1)'[""DOM"":1,1:0) S DGXRF=.361 D ^DGDDC Q"
- +7 SET X=DE(40)
- SET DIC=DIE
- +8 KILL ^DPT("AEL",DA,+X)
- IF X=$$FIND1^DIC(8,"","B","COLLATERAL OF VET")
- DO ARCHALL^DGRP1152U(DA)
- +9 SET X=DE(40)
- SET DIC=DIE
- +10 DO AUTOUPD^DGENA2(DA)
- +11 SET X=DE(40)
- SET DIIX=2_U_DIFLD
- DO AUDIT^DIET
