source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCMCLN.m@ 648

Last change on this file since 648 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.0 KB
Line 
1SCMCLN ;swo/oifobp temp clean up routine
2 ;;5.3;Scheduling;**498**;8.13.1993;Build 23
3 ;lets clean-up danglers in 404.43 PATIENT TEAM POSITION ASSIGNMENT
4 ;1st run thru 404.43 and find the pointers to 404.42 PATIENT TEAM ASSIGNMENT
5 ;pointer is piece one of 404.43
6 N CNT1,CNT2,DA,DIK,DIR,V1,V2,V3,V4,ZNODE
7 S (CNT1,CNT2)=0
8 W !,"Checking for ""Ghost Entries"" in the PATIENT TEAM POSITION ASSIGNMENT FILE."
9 W !,"This may take a moment. You will be provided with a list showing corrupted"
10 W !,"file entries. To perform a clean-up accept the ""Yes"" prompt after the list"
11 W !,"is displayed. Answer ""No"" to abort the clean-up.",!
12 S V1=0 F S V1=$O(^SCPT(404.43,V1)) Q:'V1 D
13 . S CNT1=CNT1+1
14 . S ZNODE=$G(^SCPT(404.43,V1,0))
15 . S V2=$P(ZNODE,U) Q:V2=""
16 . S V3=$G(^SCPT(404.42,V2,0)) I V3="" D LOG
17 D SHOW Q:POP
18 I $G(CNT2)<1 W !,"Nothing to clean up...." Q
19 S DIR("?")="Answerng Yes will perform a clean-up of the ghost entries"
20 S DIR("A")="Perform File Clean-Up"
21 S DIR(0)="Y",DIR("B")="No" D ^DIR
22 I Y D DEL
23 D CLEAN
24 Q
25LOG ;build a list in ^TMP("SCMCLN",$J
26 S ^TMP("SCMCLN",$J,V1)=""
27 S CNT2=CNT2+1
28 Q
29SHOW ;see what we got
30 S DIOEND="D FOOT^SCMCLN"
31 S DIC="^SCPT(404.43,",L=0,BY="@.03",(FR,TO)="",FLDS="[CAPTIONED]"
32 S BY(0)="^TMP(""SCMCLN"",$J,"
33 S L(0)=1 D EN1^DIP
34 Q
35DEL ;delete the danglers
36 ;check #404.48 -- PCMM HL7 EVENT FILE .07 field EVENT POINTER points to 404.43
37 ;variable pointer, yeck!
38 S DIK="^SCPT(404.43,"
39 S V1=0 F S V1=$O(^TMP("SCMCLN",$J,V1)) Q:'V1 D
40 .S V4=""""_V1_";SCPT(404.43,"_""""
41 .I $O(^SCPT(404.48,"AACXMIT",V4,"")) D Q ;
42 .. S ^TMP("SCMCLN2",$J,V1)=""
43 .. W !,"Pointer to HL7 EVENT file - the entry ("_V1_") was not deleted."
44 .S DA=V1
45 .D ^DIK
46 W !,"Clean-up completed",!
47 Q
48CLEAN ;clean-up
49 K ^TMP("SCMCLN",$J)
50 K ^TMP("SCMCLN2",$J)
51 Q
52FOOT ;footer message
53 W !,CNT1_" entries searched. Ghost entries found: "_CNT2
54 Q
55TEST ;
56 S X=0 F S X=$O(^SCPT(404.48,X)) Q:'X D
57 . Q:($P(^SCPT(404.48,X,0),U,7)'[404.43)
58 . W ^SCPT(404.43,$P($P(^SCPT(404.48,X,0),U,7),";"),0),!
59 . Q
Note: See TracBrowser for help on using the repository browser.