Changeset 636 for FOIAVistA/tag/r/CLINICAL_REMINDERS-PXRM/PXRMEXFI.m
- Timestamp:
- Dec 4, 2009, 8:26:01 PM (14 years ago)
- Location:
- FOIAVistA/tag/r
- Files:
-
- 1 edited
- 1 copied
Legend:
- Unmodified
- Added
- Removed
-
FOIAVistA/tag/r/CLINICAL_REMINDERS-PXRM/PXRMEXFI.m
r628 r636 1 PXRMEXFI ; SLC/PKR/PJH - Exchange utilities for file entries.; 07/05/20072 ;;2.0;CLINICAL REMINDERS; **6**;Feb 04, 2005;Build 1231 PXRMEXFI ; SLC/PKR/PJH - Exchange utilities for file entries.;12/21/2004 2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005 3 3 ;============================================== 4 4 DELALL(FILENUM,NAME) ;Delete all file entries named NAME. … … 17 17 S DIK=$$ROOT^DILFD(FILENUM) 18 18 D ^DIK 19 Q20 ;21 ;==============================================22 FEIMSG(SAME,ATTR) ;Output the general file exits install message.23 N IND,NOUT,TEXT,TEXTO24 S TEXT(1)=ATTR("FILE NAME")_" entry named "_ATTR("NAME")_" already exists"25 I SAME D26 . 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 231 I 'SAME D32 . 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 19 Q 36 20 ; … … 73 57 ;Mental Health Instruments not allowed. 74 58 I FILENUM=601 Q 0 75 I FILENUM=601.71 Q 076 59 ; 77 60 I FILENUM=790.404 Q 0 … … 81 64 ; 82 65 ;============================================== 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 66 GETFACT(PT01,ATTR,NEWPT01,NAMECHG,EXISTS) ;Get the action for a file. 67 N ACTION,CHOICES,DIR,FILENUM,MSG,RESULT,X,Y 86 68 ;See if this entry is already defined. 87 69 CHK ; 88 70 S NEWPT01="" 71 S (ATTR("NAME"),ATTR("PT01"))=PT01 89 72 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) 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) 102 81 E D 103 82 . W !!,ATTR("FILE NAME")," entry ",PT01," is NEW," … … 142 121 ; 143 122 ;============================================== 144 SETATTR(ATTR,FILE ,PT01) ;Set the file attributes for the file FILE.123 SETATTR(ATTR,FILE) ;Set the file attributes for the file FILE. 145 124 N MSG 146 125 S ATTR("FILE NUMBER")=FILE … … 149 128 D FIELD^DID(FILE,.01,"","FIELD LENGTH","ATTR","MSG") 150 129 S ATTR("MIN FIELD LENGTH")=3 151 S (ATTR("NAME"),ATTR("PT01"))=PT01152 130 Q 153 131 ;
Note:
See TracChangeset
for help on using the changeset viewer.