| 1 | ONCOU ;Hines OIFO/GWB - ONCOLOGY UTILITY CALLS ;06/06/00
|
|---|
| 2 | ;;2.11;ONCOLOGY;**5,25,26,43**;Mar 07, 1995
|
|---|
| 3 | ;
|
|---|
| 4 | ASKNUM(TXT,RNG,DFLT) ;ask for a number - expects RNG as NNN:NNN
|
|---|
| 5 | N DIR,Y S DIR(0)="N^"_RNG,DIR("A")=TXT S:$D(DFLT) DIR("B")=DFLT D ^DIR Q Y
|
|---|
| 6 | ASKY(TXT) ;ask a Y/N question, default YES, returns 1 for Y, 0 for N
|
|---|
| 7 | N DIR,Y S DIR("A")=TXT,DIR(0)="Y",DIR("B")="Yes" D ^DIR S:Y=U Y=-1 Q Y
|
|---|
| 8 | LOOKUP(FL,NTR,UIO,Y) ;look up entry NTR in File FL with user options UIO, return Y array if parameter passed
|
|---|
| 9 | N DIC,Y S DIC=FL,DIC(0)=$G(UIO),X=NTR D ^DIC Q +Y
|
|---|
| 10 | GETVAL(FN,DA,DR,SE,SF) ;get value of field DR in entry DA in file FN - if DR is a multiple then get subfield SF in subentry SE
|
|---|
| 11 | N DI,DIC,DIQ,OQ,OX,D0 S DIC=FN,DIQ="OQ",OX=+$P(^DD(FN,DR,0),U,2) S:OX DA(OX)=SE,DR(OX)=SF D EN^DIQ1 Q $S(OX:OQ(OX,SE,SF),1:OQ(FN,DA,DR))
|
|---|
| 12 | VERSION(PKG) ;get version # for pkg
|
|---|
| 13 | N PNU,Y S PNU=+$O(^DIC(9.4,"B",PKG,"")),Y=$G(^DIC(9.4,PNU,"VERSION")) Q Y
|
|---|
| 14 | VERCHK(PKG,VER,PATNO) ;verify version for a patch
|
|---|
| 15 | N INST,OK S OK=0 ; assume the worst
|
|---|
| 16 | W !!,"This routine will install ",PKG," Version ",VER," Patch ",PATNO,".",!!
|
|---|
| 17 | S INST=$$VERSION(PKG)
|
|---|
| 18 | I INST="" W *7,"But the ",PKG," package doesn't seem to be installed on this system!"
|
|---|
| 19 | E I INST'=VER W *7,"But Version ",VER," of the ",PKG," package doesn't seem to be installed!" W:INST !,"(Current installed version: ",INST,")"
|
|---|
| 20 | E S OK=1
|
|---|
| 21 | Q OK
|
|---|
| 22 | SITEPAR(MSG) ;Are ONCOCOLOGY SITE PARAMETERS defined?
|
|---|
| 23 | N OK
|
|---|
| 24 | S OK=$O(^ONCO(160.1,"C",DUZ(2),0))
|
|---|
| 25 | I OK="" S OK=$O(^ONCO(160.1,0))
|
|---|
| 26 | I 'OK,$G(MSG)="ERRMSG" W !!,"The ONCOLOGY SITE PARAMETERS have not been set up.",!,"Use the ""Define Tumor Registry Parameters"" Option.",!!
|
|---|
| 27 | Q OK
|
|---|
| 28 | LTS(DA,NOTTHIS) ;Invoked by AC cross-reference of TUMOR STATUS CODE sub-field (#.02) of TUMOR STATUS field (#73) of ONCOLOGY PRIMARY file (#165.5), sets value into LAST TUMOR STATUS field (#95)
|
|---|
| 29 | ;NOTTHIS is defined in the KILL logic - we want to skip the current TUMOR STATUS
|
|---|
| 30 | N OX,DIE,DR,NTS,OTS
|
|---|
| 31 | S NTS="" ; new tumor status defaults to null
|
|---|
| 32 | S OX=$O(^ONCO(165.5,DA,"TS","AA","")) I OX,$D(NOTTHIS),$D(^ONCO(165.5,DA,"TS","AA",OX,NOTTHIS)) S OX=$O(^ONCO(165.5,DA,"TS","AA","")) ; get IEN of last status - skip the current node on the kill
|
|---|
| 33 | S:OX OX=$O(^(OX,"")) S:OX NTS=$P($G(^ONCO(165.5,DA,"TS",OX,0)),U,2) S OTS=$P($G(^ONCO(165.5,DA,7)),U,6),$P(^(7),U,6)=NTS ;get old data, set new data
|
|---|
| 34 | K:$L(OTS) ^ONCO(165.5,"ACS",OTS,DA) S:$L(NTS) ^ONCO(165.5,"ACS",NTS,DA)="" ;kill old xref, set new xref
|
|---|
| 35 | Q
|
|---|
| 36 | ;
|
|---|
| 37 | KILLNAT(FILE,SWS) ;Kill national fields only for a file
|
|---|
| 38 | ;Valid switches in SWS:/DOTS prints a dot every 10
|
|---|
| 39 | N DOTS,DA,DIK,KT
|
|---|
| 40 | S DOTS=(SWS["/DOTS") ;print dots?
|
|---|
| 41 | S DA(1)=FILE
|
|---|
| 42 | I $D(^DD(FILE)) S DIK="^DD("_FILE_",",DA=0 F KT=1:1 S DA=$O(^DD(FILE,DA)) Q:'DA!(DA'<10000) D ^DIK I DOTS W:KT#10=0 "." ;if file exists, kill national fields only
|
|---|
| 43 | Q +$G(KT)
|
|---|
| 44 | ;
|
|---|
| 45 | CLNNOSUS ;Delete ONCOLOGY PATIENT (160) entries with no primaries/no suspense
|
|---|
| 46 | N TOTKT,CLNKT
|
|---|
| 47 | W @IOF
|
|---|
| 48 | W !
|
|---|
| 49 | W !," This option will purge ONCOLOGY PATIENT records"
|
|---|
| 50 | W !," with no suspense records and no primaries."
|
|---|
| 51 | W !
|
|---|
| 52 | L +^ONCO(160):5
|
|---|
| 53 | I D
|
|---|
| 54 | .K ^TMP($J,"NOSUS")
|
|---|
| 55 | .D COUNT
|
|---|
| 56 | .I CLNKT=0 W " No records to purge" W ! K DIR S DIR(0)="E" D ^DIR
|
|---|
| 57 | .I CLNKT>0,$$CLNOK D PURGE
|
|---|
| 58 | .L -^ONCO(160)
|
|---|
| 59 | E W !!,"The ONCOLOGY PATIENT file is in use... try again later!",*7,!!
|
|---|
| 60 | Q
|
|---|
| 61 | ;
|
|---|
| 62 | COUNT ;Count the number of entries to delete
|
|---|
| 63 | N OI S OI=0
|
|---|
| 64 | S (TOTKT,CLNKT)=0
|
|---|
| 65 | F S OI=$O(^ONCO(160,OI)) Q:OI'=+OI D CHK
|
|---|
| 66 | W !," Total ONCOLOGY PATIENT records: ",TOTKT
|
|---|
| 67 | W !," Total records marked for deletion: ",CLNKT,!
|
|---|
| 68 | I CLNKT>0 W !," Patients to be deleted:" S IEN=0 F S IEN=$O(^TMP($J,"NOSUS",IEN)) Q:IEN'>0 D
|
|---|
| 69 | .W !,?3,$$GET1^DIQ(160,IEN,60,"E")," ",$$GET1^DIQ(160,IEN,.01,"E")
|
|---|
| 70 | W !
|
|---|
| 71 | Q
|
|---|
| 72 | ;
|
|---|
| 73 | CHK S TOTKT=TOTKT+1
|
|---|
| 74 | S SUSDT=$O(^ONCO(160,OI,"SUS","B","")) I SUSDT'="" Q
|
|---|
| 75 | I $D(^ONCO(165.5,"C",OI)) Q
|
|---|
| 76 | I '$D(^ONCO(160,OI,0)) K ^ONCO(160,OI) Q
|
|---|
| 77 | S CLNKT=CLNKT+1
|
|---|
| 78 | S ^TMP($J,"NOSUS",OI)=""
|
|---|
| 79 | Q
|
|---|
| 80 | ;
|
|---|
| 81 | CLNOK() ;Confirm that it's OK to purge
|
|---|
| 82 | N DIR
|
|---|
| 83 | S DIR("A")=" Proceed with purge",DIR("B")="No",DIR(0)="Y"
|
|---|
| 84 | D ^DIR
|
|---|
| 85 | Q Y
|
|---|
| 86 | ;
|
|---|
| 87 | PURGE ;Delete entries
|
|---|
| 88 | N DIK S DIK="^ONCO(160,"
|
|---|
| 89 | N DA S DA=0
|
|---|
| 90 | F S DA=$O(^TMP($J,"NOSUS",DA)) Q:DA'=+DA D ^DIK W "."
|
|---|
| 91 | W " DONE"
|
|---|
| 92 | W ! K DIR S DIR(0)="E" D ^DIR
|
|---|
| 93 | Q
|
|---|
| 94 | ;
|
|---|
| 95 | LCASE(ONCOSTR) ;Convert string to upper/lowercase
|
|---|
| 96 | N ONCO F ONCO=2:1:$L(ONCOSTR) I $E(ONCOSTR,ONCO)?1U,$E(ONCOSTR,ONCO-1)?1A S ONCOSTR=$E(ONCOSTR,0,ONCO-1)_$C($A(ONCOSTR,ONCO)+32)_$E(ONCOSTR,ONCO+1,999)
|
|---|
| 97 | Q ONCOSTR
|
|---|
| 98 | UCASE ;Convert string to uppercase
|
|---|
| 99 | S X=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
|
|---|
| 100 | Q
|
|---|
