| 1 | SCMCLN ;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
|
|---|
| 25 | LOG ;build a list in ^TMP("SCMCLN",$J
|
|---|
| 26 | S ^TMP("SCMCLN",$J,V1)=""
|
|---|
| 27 | S CNT2=CNT2+1
|
|---|
| 28 | Q
|
|---|
| 29 | SHOW ;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
|
|---|
| 35 | DEL ;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
|
|---|
| 48 | CLEAN ;clean-up
|
|---|
| 49 | K ^TMP("SCMCLN",$J)
|
|---|
| 50 | K ^TMP("SCMCLN2",$J)
|
|---|
| 51 | Q
|
|---|
| 52 | FOOT ;footer message
|
|---|
| 53 | W !,CNT1_" entries searched. Ghost entries found: "_CNT2
|
|---|
| 54 | Q
|
|---|
| 55 | TEST ;
|
|---|
| 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
|
|---|
