Changeset 623 for WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XPDIA3.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XPDIA3.m
r613 r623 1 XPDIA3 ;SFISC/RWF - Install Pre/Post Actions for Kernel files cont. ;6/22/06 09:13 2 ;;8.0;KERNEL;**201,302,393,498**;Jul 10, 1995;Build 13 3 ;Per VHA Directive 2004-038, this routine should not be modified. 4 Q 5 ;^XTMP("XPDI",,XPDA,"KRN",XPDFILE,OLDA) is the global root 6 ;XPDNM=package name, XPDA=ien in ^XPD(9.6, 7 ;DA=ien in file, OLDA= ien in ^XTMP 8 ; 9 PAR0F2 ;PARAMETER file 8989.5: post. This is a fake entry called from the post of file 8989.51 10 ;Now load any entries from 8989.5 11 N XP1,XP2,XP3,DIK,OLDA,DA,ERR,PN,PE,PT,ROOT 12 S XP1=$O(^XTMP("XPDI",XPDA,"PKG",0)) ;Get the package 13 Q:'XP1 S PN=$G(^XTMP("XPDI",XPDA,"PKG",XP1,0)) 14 S PE=$$FIND1^DIC(9.4,,"MX",$P(PN,U,2)) ;Get the IEN of the package 15 S OLDA=0,ROOT=$NA(^XTMP("XPDI",XPDA,"KRN",8989.5)) 16 F S OLDA=$O(@ROOT@(OLDA)) Q:'OLDA D 17 . S XP1=@ROOT@(OLDA,0) 18 . S $P(XP1,U,1)=PE_";DIC(9.4," ;entity 19 . S $P(XP1,U,2)=$$LK^XPDIA($NA(^XTV(8989.51)),$P(XP1,U,2)) 20 . S DA=$$LKPAR($P(XP1,U),$P(XP1,U,2),$P(XP1,U,3)) 21 . ;Remove the current entry if we have one 22 . I DA>0 S DIK="^XTV(8989.5," D ^DIK 23 . ;Otherwise Add the zero node, See that we have a IEN 24 . I DA'>0 D ADDPAR($P(XP1,U),$P(XP1,U,2),$P(XP1,U,3)) S DA=$$LKPAR($P(XP1,U),$P(XP1,U,2),$P(XP1,U,3)) 25 . Q:'DA ;don't have a entry 26 . ;Merge the date ;with IHS fix 27 . M ^XTV(8989.5,DA)=^XTMP("XPDI",XPDA,"KRN",8989.5,OLDA) 28 . S ^XTV(8989.5,DA,0)=XP1 ;zero node with new pointers 29 . ;Get Definition and check if Data Type is pointer, then get pointed to global ref. 30 . S PT=$G(^XTV(8989.51,+$P(XP1,U,2),1)) D:$P(PT,U)="P" 31 . . S XP3=$G(^XTV(8989.5,DA,1)),PT=$P(PT,U,2) 32 . . S:PT $P(XP3,U)=$$FIND1^DIC(PT,"","X",$P(XP3,U)) ;resolve pointer value 33 . . S:$P(XP3,U) ^XTV(8989.5,DA,1)=XP3 34 . ;X-ref it 35 . S DIK="^XTV(8989.5," D IX1^DIK 36 Q 37 ; 38 LKPAR(ENT,PAR,INST) ;Lookup an entry 39 Q $O(^XTV(8989.5,"AC",PAR,ENT,INST,0)) 40 ; 41 ADDPAR(ENT,PAR,INST) ;Add a parameter instance 42 N FDA,FDAIEN,DIERR 43 S FDA(8989.5,"+1,",.01)=ENT 44 S FDA(8989.5,"+1,",.02)=PAR 45 S FDA(8989.5,"+1,",.03)=INST 46 D UPDATE^DIE("","FDA","FDAIEN","DIERR") 47 Q 48 ; 49 PAR1F1 ;PARAMETER File 8989.51: file Pre 50 Q 51 PAR1E1 ;PARAMETER file 8989.51: entry pre 52 N XP1,XP2,XP3 53 S ^TMP($J,"XPD",DA)="" 54 ;if there is a new Description, kill the old Description 55 K:$O(^XTMP("XPDI",XPDA,"KRN",8989.51,OLDA,20,0)) ^XTV(8989.51,DA,20) 56 ;Kill any old Allowable entries 57 K:$O(^XTMP("XPDI",XPDA,"KRN",8989.51,OLDA,30,0)) ^XTV(8989.51,DA,30) 58 Q 59 PAR1F2 ;PARAMETER file 8989.51: file post 60 N XPD,DIK,DA 61 S DA=0 62 F S DA=$O(^TMP($J,"XPD",DA)) Q:'DA D 63 . S DIK="^XTV(8989.51," D IX1^DIK 64 D PAR0F2 ;Go load the entries from 8989.5 65 Q 66 PAR1DEL(RT) ;Delete Parameter Def entries 67 D DELPTR^XPDUTL1(8989.51,RT) ;Cleanup pointers 68 D DELIEN^XPDUTL1(8989.51,RT) ;Cleanup entries 69 Q 70 ; 71 PAR2F1 ;PARAMETER File 8989.52: file Pre 72 K ^TMP($J,"XPD") 73 Q 74 PAR2E1 ;PARAMETER file 8989.52: entry Pre 75 N XP1,XP2,ROOT 76 S ROOT=$NA(^XTMP("XPDI",XPDA,"KRN",8989.52)) 77 S XP2=$P(@ROOT@(OLDA,0),U,4) ;Use instance of 78 ;Because we change the transport global see that a restart will work 79 I $L(XP2),XP2?1A.E S $P(@ROOT@(OLDA,0),U,4)=$$LK^XPDIA($NA(^XTV(8989.51)),XP2) 80 S XP1=0 81 F S XP1=$O(@ROOT@(OLDA,10,XP1)),XP2="" Q:'XP1 D 82 . S XP2=$P(@ROOT@(OLDA,10,XP1,0),U,2) ;Parameter 83 . I $L(XP2),XP2?1A.E S $P(@ROOT@(OLDA,10,XP1,0),U,2)=$$LK^XPDIA($NA(^XTV(8989.51)),XP2) 84 . Q 85 Q 86 PAR2F2 ;PARAMETER file 8989.52: file Post 87 Q 88 PAR2DEL(RT) ;Delete Parameter Templates 89 D DELIEN^XPDUTL1(8989.52,RT) 90 Q 1 XPDIA3 ;SFISC/RWF - Install Pre/Post Actions for Kernel files cont. ;6/22/06 09:13 2 ;;8.0;KERNEL;**201,302,393**;Jul 10, 1995;Build 12 3 Q 4 ;^XTMP("XPDI",,XPDA,"KRN",XPDFILE,OLDA) is the global root 5 ;XPDNM=package name, XPDA=ien in ^XPD(9.6, 6 ;DA=ien in file, OLDA= ien in ^XTMP 7 ; 8 PAR0F2 ;PARAMETER file 8989.5: post. This is a fake entry called from the post of file 8989.51 9 ;Now load any entries from 8989.5 10 N XP1,XP2,DIK,OLDA,DA,ERR,PN,PE,ROOT 11 S XP1=$O(^XTMP("XPDI",XPDA,"PKG",0)) ;Get the package 12 Q:'XP1 S PN=$G(^XTMP("XPDI",XPDA,"PKG",XP1,0)) 13 S PE=$$FIND1^DIC(9.4,,"MX",$P(PN,U,2)) ;Get the IEN of the package 14 S OLDA=0,ROOT=$NA(^XTMP("XPDI",XPDA,"KRN",8989.5)) 15 F S OLDA=$O(@ROOT@(OLDA)) Q:'OLDA D 16 . S XP1=@ROOT@(OLDA,0) 17 . S $P(XP1,U,1)=PE_";DIC(9.4," ;entity 18 . S $P(XP1,U,2)=$$LK^XPDIA($NA(^XTV(8989.51)),$P(XP1,U,2)) 19 . S DA=$$LKPAR($P(XP1,U),$P(XP1,U,2),$P(XP1,U,3)) 20 . ;Remove the current entry if we have one 21 . I DA>0 S DIK="^XTV(8989.5," D ^DIK 22 . ;Otherwise Add the zero node, See that we have a IEN 23 . I DA'>0 D ADDPAR($P(XP1,U),$P(XP1,U,2),$P(XP1,U,3)) S DA=$$LKPAR($P(XP1,U),$P(XP1,U,2),$P(XP1,U,3)) 24 . Q:'DA ;don't have a entry 25 . ;Merge the date ;with IHS fix 26 . M ^XTV(8989.5,DA)=^XTMP("XPDI",XPDA,"KRN",8989.5,OLDA) 27 . S ^XTV(8989.5,DA,0)=XP1 ;zero node with new pointers 28 . ;X-ref it 29 . S DIK="^XTV(8989.5," D IX1^DIK 30 Q 31 ; 32 LKPAR(ENT,PAR,INST) ;Lookup an entry 33 Q $O(^XTV(8989.5,"AC",PAR,ENT,INST,0)) 34 ; 35 ADDPAR(ENT,PAR,INST) ;Add a parameter instance 36 N FDA,FDAIEN,DIERR 37 S FDA(8989.5,"+1,",.01)=ENT 38 S FDA(8989.5,"+1,",.02)=PAR 39 S FDA(8989.5,"+1,",.03)=INST 40 D UPDATE^DIE("","FDA","FDAIEN","DIERR") 41 Q 42 ; 43 PAR1F1 ;PARAMETER File 8989.51: file Pre 44 Q 45 PAR1E1 ;PARAMETER file 8989.51: entry pre 46 N XP1,XP2,XP3 47 S ^TMP($J,"XPD",DA)="" 48 ;if there is a new Description, kill the old Description 49 K:$O(^XTMP("XPDI",XPDA,"KRN",8989.51,OLDA,20,0)) ^XTV(8989.51,DA,20) 50 ;Kill any old Allowable entries 51 K:$O(^XTMP("XPDI",XPDA,"KRN",8989.51,OLDA,30,0)) ^XTV(8989.51,DA,30) 52 Q 53 PAR1F2 ;PARAMETER file 8989.51: file post 54 N XPD,DIK,DA 55 S DA=0 56 F S DA=$O(^TMP($J,"XPD",DA)) Q:'DA D 57 . S DIK="^XTV(8989.51," D IX1^DIK 58 D PAR0F2 ;Go load the entries from 8989.5 59 Q 60 PAR1DEL(RT) ;Delete Parameter Def entries 61 D DELPTR^XPDUTL1(8989.51,RT) ;Cleanup pointers 62 D DELIEN^XPDUTL1(8989.51,RT) ;Cleanup entries 63 Q 64 ; 65 PAR2F1 ;PARAMETER File 8989.52: file Pre 66 K ^TMP($J,"XPD") 67 Q 68 PAR2E1 ;PARAMETER file 8989.52: entry Pre 69 N XP1,XP2,ROOT 70 S ROOT=$NA(^XTMP("XPDI",XPDA,"KRN",8989.52)) 71 S XP2=$P(@ROOT@(OLDA,0),U,4) ;Use instance of 72 ;Because we change the transport global see that a restart will work 73 I $L(XP2),XP2?1A.E S $P(@ROOT@(OLDA,0),U,4)=$$LK^XPDIA($NA(^XTV(8989.51)),XP2) 74 S XP1=0 75 F S XP1=$O(@ROOT@(OLDA,10,XP1)),XP2="" Q:'XP1 D 76 . S XP2=$P(@ROOT@(OLDA,10,XP1,0),U,2) ;Parameter 77 . I $L(XP2),XP2?1A.E S $P(@ROOT@(OLDA,10,XP1,0),U,2)=$$LK^XPDIA($NA(^XTV(8989.51)),XP2) 78 . Q 79 Q 80 PAR2F2 ;PARAMETER file 8989.52: file Post 81 Q 82 PAR2DEL(RT) ;Delete Parameter Templates 83 D DELIEN^XPDUTL1(8989.52,RT) 84 Q
Note:
See TracChangeset
for help on using the changeset viewer.
