Changeset 623 for WorldVistAEHR/trunk/r/WORLDVISTA-VW/VWUTIL.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/WORLDVISTA-VW/VWUTIL.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/WORLDVISTA-VW/VWUTIL.m
r613 r623 1 VWUTIL ;WVEHR/Maury Pepper/Skip Ormsby- World VistA Utilities;12:52 PM 11 Nov 2008 2 ;;1.0;WORLD VISTA;250001,250002;;Build 4 3 ; 4 ;Modified from FOIA VISTA, 5 ;Copyright 2008 WorldVistA. Licensed under the terms of the GNU 6 ;General Public License See attached copy of the License. 7 ; 8 ;This program is free software; you can redistribute it and/or modify 9 ;it under the terms of the GNU General Public License as published by 10 ;the Free Software Foundation; either version 2 of the License, or 11 ;(at your option) any later version. 12 ; 13 ;This program is distributed in the hope that it will be useful, 14 ;but WITHOUT ANY WARRANTY; without even the implied warranty of 15 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 ;GNU General Public License for more details. 17 ; 18 ;You should have received a copy of the GNU General Public License along 19 ;with this program; if not, write to the Free Software Foundation, Inc., 20 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 21 ; 22 Q 23 ;*WVEHR - 250001* 24 Q(V,D) ; Function to return $QUERY for variable V and direction D. 25 ; Replacement for Reverse $Q Function 26 ; 1/8/08 MLP 27 ;This function can be called for $Query -- either forward or reverse. 28 ;In place of $Q(V,D), use $$Q^ZDQ($NA(V),D) 29 ;Note: the 2nd argument is optional. 30 ; 31 S D=+$G(D,1) 32 Q:D=1 $Q(@V) ;Forward $Q 33 IF D'=-1 Q ;Will cause error due to no argument. 34 N S 35 TOP IF $QL(V)=0 Q "" ;done if unsubscripted 36 BKU S S=$O(@V,-1) ;backup to previous node on current level 37 S V=$NA(@V,$QL(V)-1) ;remove last subscript 38 IF S="" G DAT ;go chk for data if backed up all the way 39 S V=$NA(@V@(S)) ;add the subscript found when backing up. 40 IF $D(@V)>9 S V=$NA(@V@("")) G BKU ;if downpointer, descend and repeat 41 DAT IF $D(@V)#2=1 Q V ;if a data node, return with current name 42 G TOP 43 ; 44 ;*WVEHR 250002* 45 DD2 ;Weston/SO Make certain Required Fields in Patient File NOT required 46 ;06/30/2008 47 ;Fields: 48 ;SOCIAL SECURITY NUMBER(#.09) 49 ;SERVICE CONNECTED?(#.301) 50 ;TYPE(#391) 51 ;VETERAN (Y/N)?(#1901) 52 ; 53 D DT^DICRW ;Make sure FM variables are set up 54 F I="SOCIAL SECURITY NUMBER","SERVICE CONNECTED?","TYPE","VETERAN (Y/N)?" D 55 .N FIELD S FIELD=+$O(^DD(2,"B",I,0)) Q:'FIELD ;Get field number 56 .N X S X=$P(^DD(2,FIELD,0),U,2) ;Get field properties 57 .S X=$TR(X,"R","") ;Remove the 'R'equired flag 58 .S $P(^DD(2,FIELD,0),U,2)=X ;Re-Set field properties 59 .K ^DD(2,"RQ",FIELD) ;Kill off the ReQuired Xref 60 .S ^DD(2,FIELD,"DT")=DT ;Set the date Last Edited 61 .; 62 .;Re-Compile any Input Templates 63 .D 64 ..N IEN S IEN=0 65 ..F S IEN=$O(^DIE("AF",2,FIELD,IEN)) Q:'IEN D 66 ...N X,Y,DMAX 67 ...I '$D(^DIE(IEN,"ROU")) Q ;Not compiled 68 ...S X=^DIE(IEN,"ROU") 69 ...I X="" Q ;No routine specified 70 ...S X=$P(X,U,2),Y=IEN,DMAX=$$ROUSIZE^DILF 71 ...D EN^DIEZ 72 ...Q 73 ..Q 74 .; 75 .;Re-Compile any Print Templates 76 .D 77 ..N IEN S IEN=0 78 ..F S IEN=$O(^DIPT("AF",2,FIELD,IEN)) Q:'IEN D 79 ...N X,Y,DMAX 80 ...I '$D(^DIPT(IEN,"ROU")) Q ;Not compiled 81 ...S X=^DIPT(IEN,"ROU") 82 ...I X="" Q ;No routine specified 83 ...S X=$P(X,U,2),Y=IEN,DMAX=$$ROUSIZE^DILF 84 ...D EN^DIPZ 85 ..Q 86 .Q 87 Q 88 AMA1 ;Display the AMA Copyright for 1 second 89 N X W !,"CPT copyright AMA 2009 American Medical Association. All rights reserved." 90 R X#1:1 91 Q 92 AMA10 ;Display the AMA Copyright for 10 seconds 93 N X W !,"CPT copyright AMA 2009 American Medical Association. All rights reserved." 94 W !," Press any key to continue." 95 R X#1:10 96 Q 97 ; 1 VWUTIL ;WVEHR/Maury Pepper/Skip Ormsby- World VistA Utilities;7:32 PM 30 Jan 2008 2 ;;WVEHR-1007;WORLD VISTA;*WVEHR1*;;WorldVistA 30-Jan-08 3 ; 4 ;Modified from FOIA VISTA, 5 ;Copyright 2008 WorldVistA. Licensed under the terms of the GNU 6 ;General Public License See attached copy of the License. 7 ; 8 ;This program is free software; you can redistribute it and/or modify 9 ;it under the terms of the GNU General Public License as published by 10 ;the Free Software Foundation; either version 2 of the License, or 11 ;(at your option) any later version. 12 ; 13 ;This program is distributed in the hope that it will be useful, 14 ;but WITHOUT ANY WARRANTY; without even the implied warranty of 15 ;MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16 ;GNU General Public License for more details. 17 ; 18 ;You should have received a copy of the GNU General Public License along 19 ;with this program; if not, write to the Free Software Foundation, Inc., 20 ;51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. 21 ; 22 Q 23 ; 24 Q(V,D) ; Function to return $QUERY for variable V and direction D. 25 ; Replacement for Reverse $Q Function 26 ; 1/8/08 MLP 27 ;This function can be called for $Query -- either forward or reverse. 28 ;In place of $Q(V,D), use $$Q^ZDQ($NA(V),D) 29 ;Note: the 2nd argument is optional. 30 ; 31 S D=+$G(D,1) 32 Q:D=1 $Q(@V) ;Forward $Q 33 IF D'=-1 Q ;Will cause error due to no argument. 34 N S 35 TOP IF $QL(V)=0 Q "" ;done if unsubscripted 36 BKU S S=$O(@V,-1) ;backup to previous node on current level 37 S V=$NA(@V,$QL(V)-1) ;remove last subscript 38 IF S="" G DAT ;go chk for data if backed up all the way 39 S V=$NA(@V@(S)) ;add the subscript found when backing up. 40 IF $D(@V)>9 S V=$NA(@V@("")) G BKU ;if downpointer, descend and repeat 41 DAT IF $D(@V)#2=1 Q V ;if a data node, return with current name 42 G TOP
Note:
See TracChangeset
for help on using the changeset viewer.
