Changeset 623 for WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEXFI.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (15 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEXFI.m
r613 r623 1 PXRMEXFI ; SLC/PKR/PJH - Exchange utilities for file entries.;07/05/2007 2 ;;2.0;CLINICAL REMINDERS;**6**;Feb 04, 2005;Build 123 3 ;============================================== 4 DELALL(FILENUM,NAME) ;Delete all file entries named NAME. 5 N IEN,IND,LIST,MSG 6 D FIND^DIC(FILENUM,"","@","K",NAME,"*","","","","LIST","MSG") 7 I $P(LIST("DILIST",0),U,1)=0 Q 8 S IND=0 9 F S IND=$O(LIST("DILIST",2,IND)) Q:IND="" D 10 . S IEN=LIST("DILIST",2,IND) 11 . D DELETE(FILENUM,IEN) 12 Q 13 ; 14 ;============================================== 15 DELETE(FILENUM,DA) ;Delete a file entry. 16 N DIK 17 S DIK=$$ROOT^DILFD(FILENUM) 18 D ^DIK 19 Q 20 ; 21 ;============================================== 22 FEIMSG(SAME,ATTR) ;Output the general file exits install message. 23 N IND,NOUT,TEXT,TEXTO 24 S TEXT(1)=ATTR("FILE NAME")_" entry named "_ATTR("NAME")_" already exists" 25 I SAME D 26 . S TEXT(2)="and the packed component is identical, skipping." 27 . S TEXT(3)=" " 28 . D FORMAT^PXRMTEXT(1,70,3,.TEXT,.NOUT,.TEXTO) 29 . F IND=1:1:NOUT W !,TEXTO(IND) 30 . H 2 31 I 'SAME D 32 . S TEXT(2)="but the packed component is different, what do you want to do?" 33 . D FORMAT^PXRMTEXT(1,70,2,.TEXT,.NOUT,.TEXTO) 34 . F IND=1:1:NOUT W !,TEXTO(IND) 35 Q 36 ; 37 ;============================================== 38 FOKTI(FILENUM) ;Check if it is ok to install/transport this FILE. 39 ; 40 ;Drugs not allowed. 41 I FILENUM=50 Q 0 42 ; 43 ;VA Generic not allowed. 44 I FILENUM=50.6 Q 0 45 ; 46 ;VA Drug Class not allowed. 47 I FILENUM=50.605 Q 0 48 ; 49 ;Lab tests not allowed. 50 I FILENUM=60 Q 0 51 ; 52 ;Radiology procedures not allowed. 53 I FILENUM=71 Q 0 54 ; 55 ;ICD9 (used in Dialogs) not allowed. 56 I FILENUM=80 Q 0 57 ; 58 ;ICD0 not allowed. 59 I FILENUM=80.1 Q 0 60 ; 61 ;CPT (used in Dialogs) not allowed. 62 I FILENUM=81 Q 0 63 ; 64 ;Order Dialogs not allowed. 65 I FILENUM=101.41 Q 0 66 ; 67 ;Orderable Items not allowed. 68 I FILENUM=101.43 Q 0 69 ; 70 ;Sites cannot create entries in GMRV VITAL TYPE. 71 I FILENUM=120.51 Q 0 72 ; 73 ;Mental Health Instruments not allowed. 74 I FILENUM=601 Q 0 75 I FILENUM=601.71 Q 0 76 ; 77 I FILENUM=790.404 Q 0 78 ; 79 ;If control gets to here then it is an allowed file type. 80 Q 1 81 ; 82 ;============================================== 83 GETFACT(PT01,ATTR,NEWPT01,NAMECHG,IEN) ;Get the action for a file. 84 N ACTION,CHOICES,CSUM,DIR,FILENUM,MSG,RESULT 85 N SAME,X,Y 86 ;See if this entry is already defined. 87 CHK ; 88 S NEWPT01="" 89 S FILENUM=ATTR("FILE NUMBER") 90 I IEN="" S IEN=$$EXISTS^PXRMEXIU(FILENUM,PT01) 91 I IEN D 92 .;If the entry already exists compare the existing entry checksum 93 .;with the packed entry checksum. 94 . S CSUM=$$FILE^PXRMEXCS(ATTR("FILE NUMBER"),IEN) 95 . S SAME=$S(ATTR("CHECKSUM")=CSUM:1,1:0) 96 . D FEIMSG(SAME,.ATTR) 97 . I SAME S ACTION="S" 98 . I 'SAME D 99 .. S CHOICES=$S(FILENUM=801.41:"CMOQS",FILENUM=811.5:"CMOQS",1:"COQS") 100 .. S DIR("B")="O" 101 .. S ACTION=$$GETACT^PXRMEXIU(CHOICES,.DIR) 102 E D 103 . W !!,ATTR("FILE NAME")," entry ",PT01," is NEW," 104 . W !,"what do you want to do?" 105 . S CHOICES="CIQS" 106 . S DIR("B")="I" 107 . S ACTION=$$GETACT^PXRMEXIU(CHOICES,.DIR) 108 ; 109 I ACTION="Q" Q ACTION 110 I ACTION="C" D 111 . S NEWPT01=$$GETUNAME^PXRMEXIU(.ATTR) 112 .;Make sure the NEW .01 passes any input transforms. 113 . I NEWPT01="" S ACTION="S" 114 . E D CHK^DIE(ATTR("FILE NUMBER"),.01,"",NEWPT01,.RESULT,"MSG") 115 I $G(RESULT)="^" D G CHK 116 . D AWRITE^PXRMUTIL("MSG") 117 . K RESULT 118 ; 119 I ACTION="O" D 120 .;If the action is overwrite double check that is what the user 121 .;really wants to do. 122 . N DIROUT,DIRUT,DTOUT,DUOUT 123 . K DIR 124 . S DIR(0)="Y"_U_"A" 125 . S DIR("A")="Are you sure you want to overwrite" 126 . S DIR("B")="N" 127 . D ^DIR 128 . I $D(DIROUT)!$D(DIRUT) S Y=0 129 . I $D(DTOUT)!$D(DUOUT) S Y=0 130 . S ACTION=$S(Y:"O",1:"S") 131 ; 132 I ACTION="P" D 133 . N DIC,Y 134 . S DIC=ATTR("FILE NUMBER") 135 . S DIC(0)="AEMQ" 136 . D ^DIC 137 . I Y=-1 S ACTION="S" 138 . E S NEWPT01=$P(Y,U,2) 139 ; 140 I NEWPT01'="" S NAMECHG(ATTR("FILE NUMBER"),PT01)=NEWPT01 141 Q ACTION 142 ; 143 ;============================================== 144 SETATTR(ATTR,FILE,PT01) ;Set the file attributes for the file FILE. 145 N MSG 146 S ATTR("FILE NUMBER")=FILE 147 S ATTR("FILE NAME")=$$GET1^DID(FILE,"","","NAME","","MSG") 148 ;This call gets the field length. 149 D FIELD^DID(FILE,.01,"","FIELD LENGTH","ATTR","MSG") 150 S ATTR("MIN FIELD LENGTH")=3 151 S (ATTR("NAME"),ATTR("PT01"))=PT01 152 Q 153 ; 1 PXRMEXFI ; SLC/PKR/PJH - Exchange utilities for file entries.;12/21/2004 2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005 3 ;============================================== 4 DELALL(FILENUM,NAME) ;Delete all file entries named NAME. 5 N IEN,IND,LIST,MSG 6 D FIND^DIC(FILENUM,"","@","K",NAME,"*","","","","LIST","MSG") 7 I $P(LIST("DILIST",0),U,1)=0 Q 8 S IND=0 9 F S IND=$O(LIST("DILIST",2,IND)) Q:IND="" D 10 . S IEN=LIST("DILIST",2,IND) 11 . D DELETE(FILENUM,IEN) 12 Q 13 ; 14 ;============================================== 15 DELETE(FILENUM,DA) ;Delete a file entry. 16 N DIK 17 S DIK=$$ROOT^DILFD(FILENUM) 18 D ^DIK 19 Q 20 ; 21 ;============================================== 22 FOKTI(FILENUM) ;Check if it is ok to install/transport this FILE. 23 ; 24 ;Drugs not allowed. 25 I FILENUM=50 Q 0 26 ; 27 ;VA Generic not allowed. 28 I FILENUM=50.6 Q 0 29 ; 30 ;VA Drug Class not allowed. 31 I FILENUM=50.605 Q 0 32 ; 33 ;Lab tests not allowed. 34 I FILENUM=60 Q 0 35 ; 36 ;Radiology procedures not allowed. 37 I FILENUM=71 Q 0 38 ; 39 ;ICD9 (used in Dialogs) not allowed. 40 I FILENUM=80 Q 0 41 ; 42 ;ICD0 not allowed. 43 I FILENUM=80.1 Q 0 44 ; 45 ;CPT (used in Dialogs) not allowed. 46 I FILENUM=81 Q 0 47 ; 48 ;Order Dialogs not allowed. 49 I FILENUM=101.41 Q 0 50 ; 51 ;Orderable Items not allowed. 52 I FILENUM=101.43 Q 0 53 ; 54 ;Sites cannot create entries in GMRV VITAL TYPE. 55 I FILENUM=120.51 Q 0 56 ; 57 ;Mental Health Instruments not allowed. 58 I FILENUM=601 Q 0 59 ; 60 I FILENUM=790.404 Q 0 61 ; 62 ;If control gets to here then it is an allowed file type. 63 Q 1 64 ; 65 ;============================================== 66 GETFACT(PT01,ATTR,NEWPT01,NAMECHG,EXISTS) ;Get the action for a file. 67 N ACTION,CHOICES,DIR,FILENUM,MSG,RESULT,X,Y 68 ;See if this entry is already defined. 69 CHK ; 70 S NEWPT01="" 71 S (ATTR("NAME"),ATTR("PT01"))=PT01 72 S FILENUM=ATTR("FILE NUMBER") 73 I EXISTS="" S EXISTS=$$EXISTS^PXRMEXIU(FILENUM,PT01) 74 ;Check for identical file entry can be made here. 75 I EXISTS D 76 . W !!,ATTR("FILE NAME")," entry ",PT01," already EXISTS," 77 . W !,"what do you want to do?" 78 . S CHOICES=$S(FILENUM=801.41:"CMOQS",FILENUM=811.5:"CMOQS",1:"COQS") 79 . S DIR("B")="S" 80 . S ACTION=$$GETACT^PXRMEXIU(CHOICES,.DIR) 81 E D 82 . W !!,ATTR("FILE NAME")," entry ",PT01," is NEW," 83 . W !,"what do you want to do?" 84 . S CHOICES="CIQS" 85 . S DIR("B")="I" 86 . S ACTION=$$GETACT^PXRMEXIU(CHOICES,.DIR) 87 ; 88 I ACTION="Q" Q ACTION 89 I ACTION="C" D 90 . S NEWPT01=$$GETUNAME^PXRMEXIU(.ATTR) 91 .;Make sure the NEW .01 passes any input transforms. 92 . I NEWPT01="" S ACTION="S" 93 . E D CHK^DIE(ATTR("FILE NUMBER"),.01,"",NEWPT01,.RESULT,"MSG") 94 I $G(RESULT)="^" D G CHK 95 . D AWRITE^PXRMUTIL("MSG") 96 . K RESULT 97 ; 98 I ACTION="O" D 99 .;If the action is overwrite double check that is what the user 100 .;really wants to do. 101 . N DIROUT,DIRUT,DTOUT,DUOUT 102 . K DIR 103 . S DIR(0)="Y"_U_"A" 104 . S DIR("A")="Are you sure you want to overwrite" 105 . S DIR("B")="N" 106 . D ^DIR 107 . I $D(DIROUT)!$D(DIRUT) S Y=0 108 . I $D(DTOUT)!$D(DUOUT) S Y=0 109 . S ACTION=$S(Y:"O",1:"S") 110 ; 111 I ACTION="P" D 112 . N DIC,Y 113 . S DIC=ATTR("FILE NUMBER") 114 . S DIC(0)="AEMQ" 115 . D ^DIC 116 . I Y=-1 S ACTION="S" 117 . E S NEWPT01=$P(Y,U,2) 118 ; 119 I NEWPT01'="" S NAMECHG(ATTR("FILE NUMBER"),PT01)=NEWPT01 120 Q ACTION 121 ; 122 ;============================================== 123 SETATTR(ATTR,FILE) ;Set the file attributes for the file FILE. 124 N MSG 125 S ATTR("FILE NUMBER")=FILE 126 S ATTR("FILE NAME")=$$GET1^DID(FILE,"","","NAME","","MSG") 127 ;This call gets the field length. 128 D FIELD^DID(FILE,.01,"","FIELD LENGTH","ATTR","MSG") 129 S ATTR("MIN FIELD LENGTH")=3 130 Q 131 ;
Note:
See TracChangeset
for help on using the changeset viewer.
