| 1 | SDPURG2 ;ALB/TMP - Purge-Print Routine - Patient File nodes ; 12/24/85
|
|---|
| 2 | ;;5.3;Scheduling;;Aug 13, 1993
|
|---|
| 3 | S SDCT=0
|
|---|
| 4 | W !,"Begin purge of Patient File nodes" S Y=% D DT^DIQ
|
|---|
| 5 | S (B,SDCT)=0 F A=0:0 S B=$N(^DPT("ASDPSD",B)) W:B=-1 !,SDCT," SPECIAL SURVEY XREFS PURGED",!!,"End of Patient File purge" Q:B=-1 D DEL2,DOT
|
|---|
| 6 | G END^SDPURG1
|
|---|
| 7 | DOT W:'(SDCT#100)&('SDPR) "."
|
|---|
| 8 | Q
|
|---|
| 9 | DEL2 I B'["B",B'["C" F C=0:0 S C=$N(^DPT("ASDPSD",B,C)) Q:C'>0!(C'<SDLIM1) S X="^DPT(""ASDPSD"","""_B_""","_C_")" D PRT K @X D CT
|
|---|
| 10 | I B["B" S D=0 F C=0:0 S D=$N(^DPT("ASDPSD",B,D)) Q:D=-1 F E=0:0 S E=$N(^DPT("ASDPSD",B,D,E)) Q:E'>0!(E'<SDLIM1) D MORE2 S X="^DPT(""ASDPSD"","""_B_""","""_D_""","_E_")" K @X
|
|---|
| 11 | S D=0
|
|---|
| 12 | I B["C" F C=0:0 S D=$N(^DPT("ASDPSD",B,D)) Q:D<0 S E=-1 F E1=0:0 S E=$N(^DPT("ASDPSD",B,D,E)) Q:E<0 F F=0:0 S F=$N(^DPT("ASDPSD",B,D,E,F)) Q:F<0!(F'<SDLIM1) D MORE1 S X="^DPT(""ASDPSD"","""_B_""","""_D_""","_G_","_F_")" K @X
|
|---|
| 13 | Q
|
|---|
| 14 | MORE1 S G=$S(E:E,1:""""_E_"""") Q:'SDPR F I=0:0 S I=$N(^DPT("ASDPSD",B,D,E,F,I)) Q:I'>0 S X="^DPT(""ASDPSD"","""_B_""","""_D_""","_G_","_F_","_I_")" D PRT D CT
|
|---|
| 15 | Q
|
|---|
| 16 | MORE2 Q:'SDPR F I=0:0 S I=$N(^DPT("ASDPSD",B,D,E,I)) Q:I'>0 S Y=+^(I) I 'Y!(Y>6) K Y S X="^DPT(""ASDPSD"","""_B_""","""_D_""","_E_","_I_")" D PRT D CT
|
|---|
| 17 | Q
|
|---|
| 18 | PRT I SDPR W:$S(($D(@X)#2):1,1:0) !,X," = ",@X
|
|---|
| 19 | Q
|
|---|
| 20 | CT S SDCT=SDCT+1 Q
|
|---|
