Changeset 623 for WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMTMED.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMTMED.m
r613 r623 1 PXRMTMED ; SLC/PKR/PJH - Edit a reminder term. ;04/18/2007 2 ;;2.0;CLINICAL REMINDERS;**1,4,6**;Feb 04, 2005;Build 123 3 ; 4 ;======================================================= 5 N CS1,CS2,DA,DIC,DLAYGO,DTOUT,DUOUT,Y 6 GETNAME ;Get the name of the term to edit. 7 K DA,DIC,DLAYGO,DTOUT,DUOUT,Y 8 S DIC="^PXRMD(811.5," 9 S DIC(0)="AEMQL" 10 S DIC("A")="Select Reminder Term: " 11 S DLAYGO=811.5 12 ;Set the starting place for additions. 13 D SETSTART^PXRMCOPY(DIC) 14 W ! 15 D ^DIC 16 I ($D(DTOUT))!($D(DUOUT)) Q 17 I Y=-1 G END 18 S DA=$P(Y,U,1) 19 S CS1=$$FILE^PXRMEXCS(811.5,DA) 20 D EDIT(DIC,DA) 21 I $G(DA)="" G GETNAME 22 S CS2=$$FILE^PXRMEXCS(811.5,DA) 23 I CS2=0 G GETNAME 24 I CS2'=CS1 D SEHIST^PXRMUTIL(811.5,DIC,DA) 25 G GETNAME 26 END ; 27 Q 28 ; 29 ;======================================================= 30 CLASS(DA,DIE) ; 31 N DR,RESULT,X,Y 32 RETRY W ! 33 S DR="100" D ^DIE I $D(Y) Q 34 ;Sponsor 35 S DR="101" D ^DIE I $D(Y) Q 36 ;Make sure Class and Sponsor Class are in synch. 37 S RESULT=$$VSPONSOR^PXRMINTR(X) 38 I RESULT=0 S DIE("NO^")="Other value" G RETRY 39 I RESULT=1 K DIE("NO^") 40 ;Review date, Usage 41 S DR="102;1" D ^DIE I $D(Y) Q 42 Q 43 ; 44 ;======================================================= 45 EDIT(ROOT,DA) ; 46 N CLASS,DIC,DIE,DR,DIDEL,PXRMTMD,RESULT,TCONT,Y 47 ;PXRMTMD is set by a xref on the .01 as a flag that the entire 48 ;entry is being deleted. 49 S CLASS=$P($G(^PXRMD(811.5,DA,100)),U,1) 50 S DIE=ROOT 51 I CLASS'="N"!(($G(PXRMINST)=1)&($G(DUZ(0))="@")) D 52 . S DR=".01" 53 . D ^DIE 54 . I $G(DA)'="" D CLASS(DA,DIE) 55 I $G(DA)="" Q 56 S TCONT=1 57 F D FINDING(DIE,DA) Q:TCONT=0 58 Q 59 ; 60 ;======================================================= 61 FINDING(DIE,DA,LIST) ; 62 N CFIEN,GLOB,IEN,LIST,NODE,TERMSTAT,VF,WPIEN 63 N DEF,DEF1,DEF2,STATUS 64 S DIE("NO^")="OUTOK" 65 S STATUS=0 66 D DEF^PXRMRUTL("811.52",.DEF,.DEF1,.DEF2) 67 S NODE="^PXRMD(811.5)" 68 D LIST^PXRMREDT(NODE,DA,.LIST) 69 D DSPALL^PXRMREDF("T",NODE,DA,.LIST) 70 S DA(1)=DA 71 S IEN=DA 72 S DIC=DIE_DA(1)_",20," 73 S DIC(0)="QEAL" 74 S DIC("A")="Select Finding: " 75 D ^DIC I Y=-1 S DTOUT=1,TCONT=0 Q 76 S DIE=DIC 77 S DA=+Y,GLOB=$P($P(Y,U,2),";",2) Q:GLOB="" 78 I GLOB="PXRMD(811.4," S CFIEN=$P($P(Y,U,2),";",1) D 79 . I $D(^PXRMD(811.4,CFIEN,1))>0 D 80 .. W !!,"Computed Finding Description:" S WPIEN=0 81 .. F S WPIEN=$O(^PXRMD(811.4,CFIEN,1,WPIEN)) Q:+WPIEN'>0 D 82 ... W !,$G(^PXRMD(811.4,CFIEN,1,WPIEN,0)) 83 . E W !!,"No description defined for this computed finding" 84 . W ! 85 I GLOB="YTT(601.71," D WARN^PXRMMH 86 W !,"Editing Finding Number: "_$G(DA) 87 ;Finding record fields 88 S DR=".01;9;12;17" 89 I GLOB="PXRMD(811.4," S DR=DR_";26" 90 ;Taxonomy - use inactive problems 91 I GLOB="PXD(811.2," D 92 .S TERMSTAT=$$TAXNODE^PXRMSTA1($P($P(Y,U,2),";"),"H") 93 .I TERMSTAT="P" S DR=DR_";10" Q 94 .I TERMSTAT'=0 S DR=DR_";10",STATUS=1 95 ;Health Factor - within category rank 96 I GLOB="AUTTHF(" S DR=DR_";11" 97 ;If V file INCLUDE VISIT DATA 98 S VF=$S(GLOB["AUTTEDT":1,GLOB["AUTTEXAM":1,GLOB["AUTTHF":1,GLOB["AUTTIMM":1,GLOB="AUTTSK":1,GLOB["PXD(811.2":1,1:0) 99 I VF S DR=DR_";28" 100 ;Mental Health - scale 101 I GLOB="YTT(601.71," S DR=DR_";13" 102 ;Radiology procedure 103 I GLOB="RAMIS(71," S STATUS=1 104 ;Orderable item 105 I GLOB="ORD(101.43," S DR=DR_";27",STATUS=1 106 ;Rx Type 107 I GLOB="PSDRUG("!(GLOB="PS(50.605,")!(GLOB="PSNDF(50.6,") S DR=DR_";16;27",STATUS=1 108 ;Condition 109 S DR=DR_";14;15;18" 110 ; 111 ;Edit finding record 112 D ^DIE 113 I STATUS=1,$D(DA)>0,$D(Y)=0 D STATUS^PXRMSTA1(.DA,"T") 114 S $P(^PXRMD(811.5,IEN,20,0),U,3)=0 115 Q 116 ; 1 PXRMTMED ; SLC/PKR/PJH - Edit a reminder term. ;01/30/2006 2 ;;2.0;CLINICAL REMINDERS;**1,4**;Feb 04, 2005;Build 21 3 ; 4 ;======================================================= 5 N CS1,CS2,DA,DIC,DLAYGO,DTOUT,DUOUT,Y 6 GETNAME ;Get the name of the term to edit. 7 K DA,DIC,DLAYGO,DTOUT,DUOUT,Y 8 S DIC="^PXRMD(811.5," 9 S DIC(0)="AEMQL" 10 S DIC("A")="Select Reminder Term: " 11 S DLAYGO=811.5 12 ;Set the starting place for additions. 13 D SETSTART^PXRMCOPY(DIC) 14 W ! 15 D ^DIC 16 I ($D(DTOUT))!($D(DUOUT)) Q 17 I Y=-1 G END 18 S DA=$P(Y,U,1) 19 S CS1=$$FILE^PXRMEXCS(811.5,DA) 20 D EDIT(DIC,DA) 21 I $G(DA)="" G GETNAME 22 S CS2=$$FILE^PXRMEXCS(811.5,DA) 23 I CS2=0 G GETNAME 24 I CS2'=CS1 D SEHIST^PXRMUTIL(811.5,DIC,DA) 25 G GETNAME 26 END ; 27 Q 28 ; 29 ;======================================================= 30 CLASS(DA,DIE) ; 31 N DR,RESULT,X,Y 32 RETRY W ! 33 S DR="100" D ^DIE I $D(Y) Q 34 ;Sponsor 35 S DR="101" D ^DIE I $D(Y) Q 36 ;Make sure Class and Sponsor Class are in synch. 37 S RESULT=$$VSPONSOR^PXRMINTR(X) 38 I RESULT=0 S DIE("NO^")="Other value" G RETRY 39 I RESULT=1 K DIE("NO^") 40 ;Review date, Usage 41 S DR="102;1" D ^DIE I $D(Y) Q 42 Q 43 ; 44 ;======================================================= 45 EDIT(ROOT,DA) ; 46 N CLASS,DIC,DIE,DR,DIDEL,PXRMTMD,RESULT,TCONT,Y 47 ;PXRMTMD is set by a xref on the .01 as a flag that the entire 48 ;entry is being deleted. 49 S CLASS=$P($G(^PXRMD(811.5,DA,100)),U,1) 50 S DIE=ROOT 51 I CLASS'="N"!(($G(PXRMINST)=1)&($G(DUZ(0))="@")) D 52 . S DR=".01" 53 . D ^DIE 54 . I $G(DA)'="" D CLASS(DA,DIE) 55 I $G(DA)="" Q 56 S TCONT=1 57 F D FINDING(DIE,DA) Q:TCONT=0 58 Q 59 ; 60 ;======================================================= 61 FINDING(DIE,DA,LIST) ; 62 N CFIEN,GLOB,IEN,LIST,NODE,TERMSTAT,VF,WPIEN 63 N DEF,DEF1,DEF2,STATUS 64 S STATUS=0 65 D DEF^PXRMRUTL("811.52",.DEF,.DEF1,.DEF2) 66 S NODE="^PXRMD(811.5)" 67 D LIST^PXRMREDT(NODE,DA,.LIST) 68 D DSPALL^PXRMREDF("T",NODE,DA,.LIST) 69 S DA(1)=DA 70 S IEN=DA 71 S DIC=DIE_DA(1)_",20," 72 S DIC(0)="QEAL" 73 S DIC("A")="Select Finding: " 74 D ^DIC I Y=-1 S DTOUT=1,TCONT=0 Q 75 S DIE=DIC 76 S DA=+Y,GLOB=$P($P(Y,U,2),";",2) Q:GLOB="" 77 I GLOB="PXRMD(811.4," S CFIEN=$P($P(Y,U,2),";",1) D 78 .I $D(^PXRMD(811.4,CFIEN,1))>0 D 79 ..W !!,"Computed Finding Description:" S WPIEN=0 80 ..F S WPIEN=$O(^PXRMD(811.4,CFIEN,1,WPIEN)) Q:+WPIEN'>0 D 81 ...W !,$G(^PXRMD(811.4,CFIEN,1,WPIEN,0)) 82 .E W !!,"No description defined for this computed finding" 83 .W ! 84 W !,"Editing Finding Number: "_$G(DA) 85 ;Finding record fields 86 S DR=".01;9;12;17" 87 I GLOB="PXRMD(811.4," S DR=DR_";26" 88 ;Taxonomy - use inactive problems 89 I GLOB="PXD(811.2," D 90 .S TERMSTAT=$$TAXNODE^PXRMSTA1($P($P(Y,U,2),";"),"H") 91 .I TERMSTAT="P" S DR=DR_";10" Q 92 .I TERMSTAT'=0 S DR=DR_";10",STATUS=1 93 ;Health Factor - within category rank 94 I GLOB="AUTTHF(" S DR=DR_";11" 95 ;If V file INCLUDE VISIT DATA 96 S VF=$S(GLOB["AUTTEDT":1,GLOB["AUTTEXAM":1,GLOB["AUTTHF":1,GLOB["AUTTIMM":1,GLOB="AUTTSK":1,GLOB["PXD(811.2":1,1:0) 97 I VF S DR=DR_";28" 98 ;Mental Health - scale 99 I GLOB="YTT(601," S DR=DR_";13" 100 ;Radiology procedure 101 I GLOB="RAMIS(71," S STATUS=1 102 ;Orderable item 103 I GLOB="ORD(101.43," S DR=DR_";27",STATUS=1 104 ;Rx Type 105 I GLOB="PSDRUG("!(GLOB="PS(50.605,")!(GLOB="PSNDF(50.6,") S DR=DR_";16;27",STATUS=1 106 ;Condition 107 S DR=DR_";14;15;18" 108 ; 109 ;Edit finding record 110 D ^DIE 111 I STATUS=1,$D(DA)>0 D STATUS^PXRMSTA1(.DA,"T") 112 S $P(^PXRMD(811.5,IEN,20,0),U,3)=0 113 Q 114 ;
Note:
See TracChangeset
for help on using the changeset viewer.
